X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-error.lisp;h=e43114621314c8ad5d7a904e79258ef7b973481a;hb=a6a12ed609d5467ec43b411283e5b3568fee81df;hp=659ed28d8ad93b490c670fe96e5c01c5c20f1e76;hpb=b0f607ac03cbabb039319ea983665cdc1e38a2a6;p=sbcl.git

diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp
index 659ed28..e431146 100644
--- a/src/code/target-error.lisp
+++ b/src/code/target-error.lisp
@@ -156,8 +156,12 @@ with that condition (or with no condition) will be returned."
 ;;; READ-EVALUATED-FORM is used as the interactive method for restart cases
 ;;; setup by the Common Lisp "casing" (e.g., CCASE and CTYPECASE) macros
 ;;; and by CHECK-TYPE.
-(defun read-evaluated-form ()
-  (format *query-io* "~&Type a form to be evaluated:~%")
+(defun read-evaluated-form (&optional (prompt-control nil promptp)
+                            &rest prompt-args)
+  (apply #'format *query-io*
+         (if promptp prompt-control "~&Type a form to be evaluated: ")
+         prompt-args)
+  (finish-output *query-io*)
   (list (eval (read *query-io*))))
 
 (defun check-type-error (place place-value type type-string)
@@ -176,6 +180,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