From 15d6e7c9a2c3234f95dfe278046fa2fee1b0c007 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 26 Oct 2004 10:24:54 +0000 Subject: [PATCH] 0.8.16.2: TYPE-ERROR for ERROR * ANSI sayeth that we should signal a TYPE-ERROR if arguments to ERROR are silly. Make it so. --- NEWS | 2 ++ src/code/class.lisp | 8 +++++--- tests/condition.pure.lisp | 15 +++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 23 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index 5e4f658..316655a 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,8 @@ changes in sbcl-0.8.17 relative to sbcl-0.8.16: *READ-SUPPRESS* is true. (reported by Bruno Haible for CMUCL) * bug fix: Default value of EOF-ERROR-P in READ-FROM-STRING is true. (reported by Bruno Haible for CMUCL) + * bug fix: ERROR now signals a TYPE-ERROR if the arguments to ERROR + do not designate a condition. (reported by Bruno Haible for CMUCL) changes in sbcl-0.8.16 relative to sbcl-0.8.15: * enhancement: saving cores with foreign code loaded is now diff --git a/src/code/class.lisp b/src/code/class.lisp index 6845b19..056f802 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -702,13 +702,15 @@ (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) (defun find-classoid (name &optional (errorp t) environment) #!+sb-doc - "Return the class with the specified NAME. If ERRORP is false, then NIL is - returned when no such class exists." + "Return the class with the specified NAME. If ERRORP is false, then +NIL is returned when no such class exists." (declare (type symbol name) (ignore environment)) (let ((res (classoid-cell-classoid (find-classoid-cell name)))) (if (or res (not errorp)) res - (error "class not yet defined:~% ~S" name)))) + (error 'simple-type-error + :format-control "class not yet defined:~% ~S" + :format-arguments (list name))))) (defun (setf find-classoid) (new-value name) #-sb-xc (declare (type (or null classoid) new-value)) (cond diff --git a/tests/condition.pure.lisp b/tests/condition.pure.lisp index 310562d..d40cdba 100644 --- a/tests/condition.pure.lisp +++ b/tests/condition.pure.lisp @@ -122,3 +122,18 @@ (subtypep 'fixnum (type-error-expected-type c)))) (assert (eq (type-error-datum c) t))) (:no-error (&rest rest) (error "no error: ~S" rest))) + +;;; ANSI specifies TYPE-ERROR if datum and arguments of ERROR are not +;;; designators for a condition. Reported by Bruno Haible on cmucl-imp +;;; 2004-10-12. +(flet ((test (&rest args) + (multiple-value-bind (res err) + (ignore-errors (apply #'error args)) + (assert (not res)) + (assert (typep err 'type-error))))) + (test '#:no-such-condition) + (test nil) + (test t) + (test 42) + (test (make-instance 'standard-object))) + diff --git a/version.lisp-expr b/version.lisp-expr index 83d4b04..668a711 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".) -"0.8.16.1" +"0.8.16.2" -- 1.7.10.4