0.pre8.18:

	Fix a couple of condition system bugs from the test suite
	... slot access in the presence of multiple initargs;
	... USE-VALUE and friends in the presence of multiple restarts
		of the same name where some are associated with other
		conditions.

diff --git a/NEWS b/NEWS
index 34505a7..93dbf0b 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1636,6 +1636,11 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** COPY-ALIST now signals an error if its argument is a dotted
        list;
+    ** condition slots are now accessed more correctly in the presence
+       of multiple initargs for a given slot;
+    ** the USE-VALUE, CONTINUE and STORE-VALUE functions now correctly
+       exclude restarts of the same name associated with a different
+       condition;
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 07393fa..5feeb73 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -206,7 +206,6 @@
       (when (eq (condition-slot-name cslot) name)
        (return-from condition-reader-function
                     (car (condition-slot-cell cslot)))))
-
     (let ((val (getf (condition-assigned-slots condition) name
                     *empty-condition-slot*)))
       (if (eq val *empty-condition-slot*)
@@ -214,17 +213,15 @@
                (slot (find-condition-class-slot class name)))
             (unless slot
              (error "missing slot ~S of ~S" name condition))
-           (dolist (initarg (condition-slot-initargs slot))
-             (let ((val (getf actual-initargs
-                              initarg
-                              *empty-condition-slot*)))
-               (unless (eq val *empty-condition-slot*)
-                 (return-from condition-reader-function
-                              (setf (getf (condition-assigned-slots condition)
-                                          name)
-                                    val)))))
-           (setf (getf (condition-assigned-slots condition) name)
-                 (find-slot-default class slot)))
+           (do ((initargs actual-initargs (cddr initargs)))
+               ((endp initargs)
+                (setf (getf (condition-assigned-slots condition) name)
+                      (find-slot-default class slot)))
+             (when (member (car initargs) (condition-slot-initargs slot))
+               (return-from condition-reader-function
+                 (setf (getf (condition-assigned-slots condition)
+                             name)
+                       (cadr initargs))))))
          val))))
 \f
 ;;;; MAKE-CONDITION
@@ -866,8 +863,9 @@
                #!+sb-doc ,doc
                ;; FIXME: Perhaps this shared logic should be pulled out into
                ;; FLET MAYBE-INVOKE-RESTART? See whether it shrinks code..
-               (when (find-restart ',name condition)
-                 (invoke-restart ',name ,@args)))))
+               (let ((restart (find-restart ',name condition)))
+                 (when restart
+                   (invoke-restart restart ,@args))))))
   (define-nil-returning-restart continue ()
     "Transfer control to a restart named CONTINUE, or return NIL if none exists.")
   (define-nil-returning-restart store-value (value)

diff --git a/version.lisp-expr b/version.lisp-expr
index 975ce35..8c2cf77 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre8.17"
+"0.pre8.18"