DEFPACKAGE chokes with obscure compile-time error if :use package doesn't exist.

[heegaiximephoomeeghahyaiseekh]

Reproduction:

(macroexpand-1 '(defpackage #:foobar (:use #:does-not-exist)))

Error:

;;; An error of type SIMPLE-ERROR was detected in function CHECK-TYPE-BODY:
;;; Error: The value of P, NIL, is not of type PACKAGE
;;; Entering Corman Lisp debug loop. 
;;; Use :C followed by an option to exit. Type :HELP for help.
;;; Restart options:
;;; 1   Abort to top level.

I traced the error to a mapcar call in the defpackage macro that attempts to change a list of packages into strings via package-name. That list is generated from the package-designators in the :use subform, and if an undefined package was in that list, then the corresponding element in the package list will be a string instead of a package.

Fixing that bug (see patch), a further bug exists: The macro does not show which package didn't exist. You end up getting this error:

;;; An error of type SIMPLE-ERROR was detected in function ADD-USED-PACKAGE:
;;; Error: Not a package: NIL
;;; Entering Corman Lisp debug loop. 
;;; Use :C followed by an option to exit. Type :HELP for help.
;;; Restart options:
;;; 1   Abort to top level.

That happens because defpackage doesn't check if the package exists before or after using find-package. The result is that NIL gets passed to use-package and no further information is available.

This can be fixed by checking if find-package returns NIL before using it, and signalling an error while the name of the package is still known.

Here is a diff patch to fix both problems.

Unfortunately, GitHub doesn't allow patches to be attached, so I'll have to just paste it here:

--- defpackage.lisp     2015-01-06 01:08:14.000000000 -0500
+++ /tmp/defpackage.lisp        2015-06-06 13:16:18.000000000 -0400
@@ -140,7 +140,7 @@
                         (remove-duplicates
                             (append use
                                 (mapcar #'(lambda (pkg) (canonicalize-package-designator pkg nil)) value)))))
-                               (:import-from (push value import-from))
+                       (:import-from (push value import-from))
                                (:intern (setq intern (append intern (mapcar #'string value))))
                                (:export (setq export (append export (mapcar #'string value))))
                                (:documentation
@@ -156,12 +156,20 @@
                         :nicknames ',(remove-duplicates nicknames :test #'string-equal)
                         :use nil
                         ,@(when size `(:size ,size)))) forms))
-        (setq use (mapcar (lambda (package) (package-name package)) use))   ;; list package names, not packages
+        (setq use (mapcar (lambda (package)
+                            (if (packagep package)
+                                (package-name package)
+                                 package)) use))   ;; list package names, not packages
                (when shadow
                  (push `(shadow ',shadow ',name) forms))
                (when shadowing-import-from
           (push `,(build-import-forms name shadowing-import-from t) forms))
                (when use
+          (let ((pkg (gensym)))
+                (push
+                `(loop for ,pkg in (list ,@use)
+                    unless (find-package ,pkg)
+                    do (error "No such package ~a" ,pkg)) forms))
                  (push `(use-package ',use ',name) forms))
                (when import-from
           (push `,(build-import-forms name import-from nil) forms))
@@ -174,9 +182,8 @@
                (when documentation
                  (push `(setf (documentation ',(intern (string name)) 'package) ,documentation) forms))
                (push `(find-package ',name) forms)
-
                `(eval-when (:load-toplevel :compile-toplevel :execute)
-                       ,@(nreverse forms))))
+                       ,@(nreverse forms))))

 ;; support function for DO-SYMBOLS, etc.
 (defun iterate-over-package (package func &optional external-only)

[binghe]

Thanks

[arbv]

This is a nice addition even though I had to fix image building after merging this.