From: William Harold Newman <william.newman@airmail.net>
Date: Mon, 30 Jun 2003 19:28:17 +0000 (+0000)
Subject: 0.8.1.12:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=24bee0f055e15d6ad6b1ef37c5013b462ba2a877;p=sbcl.git

0.8.1.12:
	minor ANSI-compliance fix: CONTROL-ERROR from failed
		MUFFLE-WARNING (caught by clocc-ansi-test)
	centralized FIND-RESTART-OR-CONTROL-ERROR logic more than
		before
---

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index ce17c06..114def3 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -884,6 +884,7 @@ retained, possibly temporariliy, because it might be used internally."
              "EVAL-IN-LEXENV"
 	     "DEBUG-NAMIFY"
              "FORCE" "DELAY" "PROMISE-READY-P"
+	     "FIND-RESTART-OR-CONTROL-ERROR"
 
              ;; These could be moved back into SB!EXT if someone has
              ;; compelling reasons, but hopefully we can get by
diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 0b2b49b..62b7465 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -875,7 +875,7 @@
   #!+sb-doc
   "Transfer control to a restart named ABORT, signalling a CONTROL-ERROR if
    none exists."
-  (invoke-restart (find-restart 'abort condition))
+  (invoke-restart (find-restart-or-control-error 'abort condition))
   ;; ABORT signals an error in case there was a restart named ABORT
   ;; that did not transfer control dynamically. This could happen with
   ;; RESTART-BIND.
@@ -885,7 +885,7 @@
   #!+sb-doc
   "Transfer control to a restart named MUFFLE-WARNING, signalling a
    CONTROL-ERROR if none exists."
-  (invoke-restart (find-restart 'muffle-warning condition)))
+  (invoke-restart (find-restart-or-control-error 'muffle-warning condition)))
 
 (macrolet ((define-nil-returning-restart (name args doc)
 	     #!-sb-doc (declare (ignore doc))
diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp
index fc61108..4c8eb83 100644
--- a/src/code/target-error.lisp
+++ b/src/code/target-error.lisp
@@ -82,21 +82,21 @@
                    (eq (restart-name x) name)))
              restarts)))
 
-(defun find-restart-or-lose (restart-designator)
-  (let ((real-restart (find-restart restart-designator)))
-    (unless real-restart
+;;; helper for the various functions which are ANSI-spec'ed to do
+;;; something with a restart or signal CONTROL-ERROR if there is none
+(defun find-restart-or-control-error (identifier &optional condition)
+  (or (find-restart identifier condition)
       (error 'simple-control-error
-	     :format-control "Restart ~S is not active."
-	     :format-arguments (list restart-designator)))
-    real-restart))
+	     :format-control "No restart ~S is active ~{for ~S~}."
+	     :format-arguments (list identifier condition))))
 
 (defun invoke-restart (restart &rest values)
   #!+sb-doc
   "Calls the function associated with the given restart, passing any given
    arguments. If the argument restart is not a restart or a currently active
-   non-nil restart name, then a control-error is signalled."
+   non-nil restart name, then a CONTROL-ERROR is signalled."
   (/show "entering INVOKE-RESTART" restart)
-  (let ((real-restart (find-restart-or-lose restart)))
+  (let ((real-restart (find-restart-or-control-error restart)))
     (apply (restart-function real-restart) values)))
 
 (defun interactive-restart-arguments (real-restart)
@@ -109,8 +109,8 @@
   #!+sb-doc
   "Calls the function associated with the given restart, prompting for any
    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* ((real-restart (find-restart-or-lose restart))
+   currently active non-NIL restart name, then a CONTROL-ERROR is signalled."
+  (let* ((real-restart (find-restart-or-control-error restart))
 	 (args (interactive-restart-arguments real-restart)))
     (apply (restart-function real-restart) args)))
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 2965c2a..b2e1faa 100644
--- 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.8.1.11"
+"0.8.1.12"