X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ferror.lisp;h=86e41d125096fc22e6ca1420e2c33c5815a2038d;hb=dfe6138af5c38d92568b6dac48e852c01be0ec8e;hp=b80994e56d87a48c1ac5db9b1011f9130259524b;hpb=c2fd998cbeea4a2049e8b77bf36c6e478ebb7d44;p=sbcl.git diff --git a/src/code/error.lisp b/src/code/error.lisp index b80994e..86e41d1 100644 --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -17,23 +17,24 @@ (defun style-warn (format-control &rest format-arguments) (/show0 "entering STYLE-WARN") (/show format-control format-arguments) - (warn 'simple-style-warning - :format-control format-control - :format-arguments format-arguments)) + (with-sane-io-syntax + (warn 'simple-style-warning + :format-control format-control + :format-arguments format-arguments))) ;;; a utility for SIGNAL, ERROR, CERROR, WARN, COMPILER-NOTIFY and ;;; INVOKE-DEBUGGER: Parse the hairy argument conventions into a ;;; single argument that's directly usable by all the other routines. (defun coerce-to-condition (datum arguments default-type fun-name) (cond ((typep datum 'condition) - (if arguments - (cerror "Ignore the additional arguments." - 'simple-type-error - :datum arguments - :expected-type 'null - :format-control "You may not supply additional arguments ~ - when giving ~S to ~S." - :format-arguments (list datum fun-name))) + (when (and arguments (not (eq fun-name 'cerror))) + (cerror "Ignore the additional arguments." + 'simple-type-error + :datum arguments + :expected-type 'null + :format-control "You may not supply additional arguments ~ + when giving ~S to ~S." + :format-arguments (list datum fun-name))) datum) ((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION) (apply #'make-condition datum arguments)) @@ -75,8 +76,8 @@ (source :initarg :source :reader program-error-source)) (:report (lambda (condition stream) (format stream "Execution of a form compiled with errors.~%~ - Form:~% ~A~%~ - Compile-time-error:~% ~A" + Form:~% ~A~%~ + Compile-time-error:~% ~A" (program-error-source condition) (program-error-message condition)))))