1.0.41.50: additional error checking for DEFTYPE &co

Based on patch by Roman Marynchak.

 * Make PARSE-DEFMACRO check that the lambda-list is actually a list.

 * Define BAD-TYPE as an utility to signal SIMPLE-TYPE-ERRORS, instead
   of having to write the keyword calls everywhere.

 * Fixes https://bugs.launchpad.net/sbcl/+bug/576594

NEWS

@@ -14,6 +14,8 @@ changes relative to sbcl-1.0.41
   * bug fix: RENAME-PACKAGE returns the package.  (Thanks to Eric Marsden)
   * bug fix: EXPT signals an error if first argument is a zero and second
     argument is a floating point zero. (lp#571581, thanks to Roman Marynchak)
+  * bug fix: DEFTYPE signals an error for non-list lambda-lists.
+    (lp#576594, thanks to Roman Marynchak)
 
 changes in sbcl-1.0.41 relative to sbcl-1.0.40:
   * optimization: validity of observed keyword initargs to MAKE-INSTANCE is

package-data-list.lisp-expr

@@ -898,6 +898,7 @@ possibly temporariliy, because it might be used internally."
 
                ;; error-reporting facilities
                "ARGUMENTS-OUT-OF-DOMAIN-ERROR"
+               "BAD-TYPE"
                "CLOSED-STREAM-ERROR"
                "COMPILED-PROGRAM-ERROR"
                "ENCAPSULATED-CONDITION"

src/code/condition.lisp

@@ -624,6 +624,15 @@
 (define-condition simple-style-warning (simple-condition style-warning) ())
 (define-condition simple-type-error (simple-condition type-error) ())
 
+;; Can't have a function called SIMPLE-TYPE-ERROR or TYPE-ERROR...
+(declaim (ftype (sfunction (t t t &rest t) nil) bad-type))
+(defun bad-type (datum type control &rest arguments)
+  (error 'simple-type-error
+         :datum datum
+         :expected-type type
+         :format-control control
+         :format-arguments arguments))
+
 (define-condition program-error (error) ())
 (define-condition parse-error   (error) ())
 (define-condition control-error (error) ())

src/code/parse-defmacro.lisp

@@ -39,6 +39,9 @@
                        ((:default-default *default-default*))
                        (error-fun 'error)
                        (wrap-block t))
+  (unless (listp lambda-list)
+    (bad-type lambda-list 'list "~S lambda-list is not a list: ~S"
+              context lambda-list))
   (multiple-value-bind (forms declarations documentation)
       (parse-body body :doc-string-allowed doc-string-allowed)
     (let ((*arg-tests* ())

src/compiler/deftype.lisp

@@ -19,11 +19,12 @@
 (defun %deftype (name)
   (setf (classoid-cell-pcl-class (find-classoid-cell name :create t)) nil))
 
-(def!macro sb!xc:deftype (name lambda-list &body body)
+(def!macro sb!xc:deftype (&whole form name lambda-list &body body)
   #!+sb-doc
   "Define a new type, with syntax like DEFMACRO."
   (unless (symbolp name)
-    (error "type name not a symbol: ~S" name))
+    (bad-type name 'symbol "Type name is not a symbol:~%  ~S"
+              form))
   (multiple-value-bind (expander-form doc source-location-form)
       (multiple-value-bind (forms decls doc) (parse-body body)
         ;; FIXME: We could use CONSTANTP here to deal with slightly more

tests/compiler.impure.lisp

@@ -1193,6 +1193,10 @@
       (eval '(defstruct bug-542807 slot)))
     (assert (= 1 (length conds)))
     (assert (typep (car conds) 'sb-kernel::redefinition-with-defun))))
+
+(with-test (:name :defmacro-not-list-lambda-list)
+  (assert (raises-error? (eval `(defmacro ,(gensym) "foo"))
+                         type-error)))
 
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself

tests/deftype.impure.lisp

@@ -49,3 +49,6 @@
 (defconstant whatever 't)
 (deftype anything () whatever)
 (assert (typep 42 'anything))
+
+(with-test (:name :deftype-not-list-lambda-list)
+  (assert (raises-error? (eval `(deftype ,(gensym) non-list-argument)))))

version.lisp-expr

@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.41.49"
+"1.0.41.50"