Commit 3abdab00 authored by Alexey Dejneka's avatar Alexey Dejneka
Browse files

0.8.4.22:

        * Fix problem reported by salex on #lisp: SLOT-VALUE was not
          known to return exactly one value.
parent c6b35dc7
Loading
Loading
Loading
Loading
+2 −0
Original line number Diff line number Diff line
@@ -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.
+1 −1
Original line number Diff line number Diff line
@@ -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"
+2 −1
Original line number Diff line number Diff line
@@ -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))
+2 −1
Original line number Diff line number Diff line
@@ -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)
+17 −0
Original line number Diff line number Diff line
@@ -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)
Loading