Changeset 15303


Ignore:
Timestamp:
Apr 8, 2012, 9:04:47 PM (8 years ago)
Author:
gb
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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-error-system.lisp

    r15302 r15303  
    662662   associated with that condition (or with no condition) will be
    663663   returned."
    664   (dolist (cluster %restarts%)
    665     (dolist (restart cluster)
    666       (when (and (or (eq restart name) (eq (restart-name restart) name))
    667                  (applicable-restart-p restart condition))
    668         (return-from find-restart restart)))))
     664  (if (typep name 'restart)
     665    (dolist (cluster %restarts%)
     666      (dolist (restart cluster)
     667        (if (eq restart name)
     668          (return-from find-restart restart))))
     669    (dolist (cluster %restarts%)
     670      (dolist (restart cluster)
     671        (when (and (eq (restart-name restart) name)
     672                   (applicable-restart-p restart condition))
     673          (return-from find-restart restart))))))
    669674
    670675(defun %active-restart (name)
     
    672677    (dolist (restart cluster)
    673678      (when (or (eq restart name)
    674                 (let* ((rname (%restart-name restart))
    675                        (rtest (%restart-test restart)))
     679                (let* ((rname (%restart-name restart)))
    676680                  (and (eq rname name)
    677                        (or (null rtest) (funcall rtest nil)))))
     681                       (applicable-restart-p restart nil))))
    678682                (return-from %active-restart (values restart cluster)))))
    679683  (error 'inactive-restart :restart-name name))
     
    704708   necessary arguments. If the argument restart is not a restart or a
    705709   currently active non-NIL restart name, then a CONTROL-ERROR is signalled."
    706   (let* ((restart (find-restart restart)))
     710  (let* ((restart (%active-restart restart)))
    707711    (format *error-output* "~&Invoking restart: ~a~&" restart)
    708712    (let* ((argfn (%restart-interactive restart))
Note: See TracChangeset for help on using the changeset viewer.