From: Alexey Dejneka <adejneka@comail.ru>
Date: Tue, 14 Oct 2003 07:31:04 +0000 (+0000)
Subject: 0.8.4.22:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=3abdab003d4cdb02d7386dcd4bc8d9ac4dafb359;p=sbcl.git

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

diff --git a/NEWS b/NEWS
index f5654b9..7e85de9 100644
--- a/NEWS
+++ b/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.
diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index e162d8e..a7d35a3 100644
--- a/package-data-list.lisp-expr
+++ b/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"
diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp
index dc46d56..0d3b707 100644
--- a/src/pcl/slots-boot.lisp
+++ b/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))
diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp
index 2c058c0..69232a7 100644
--- a/src/pcl/slots.lisp
+++ b/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)
diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 405a219..da5e1aa 100644
--- a/tests/clos.impure.lisp
+++ b/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)
diff --git a/version.lisp-expr b/version.lisp-expr
index 6e2765f..20bd12d 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.4.21"
+"0.8.4.22"