0.9.2.23: ansi fixes

 * fill slots in TYPE-ERRORs from COERCE.
 * classes are type designators and must be accepted by MAKE-CONDITION.
 * MULTIPLE-VALUE-SETQ returns the primary value of the values form.
 * COMPILE must not return NIL.

diff --git a/NEWS b/NEWS
index 68cf096..bc4b411 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -14,6 +14,7 @@ changes in sbcl-0.9.3 relative to sbcl-0.9.2:
   * bug fix: out-of-line SB-SYS:FOREIGN-SYMBOL-ADDRESS did not work
     for variables on SBCL built with linkage-tables. (reported by Luis
     Oliveira)
+  * various error reporting improvements.
   * optimizations: LOGNOR on fixnums is improved in the MIPS backend.
     (Thanks to Thiemo Seufer)
   * threads
@@ -24,6 +25,13 @@ changes in sbcl-0.9.3 relative to sbcl-0.9.2:
        starting up or going down
     ** bug fix: a race where an exiting thread could lose its stack to gc
     ** fixed numerous gc deadlocks introduced in the pthread merge
+  * fixed some bugs revealed by Paul Dietz' test suite:
+    ** TYPE-ERRORs from signalled by COERCE now have DATUM and
+       EXPECTED-TYPE slots filled.
+    ** MULTIPLE-VALUE-SETQ always returns the primary value of the
+       values form.
+    ** MAKE-CONDITION accepts classes as type-designators.
+    ** COMPILE may never return NIL.
 
 changes in sbcl-0.9.2 relative to sbcl-0.9.1:
   * numerous signal handling fixes to increase stability

diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index 59bd1da..13762a3 100644 (file)
--- a/src/code/coerce.lisp
+++ b/src/code/coerce.lisp
@@ -106,7 +106,9 @@
           (/show0 "entering COERCE-ERROR")
           (error 'simple-type-error
                  :format-control "~S can't be converted to type ~S."
-                 :format-arguments (list object output-type-spec))))
+                 :format-arguments (list object output-type-spec)
+                 :datum object
+                 :expected-type output-type-spec)))
     (let ((type (specifier-type output-type-spec)))
       (cond
        ((%typep object output-type-spec)

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index b89d6d8..ea93f2a 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -248,27 +248,30 @@
 \f
 ;;;; MAKE-CONDITION
 
-(defun make-condition (thing &rest args)
+(defun make-condition (type &rest args)
   #!+sb-doc
   "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 (or (and (symbolp thing) (find-classoid thing nil))
-                   thing))
-        (class (typecase thing
-                 (condition-classoid thing)
+  (let* ((type (or (and (symbolp type) (find-classoid type nil))
+                   type))
+        (class (typecase type
+                 (condition-classoid type)
+                 (class
+                  ;; Punt to CLOS.
+                  (return-from make-condition (apply #'make-instance type args)))
                  (classoid
                   (error 'simple-type-error
-                         :datum thing
+                         :datum type
                          :expected-type 'condition-class
                          :format-control "~S is not a condition class."
-                         :format-arguments (list thing)))
+                         :format-arguments (list type)))
                  (t
                   (error 'simple-type-error
-                         :datum thing
+                         :datum type
                          :expected-type 'condition-class
-                         :format-control "bad thing for class argument:~%  ~S"
-                         :format-arguments (list thing)))))
+                         :format-control "Bad type argument:~%  ~S"
+                         :format-arguments (list type)))))
         (res (make-condition-object args)))
     (setf (%instance-layout res) (classoid-layout class))
     ;; Set any class slots with initargs present in this call.

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index c505819..43ad076 100644 (file)
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -50,7 +50,13 @@
 (defmacro-mundanely multiple-value-setq (vars value-form)
   (unless (list-of-symbols-p vars)
     (error "Vars is not a list of symbols: ~S" vars))
-  `(values (setf (values ,@vars) ,value-form)))
+  ;; MULTIPLE-VALUE-SETQ is required to always return just the primary
+  ;; value of the value-from, even if there are no vars. (SETF VALUES)
+  ;; in turn is required to return as many values as there are
+  ;; value-places, hence this:
+  (if vars
+      `(values (setf (values ,@vars) ,value-form))
+      `(values ,value-form)))
 
 (defmacro-mundanely multiple-value-list (value-form)
   `(multiple-value-call #'list ,value-form))

diff --git a/src/compiler/target-main.lisp b/src/compiler/target-main.lisp
index 5d81a45..a02797b 100644 (file)
--- a/src/compiler/target-main.lisp
+++ b/src/compiler/target-main.lisp
@@ -114,4 +114,15 @@
   otherwise THING is NAME. When NAME is not NIL, the compiled function
   is also set into (MACRO-FUNCTION NAME) if NAME names a macro, or into
   (FDEFINITION NAME) otherwise."
-  (compile-in-lexenv name definition (make-null-lexenv)))
+  (multiple-value-bind (function warnings-p failure-p) 
+      (compile-in-lexenv name definition (make-null-lexenv))
+    (values (or function
+               name
+               (lambda (&rest arguments)
+                 (error 'simple-program-error
+                        :format-control 
+                        "Called function compiled with errors. Original ~
+                          definition:~%  ~S~@[~%Arguments:~% ~{ ~S~}~]"
+                        :format-arguments (list definition arguments))))
+           warnings-p
+           failure-p)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 8a2ed6d..cb1893a 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.9.2.22"
+"0.9.2.23"