X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpackages.impure.lisp;h=3b5273e5cf176c8b8106239dcd1370c37ef36167;hb=a51d83191034919bc76367268929e234d62164db;hp=0a477b3a24a9d8600df4620e7de5a02283f06c67;hpb=666a3a77ee04225cf861ed8e1e7f378b8438d925;p=sbcl.git diff --git a/tests/packages.impure.lisp b/tests/packages.impure.lisp index 0a477b3..3b5273e 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")) @@ -256,6 +272,11 @@ if a restart was invoked." (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 @@ -267,3 +288,16 @@ if a restart was invoked." ((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 +#+sb-thread +(with-test (:name :bug-511072) + (let* ((p (make-package :bug-511072)) + (sem (sb-thread:make-semaphore)) + (t2 (sb-thread:make-thread (lambda () + (handler-bind ((error (lambda (c) + (sb-thread:signal-semaphore sem) + (signal c)))) + (make-package :bug-511072)))))) + (sb-thread:wait-on-semaphore sem) + (assert (eq 'cons (read-from-string "CL:CONS")))))