From deac413eadea2935f356eebfc8f6b01b6367d260 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 17 Aug 2010 12:26:24 +0000 Subject: [PATCH] 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 | 2 ++ package-data-list.lisp-expr | 1 + src/code/condition.lisp | 9 +++++++++ src/code/parse-defmacro.lisp | 3 +++ src/compiler/deftype.lisp | 5 +++-- tests/compiler.impure.lisp | 4 ++++ tests/deftype.impure.lisp | 3 +++ version.lisp-expr | 2 +- 8 files changed, 26 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index 0efbedc..9ddaaeb 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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))) ;;;; 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 --- 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 --- 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" -- 1.7.10.4