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