From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 26 Oct 2004 14:49:11 +0000 (+0000)
Subject: 0.8.16.5: deoopsification
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=dfa8294a1580e8aa099a92baebba7d9caddb2fcb;p=sbcl.git

0.8.16.5: deoopsification
          * Fix paths going thru READ-MAYBE-NOTHING that 0.8.16.1
             broke -- discovered by SB-ACLREPL breaking. Also
             add a regression test for the same.
          * Better TYPE-ERRORs from ERROR: ones that actually have
             expected-type and datum slots filled.
---

diff --git a/src/code/class.lisp b/src/code/class.lisp
index 056f802..0228dcc 100644
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -709,6 +709,8 @@ NIL is returned when no such class exists."
     (if (or res (not errorp))
 	res
 	(error 'simple-type-error
+               :datum nil
+               :expected-type 'class
                :format-control "class not yet defined:~%  ~S" 
                :format-arguments (list name)))))
 (defun (setf find-classoid) (new-value name)
diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 618db15..2000871 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -233,8 +233,7 @@
   "Make an instance of a condition object using the specified initargs."
   ;; Note: ANSI specifies no exceptional situations in this function.
   ;; signalling simple-type-error would not be wrong.
-  (let* ((thing (if (symbolp thing)
-		    (find-classoid thing)
+  (let* ((thing (or (and (symbolp thing) (find-classoid thing nil))
 		    thing))
 	 (class (typecase thing
 		  (condition-classoid thing)
diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 04c893f..7929c03 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -431,8 +431,7 @@
 		 (funcall (get-coerced-cmt-entry char *readtable*)
 			  stream
 			  char))))
-    (when (and retval (not *read-suppress*))
-      (rplacd retval nil))))
+    (if retval (rplacd retval nil))))
 
 (defun read (&optional (stream *standard-input*)
 		       (eof-error-p t)
@@ -465,7 +464,7 @@
   (do ((char (flush-whitespace input-stream)
 	     (flush-whitespace input-stream))
        (retlist ()))
-      ((char= char endchar) (nreverse retlist))
+      ((char= char endchar) (unless *read-suppress* (nreverse retlist)))
     (setq retlist (nconc (read-maybe-nothing input-stream char) retlist))))
 
 ;;;; basic readmacro definitions
diff --git a/tests/condition.pure.lisp b/tests/condition.pure.lisp
index d40cdba..370ce4b 100644
--- a/tests/condition.pure.lisp
+++ b/tests/condition.pure.lisp
@@ -130,10 +130,13 @@
          (multiple-value-bind (res err) 
              (ignore-errors (apply #'error args))
            (assert (not res))
-           (assert (typep err 'type-error)))))
+           (assert (typep err 'type-error))
+           (assert (not (nth-value 1 (ignore-errors 
+                                       (type-error-datum err)))))
+           (assert (not (nth-value 1 (ignore-errors 
+                                       (type-error-expected-type err))))))))
   (test '#:no-such-condition)
   (test nil)
   (test t)
   (test 42)
   (test (make-instance 'standard-object)))
-
diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index 7e964ff..0d22933 100644
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -224,3 +224,7 @@
 (multiple-value-bind (res err) (ignore-errors (read-from-string ""))
   (assert (not res))
   (assert (typep err 'end-of-file)))
+
+(assert (equal '((0 . "A") (1 . "B"))
+               (coerce (read-from-string "#((0 . \"A\") (1 . \"B\"))") 
+                       'list)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 071203e..5852e53 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.4"
+"0.8.16.5"