From 47396cc92c75ca054881fce899c68ec930b7fd13 Mon Sep 17 00:00:00 2001 From: gerd <gerd> Date: Mon, 10 Mar 2003 11:29:02 +0000 Subject: [PATCH] * compiler/ir1util.lisp (print-error-message): Don't treat all subtypes of SIMPLE-CONDITION like a SIMPLE-CONDITION, because that ignores report functions of the subtypes. Instead, recognize conditions of the exact type SIMPLE-WARNING, SIMPLE-ERROR, and SIMPLE-STYLE-WARNING. --- compiler/ir1util.lisp | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler/ir1util.lisp b/compiler/ir1util.lisp index 44d86c033..389a83fef 100644 --- a/compiler/ir1util.lisp +++ b/compiler/ir1util.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.87 2003/01/06 15:10:17 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.88 2003/03/10 11:29:02 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1848,14 +1848,14 @@ (let ((*print-level* (or *error-print-level* *print-level*)) (*print-length* (or *error-print-length* *print-length*)) (*print-lines* (or *error-print-lines* *print-lines*))) - (multiple-value-bind - (format-string format-args) - (if (typep condition 'simple-condition) + (multiple-value-bind (format-string format-args) + (if (member (type-of condition) + '(simple-warning simple-error simple-style-warning) + :test #'eq) (values (simple-condition-format-control condition) (simple-condition-format-arguments condition)) - (values (with-output-to-string (s) - (princ condition s)) - ())) + (values "~a" + (with-output-to-string (s) (princ condition s)))) (let ((stream *compiler-error-output*) (context (find-error-context format-args))) (cond -- GitLab