0.9.5.83: almost fix COMPUTE-RESTARTS & FIND-RESTART

 * back out the previous change to COMPUTE-RESTARTS.
 * make FIND-RESTART check the activity, not applicability, of a restart object
   passed in as an argument.

 => now both the Helmut Eller's case and ansi-tests pass.

 Although: I dispute COMPUTE-RESTARTS.10 and RESTART-BIND.20. See emails to
 sbcl-devel around Sun, 16 Oct 2005 13:12. The more radical changes outlined there
 are not part of this yet.

diff --git a/NEWS b/NEWS
index 708ab1c..77dd7fb 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -12,9 +12,8 @@ changes in sbcl-0.9.6 relative to sbcl-0.9.5:
     on platforms supporting dynamic-extent allocation.
   * enhancement: saving cores with foreign code loaded is now supported
     on MIPS/Linux in addition to the previously supported platforms.
-  * bug fix: COMPUTE-RESTARTS returns all active restarts, including those
-    with :TEST, when called without a condition. (reported by Helmut Eller for
-    CMUCL)
+  * bug fix: FIND-RESTART now tests for activity, not applicability when given
+    a restart object as identifier. (reported by Helmut Eller for CMUCL)
   * bug fix: division by zero in sb-sprof when no samples were collected
   * bug fix: a race when a slow to arrive sigprof signal killed sbcl
   * bug fix: asdf-install uses CRLF as required by the HTTP spec.

diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp
index f7d43cb..2f6d3fc 100644 (file)
--- a/src/code/target-error.lisp
+++ b/src/code/target-error.lisp
@@ -35,10 +35,9 @@
 
 (defun compute-restarts (&optional condition)
   #!+sb-doc
-  "Return a list of all the currently active restarts ordered from most
-   recently established to less recently established. If CONDITION is
-   specified, then only restarts associated with CONDITION (or with no
-   condition) will be returned."
+  "Return a list of all the currently active restarts ordered from most recently
+established to less recently established. If CONDITION is specified, then only
+restarts associated with CONDITION (or with no condition) will be returned."
   (let ((associated ())
         (other ()))
     (dolist (alist *condition-restarts*)
@@ -51,9 +50,7 @@
           (when (and (or (not condition)
                          (member restart associated)
                          (not (member restart other)))
-                     (or (not condition)
-                         (funcall (restart-test-function restart)
-                                  condition)))
+                     (funcall (restart-test-function restart) condition))
             (res restart))))
       (res))))
 
@@ -69,19 +66,18 @@
                        (format stream "~S" restart)))))
            stream))
 
-(defun find-restart (name &optional condition)
+(defun find-restart (identifier &optional condition)
   #!+sb-doc
-  "Return the first restart named NAME. If NAME names a restart, the restart
-   is returned if it is currently active. If no such restart is found, NIL is
-   returned. It is an error to supply NIL as a name. If CONDITION is specified
-   and not NIL, then only restarts associated with that condition (or with no
-   condition) will be returned."
-  (let ((restarts (compute-restarts condition)))
-    (declare (type list restarts))
-    (find-if (lambda (x)
-               (or (eq x name)
-                   (eq (restart-name x) name)))
-             restarts)))
+  "Return the first restart identified by IDENTIFIER. If IDENTIFIER is a symbol,
+then the innermost applicable restart with that name is returned. If IDENTIFIER
+is a restart, it is returned if it is currently active. Otherwise NIL is
+returned. If CONDITION is specified and not NIL, then only restarts associated
+with that condition (or with no condition) will be returned."
+  ;; see comment above
+  (if (typep identifier 'restart)
+      (and (find-if (lambda (cluster) (find identifier cluster)) *restart-clusters*)
+           identifier)
+      (find identifier (compute-restarts condition) :key #'restart-name)))
 
 ;;; helper for the various functions which are ANSI-spec'ed to do
 ;;; something with a restart or signal CONTROL-ERROR if there is none

diff --git a/tests/condition.impure.lisp b/tests/condition.impure.lisp
index 07b41e0..4cb5abe 100644 (file)
--- a/tests/condition.impure.lisp
+++ b/tests/condition.impure.lisp
@@ -54,7 +54,19 @@
         (assert (eq (car (compute-restarts)) (car (compute-restarts c))))))
   (picky-restart ()
     :report "Do nothing."
-    :test (lambda (c) (typep c 'picky-condition))
+    :test (lambda (c)
+            (typep c '(or null picky-condition)))
     'ok))
 
+;;; adapted from Helmut Eller on cmucl-imp
+(assert (eq 'it
+            (restart-case
+                (handler-case
+                    (error 'picky-condition)
+                  (picky-condition (c)
+                    (invoke-restart (find-restart 'give-it c))))
+              (give-it ()
+                :test (lambda (c) (typep c 'picky-condition))
+                'it))))
+
 ;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index 302dda0..d8e6565 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.5.82"
+"0.9.5.83"