X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcondition.lisp;h=ee00b04325d42faa6dba35968f8885b760a716b9;hb=c40c56eedec692acb930ec0e358a933ab33a3560;hp=f9909cbed3dfee059725652084634e8fb8245d5b;hpb=2a1df4bcc815f763fac346f32fbe535b39a0d2e1;p=sbcl.git

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index f9909cb..ee00b04 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -171,7 +171,10 @@
 ;;; The current code doesn't seem to quite match that.
 (def!method print-object ((x condition) stream)
   (if *print-escape*
-      (print-unreadable-object (x stream :type t :identity t))
+      (if (and (typep x 'simple-condition) (slot-boundp x 'format-control))
+          (print-unreadable-object (x stream :type t :identity t)
+            (format stream "~S" (simple-condition-format-control x)))
+          (print-unreadable-object (x stream :type t :identity t)))
       ;; KLUDGE: A comment from CMU CL here said
       ;;   7/13/98 BUG? CPL is not sorted and results here depend on order of
       ;;   superclasses in define-condition call!
@@ -943,6 +946,9 @@
 (define-condition type-warning (reference-condition simple-warning)
   ()
   (:default-initargs :references (list '(:sbcl :node "Handling of Types"))))
+(define-condition type-style-warning (reference-condition simple-style-warning)
+  ()
+  (:default-initargs :references (list '(:sbcl :node "Handling of Types"))))
 
 (define-condition local-argument-mismatch (reference-condition simple-warning)
   ()