X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-error.lisp;h=be8c31901e0a5d51a4d7e34d0a9f4efb168f3172;hb=829ced3e78a23ba153ba4db64e6ea6984c2313b6;hp=035d44a81124ab46cacdd73867933df6805bb09c;hpb=8380b5ebecae80cb792805956e80c1fbbcba641f;p=sbcl.git diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp index 035d44a..be8c319 100644 --- a/src/code/target-error.lisp +++ b/src/code/target-error.lisp @@ -131,33 +131,35 @@ with that condition (or with no condition) will be returned." (args (interactive-restart-arguments real-restart))) (apply (restart-function real-restart) args))) -(defun assert-error (assertion places datum &rest arguments) +(defun assert-error (assertion args-and-values places datum &rest arguments) (let ((cond (if datum - (coerce-to-condition datum - arguments - 'simple-error - 'error) - (make-condition 'simple-error - :format-control "The assertion ~S failed." - :format-arguments (list assertion))))) + (coerce-to-condition + datum arguments 'simple-error 'error) + (make-condition + 'simple-error + :format-control "~@" + :format-arguments (list assertion args-and-values))))) (restart-case (error cond) (continue () - :report (lambda (stream) - (format stream "Retry assertion") - (if places - (format stream - " with new value~P for ~{~S~^, ~}." - (length places) - places) - (format stream "."))) - nil)))) + :report (lambda (stream) + (format stream "Retry assertion") + (if places + (format stream " with new value~P for ~{~S~^, ~}." + (length places) places) + (format stream "."))) + nil)))) ;;; 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)