Changeset 15303

Timestamp:

Apr 8, 2012, 2:04:47 PM (13 years ago)

Author:

Gary Byers

Message:

FIND-RESTART: if argument is a RESTART (rather than a symbol that
might name one), don't worry about whether it's applicable (just return
it if it's active.) Someone was arguing vehemently that this was wrong
a few years ago, IIRC.

In %ACTIVE-RESTART, use APPLICABLE-RESTART-P.

In INVOKE-RESTART-INTERACTIVELY, call %ACTIVE-RESTART (which signals
a CONTROL-ERROR rather than indirecting through NIL if the restart
isn't found.)

Fixes ticket:949 in the trunk.

File:

• trunk/source/level-1/l1-error-system.lisp (modified) (3 diffs)

trunk/source/level-1/l1-error-system.lisp

@@ -662 +662 @@
    associated with that condition (or with no condition) will be
    returned."
-  (dolist (cluster %restarts%)
-    (dolist (restart cluster)
-      (when (and (or (eq restart name) (eq (restart-name restart) name))
-                 (applicable-restart-p restart condition))
-        (return-from find-restart restart)))))
+  (if (typep name 'restart)
+    (dolist (cluster %restarts%)
+      (dolist (restart cluster)
+        (if (eq restart name)
+          (return-from find-restart restart))))
+    (dolist (cluster %restarts%)
+      (dolist (restart cluster)
+        (when (and (eq (restart-name restart) name)
+                   (applicable-restart-p restart condition))
+          (return-from find-restart restart))))))
 
 (defun %active-restart (name)
@@ -672 +677 @@
     (dolist (restart cluster)
       (when (or (eq restart name)
-                (let* ((rname (%restart-name restart))
-                       (rtest (%restart-test restart)))
+                (let* ((rname (%restart-name restart)))
                   (and (eq rname name)
-                       (or (null rtest) (funcall rtest nil)))))
+                       (applicable-restart-p restart nil))))
                 (return-from %active-restart (values restart cluster)))))
   (error 'inactive-restart :restart-name name))
@@ -704 +708 @@
    necessary arguments. If the argument restart is not a restart or a
    currently active non-NIL restart name, then a CONTROL-ERROR is signalled."
-  (let* ((restart (find-restart restart)))
+  (let* ((restart (%active-restart restart)))
     (format *error-output* "~&Invoking restart: ~a~&" restart)
     (let* ((argfn (%restart-interactive restart))