X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpackages.impure.lisp;h=82ef917ef5e1fcf3378fe0201f71398b0631136e;hb=b14aefb22fd710673b1a1005add3c0425713d2a0;hp=0a477b3a24a9d8600df4620e7de5a02283f06c67;hpb=666a3a77ee04225cf861ed8e1e7f378b8438d925;p=sbcl.git diff --git a/tests/packages.impure.lisp b/tests/packages.impure.lisp index 0a477b3..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")) @@ -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,19 @@ 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 +(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)))