X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpackages.impure.lisp;h=82ef917ef5e1fcf3378fe0201f71398b0631136e;hb=b14aefb22fd710673b1a1005add3c0425713d2a0;hp=5078b9e42a00b8eda90179e18d2867d4226d7a58;hpb=56fd7d95cfadb61a353e8999111a0e2e6a94842b;p=sbcl.git

diff --git a/tests/packages.impure.lisp b/tests/packages.impure.lisp
index 5078b9e..82ef917 100644
--- a/tests/packages.impure.lisp
+++ b/tests/packages.impure.lisp
@@ -17,6 +17,11 @@
 (assert (eq *foo* (find-package "")))
 (assert (delete-package ""))
 
+(make-package "BAR")
+(defvar *baz* (rename-package "BAR" "BAZ"))
+(assert (eq *baz* (find-package "BAZ")))
+(assert (delete-package *baz*))
+
 (handler-case
     (export :foo)
   (package-error (c) (princ c))
@@ -245,6 +250,17 @@ if a restart was invoked."
       (is (eql 1 (length conflict-sets)))
       (is (eql 3 (length (first conflict-sets)))))))
 
+;;; Make sure that resolving a name-conflict in IMPORT doesn't leave
+;;; multiple symbols of the same name in the package (this particular
+;;; scenario found in 1.0.38.9, but clearly a longstanding issue).
+(with-test (:name import-conflict-resolution)
+  (with-packages (("FOO" (:export "NIL"))
+                  ("BAR" (:use)))
+    (with-name-conflict-resolution ((sym "FOO" "NIL"))
+      (import (list 'CL:NIL (sym "FOO" "NIL")) "BAR"))
+    (do-symbols (sym "BAR")
+      (assert (eq sym (sym "FOO" "NIL"))))))
+
 ;;; UNINTERN
 (with-test (:name unintern.1)
   (with-packages (("FOO" (:export "SYM"))
@@ -255,3 +271,36 @@ if a restart was invoked."
       (is restartedp)
       (is (eq (sym "FOO" "SYM")
               (sym "BAZ" "SYM"))))))
+
+(with-test (:name unintern.2)
+  (with-packages (("FOO" (:intern "SYM")))
+    (unintern :sym "FOO")
+    (assert (find-symbol "SYM" "FOO"))))
+
+;;; WITH-PACKAGE-ITERATOR error signalling had problems
+(with-test (:name with-package-itarator.error)
+  (assert (eq :good
+              (handler-case
+                  (progn
+                    (eval '(with-package-iterator (sym :cl-user :foo)
+                            (sym)))
+                    :bad)
+                ((and simple-condition program-error) (c)
+                  (assert (equal (list :foo) (simple-condition-format-arguments c)))
+                  :good)))))
+
+;;; MAKE-PACKAGE error in another thread blocking FIND-PACKAGE & FIND-SYMBOL
+(with-test (:name :bug-511072 :skipped-on '(not :sb-thread))
+  (let* ((p (make-package :bug-511072))
+         (sem1 (sb-thread:make-semaphore))
+         (sem2 (sb-thread:make-semaphore))
+         (t2 (sb-thread:make-thread (lambda ()
+                                      (handler-bind ((error (lambda (c)
+                                                              (sb-thread:signal-semaphore sem1)
+                                                              (sb-thread:wait-on-semaphore sem2)
+                                                              (abort c))))
+                                        (make-package :bug-511072))))))
+    (sb-thread:wait-on-semaphore sem1)
+    (with-timeout 10
+      (assert (eq 'cons (read-from-string "CL:CONS"))))
+    (sb-thread:signal-semaphore sem2)))