X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-error.lisp;h=035d44a81124ab46cacdd73867933df6805bb09c;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=845c64708ec95da0698cd0d8beddf279bd5fd5da;hpb=6822034325136cde4e14773c83c3769b42721306;p=sbcl.git

diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp
index 845c647..035d44a 100644
--- a/src/code/target-error.lisp
+++ b/src/code/target-error.lisp
@@ -19,12 +19,13 @@
 ;;; associated with Condition
 (defvar *condition-restarts* ())
 
+(defun muffle-warning-p (warning)
+  (declare (special *muffled-warnings*))
+  (typep warning *muffled-warnings*))
+
 (defun initial-handler-clusters ()
   `(((warning . ,#'(lambda (warning)
-                     (when (typep warning
-                                  (locally
-                                      (declare (special sb!ext:*muffled-warnings*))
-                                    sb!ext:*muffled-warnings*))
+                     (when (muffle-warning-p warning)
                        (muffle-warning warning)))))))
 
 (defvar *handler-clusters* (initial-handler-clusters))
@@ -175,6 +176,15 @@ with that condition (or with no condition) will be returned."
         :interactive read-evaluated-form
         value))))
 
+(defun case-failure (name value keys)
+  (error 'case-failure
+         :name name
+         :datum value
+         :expected-type (if (eq name 'ecase)
+                            `(member ,@keys)
+                            `(or ,@keys))
+         :possibilities keys))
+
 (defun case-body-error (name keyform keyform-value expected-type keys)
   (restart-case
       (error 'case-failure