0.8.12.2:

	Fix for TYPE-ERROR-DATUM badness in CHECK-TYPE
	... and a test.

diff --git a/BUGS b/BUGS
index 61eb424..0963925 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1389,12 +1389,6 @@ WORKAROUND:
     debugger invoked on a SB-INT:BUG in thread 27726:
       fasl stack not empty when it should be
 
-333: "CHECK-TYPE TYPE-ERROR-DATUM place"
-  (reported by Tony Martinez sbcl-devel 2004-05-23)
-  When CHECK-TYPE signals a TYPE-ERROR, the TYPE-ERROR-DATUM holds the
-  lisp symbolic place in question rather than the place's value.  This
-  seems wrong.
-
 334: "COMPUTE-SLOTS used to add slots to classes"
   (reported by Bruno Haible sbcl-devel 2004-06-01)
   a. Adding a local slot does not work:

diff --git a/NEWS b/NEWS
index f53a0d6..60ac550 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2559,6 +2559,9 @@ changes in sbcl-0.8.13 relative to sbcl-0.8.12:
     The symbols are also exported from SB-PCL for backwards
     compatibility, but more so than before SB-PCL should be treated as
     an implementation-internal package.
+  * fixed bug #333: CHECK-TYPE now ensures that the type error
+    signalled, if any, has the right object to be accessed by
+    TYPE-ERROR-DATUM.  (reported by Tony Martinez)
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index a45cd62..5c64df2 100644 (file)
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -54,14 +54,6 @@
 ;;; and some things (e.g., READ-CHAR) can't afford this excessive
 ;;; consing, we bend backwards a little.
 ;;;
-;;; FIXME: In reality, this restart cruft is needed hardly anywhere in
-;;; the system. Write NEED and NEED-TYPE to replace ASSERT and
-;;; CHECK-TYPE inside the system. (CL:CHECK-TYPE must still be
-;;; defined, since it's specified by ANSI and it is sometimes nice for
-;;; whipping up little things. But as far as I can tell it's not
-;;; usually very helpful deep inside the guts of a complex system like
-;;; SBCL.)
-;;;
 ;;; CHECK-TYPE-ERROR isn't defined until a later file because it uses
 ;;; the macro RESTART-CASE, which isn't defined until a later file.
 (defmacro-mundanely check-type (place type &optional type-string)

diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp
index 7b89317..288f3e1 100644 (file)
--- a/src/code/target-error.lisp
+++ b/src/code/target-error.lisp
@@ -144,24 +144,15 @@
   (list (eval (read *query-io*))))
 
 (defun check-type-error (place place-value type type-string)
-  (let ((cond (if type-string
-                 (make-condition 'simple-type-error
-                                 :datum place
-                                 :expected-type type
-                                 :format-control
-                                 "The value of ~S is ~S, which is not ~A."
-                                 :format-arguments (list place
-                                                         place-value
-                                                         type-string))
-                 (make-condition 'simple-type-error
-                                 :datum place
-                                 :expected-type type
-                                 :format-control
-                         "The value of ~S is ~S, which is not of type ~S."
-                                 :format-arguments (list place
-                                                         place-value
-                                                         type)))))
-    (restart-case (error cond)
+  (let ((condition
+        (make-condition
+         'simple-type-error
+         :datum place-value
+         :expected-type type
+         :format-control
+         "The value of ~S is ~S, which is not ~:[of type ~S~;~:*~A~]."
+         :format-arguments (list place place-value type-string type))))
+    (restart-case (error condition)
       (store-value (value)
        :report (lambda (stream)
                  (format stream "Supply a new value for ~S." place))

diff --git a/tests/condition.pure.lisp b/tests/condition.pure.lisp
index 0a4dd84..310562d 100644 (file)
--- a/tests/condition.pure.lisp
+++ b/tests/condition.pure.lisp
@@ -114,3 +114,11 @@
   (control-error (c) (format nil "~A" c))
   ;; there had better be an error
   (:no-error (&rest args) (error "No error: ~S" args)))
+
+(handler-case
+    (funcall (lambda (x) (check-type x fixnum) x) t)
+  (type-error (c)
+    (assert (and (subtypep (type-error-expected-type c) 'fixnum)
+                (subtypep 'fixnum (type-error-expected-type c))))
+    (assert (eq (type-error-datum c) t)))
+  (:no-error (&rest rest) (error "no error: ~S" rest)))

diff --git a/version.lisp-expr b/version.lisp-expr
index db503a4..87145a1 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".)
-"0.8.12.1"
+"0.8.12.2"