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

diff --git a/NEWS b/NEWS
index 0efbedc..9ddaaeb 100644 (file)
--- a/NEWS
+++ b/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

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 939d02b..b643193 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/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"

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index d01dca2..1ba4f0b 100644 (file)
--- a/src/code/condition.lisp
+++ b/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) ())

diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp
index 0058522..4857679 100644 (file)
--- a/src/code/parse-defmacro.lisp
+++ b/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* ())

diff --git a/src/compiler/deftype.lisp b/src/compiler/deftype.lisp
index fba4c91..3708525 100644 (file)
--- a/src/compiler/deftype.lisp
+++ b/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

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 99ba834..513ca2c 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/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)))
 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself

diff --git a/tests/deftype.impure.lisp b/tests/deftype.impure.lisp
index c260264..3432997 100644 (file)
--- a/tests/deftype.impure.lisp
+++ b/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)))))

diff --git a/version.lisp-expr b/version.lisp-expr
index e2089d9..10015cc 100644 (file)
--- a/version.lisp-expr
+++ b/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"