X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-package.lisp;h=88b3cbf69de71c6e8c75ac731688988ae48be46b;hb=af178240ffbda39e9c3bf584ad8ed0adcf4b6abd;hp=f85db1602af4263794ec3e958bb92e2dc1e4a916;hpb=f4b2df30d28c890bda36fdeea2c2243de09982eb;p=sbcl.git diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp index f85db16..88b3cbf 100644 --- a/src/code/target-package.lisp +++ b/src/code/target-package.lisp @@ -237,9 +237,11 @@ error if any of PACKAGES is not a valid package designator." #!+sb-package-locks (let* ((symbol (etypecase name (symbol name) - (list (if (eq 'setf (first name)) + (list (if (and (consp (cdr name)) + (eq 'setf (first name))) (second name) - ;; Skip (class-predicate foo), etc. + ;; Skip lists of length 1, single conses and + ;; (class-predicate foo), etc. ;; FIXME: MOP and package-lock ;; interaction needs to be thought about. (return-from @@ -477,15 +479,17 @@ error if any of PACKAGES is not a valid package designator." (push n (package-%nicknames package))) ((eq found package)) ((string= (the string (package-%name found)) n) - (error 'simple-package-error - :package package - :format-control "~S is a package name, so it cannot be a nickname for ~S." - :format-arguments (list n (package-%name package)))) + (cerror "Ignore this nickname." + 'simple-package-error + :package package + :format-control "~S is a package name, so it cannot be a nickname for ~S." + :format-arguments (list n (package-%name package)))) (t - (error 'simple-package-error - :package package - :format-control "~S is already a nickname for ~S." - :format-arguments (list n (package-%name found)))))))) + (cerror "Leave this nickname alone." + 'simple-package-error + :package package + :format-control "~S is already a nickname for ~S." + :format-arguments (list n (package-%name found)))))))) (defun make-package (name &key (use '#.*default-package-use-list*) @@ -647,8 +651,8 @@ error if any of PACKAGES is not a valid package designator." ;; We just simple-stringify the name and call INTERN*, where the real ;; logic is. (let ((name (if (simple-string-p name) - name - (coerce name 'simple-string))) + name + (coerce name 'simple-string))) (package (find-undeleted-package-or-lose package))) (declare (simple-string name)) (intern* name @@ -985,7 +989,8 @@ error if any of PACKAGES is not a valid package designator." :package package :format-control "~@" - :format-arguments (list (package-%name package) missing))) + :format-arguments (list (package-%name package) missing)) + 'import (package-%name package)) (import missing package)) (import imports package))