0.8.4.22:

        * Fix problem reported by salex on #lisp: SLOT-VALUE was not
          known to return exactly one value.

NEWS

@@ -2126,6 +2126,8 @@ changes in sbcl-0.8.5 relative to sbcl-0.8.4:
     with values NIL and :ERROR.  (thanks to Milan Zamazal)
   * compiler enhancement: SIGNUM is now better able to derive the type
     of its result.
+  * type declarations inside WITH-SLOTS are checked.  (reported by
+    salex on #lisp)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** incorrect optimization of TRUNCATE for a positive first
        argument and negative second.

package-data-list.lisp-expr

@@ -1925,7 +1925,7 @@ structure representations"
              "CATCH-BLOCK-ENTRY-PC-SLOT" "CATCH-BLOCK-PREVIOUS-CATCH-SLOT"
              "CATCH-BLOCK-SC-NUMBER" "CATCH-BLOCK-SIZE" "CATCH-BLOCK-SIZE-SLOT"
              "CATCH-BLOCK-TAG-SLOT" "CERROR-TRAP"
-             "CLOSURE-FUN-HEADER-WIDETAG" "CLOSURE-FUN-SLOT"
+             "CLOSURE-FUN-SLOT"
              "CLOSURE-HEADER-WIDETAG" "CLOSURE-INFO-OFFSET"
              "CODE-CODE-SIZE-SLOT" "CODE-CONSTANTS-OFFSET"
              "CODE-DEBUG-INFO-SLOT" "CODE-ENTRY-POINTS-SLOT"

src/pcl/slots-boot.lisp

@@ -94,7 +94,8 @@
     `(let ((.ignore. (load-time-value
 		      (ensure-accessor 'reader ',reader-name ',slot-name))))
       (declare (ignore .ignore.))
-      (funcall #',reader-name ,object))))
+      (truly-the (values t &optional)
+                 (funcall #',reader-name ,object)))))
 
 (defmacro accessor-set-slot-value (object slot-name new-value &environment env)
   (aver (constantp slot-name))

src/pcl/slots.lisp

@@ -80,6 +80,7 @@
     (when (eql slot-name (slot-definition-name slot))
       (return slot))))
 
+(declaim (ftype (sfunction (t symbol) t) slot-value))
 (defun slot-value (object slot-name)
   (let* ((class (class-of object))
 	 (slot-definition (find-slot-definition class slot-name)))
@@ -279,7 +280,7 @@
 	 (value (funcall function object)))
     (declare (type function function))
     (if (eq value +slot-unbound+)
-	(slot-unbound class object (slot-definition-name slotd))
+	(values (slot-unbound class object (slot-definition-name slotd)))
 	value)))
 
 (defmethod (setf slot-value-using-class)

tests/clos.impure.lisp

@@ -683,5 +683,22 @@
   (list x y))
 (assert (equal (bug262 1 2) '(1 2)))
 
+;;; salex on #lisp 2003-10-13 reported that type declarations inside
+;;; WITH-SLOTS are too hairy to be checked
+(defun ensure-no-notes (form)
+  (handler-case (compile nil `(lambda () ,form))
+    (sb-ext:compiler-note (c)
+      ;; FIXME: it would be better to check specifically for the "type
+      ;; is too hairy" note
+      (error c))))
+(defvar *x*)
+(ensure-no-notes '(with-slots (a) *x*
+                   (declare (integer a))
+                   a))
+(ensure-no-notes '(with-slots (a) *x*
+                   (declare (integer a))
+                   (declare (notinline slot-value))
+                   a))
+
 ;;;; success
 (sb-ext:quit :unix-status 104)

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.4.21"
+"0.8.4.22"