Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv22296

Modified Files:
	version.lisp-expr 
Log Message:
1.0.43.41: TYPE-ERROR printing tweak for *PRINT-ESCAPE* = T

 Print as #<TYPE-ERROR exptected-type: SOME-TYPE datum: SOME-DATUM> when
 possible.

 Virtually every time I see a TYPE-ERROR printed with *PRINT-ESCAPE* =
 T I need to go look for the place where it is printed in order to see
 what the actual problem is -- and I don't think I'm the only one.

 This is hopefully one annoyance less.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.5067
retrieving revision 1.5068
diff -u -d -r1.5067 -r1.5068
--- version.lisp-expr	10 Oct 2010 00:34:11 -0000	1.5067
+++ version.lisp-expr	11 Oct 2010 14:29:13 -0000	1.5068
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.43.40"
+"1.0.43.41"

Update of /cvsroot/sbcl/sbcl/src/code
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv22296/src/code

Modified Files:
	condition.lisp 
Log Message:
1.0.43.41: TYPE-ERROR printing tweak for *PRINT-ESCAPE* = T

 Print as #<TYPE-ERROR exptected-type: SOME-TYPE datum: SOME-DATUM> when
 possible.

 Virtually every time I see a TYPE-ERROR printed with *PRINT-ESCAPE* =
 T I need to go look for the place where it is printed in order to see
 what the actual problem is -- and I don't think I'm the only one.

 This is hopefully one annoyance less.


Index: condition.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/condition.lisp,v
retrieving revision 1.108
retrieving revision 1.109
diff -u -d -r1.108 -r1.109
--- condition.lisp	19 Sep 2010 20:08:47 -0000	1.108
+++ condition.lisp	11 Oct 2010 14:29:14 -0000	1.109
@@ -620,6 +620,19 @@
              (type-error-datum condition)
              (type-error-expected-type condition)))))
 
+(def!method print-object ((condition type-error) stream)
+  (if *print-escape*
+      (flet ((maybe-string (thing)
+               (ignore-errors
+                 (write-to-string thing :lines 1 :readably nil :array nil :pretty t))))
+        (let ((type (maybe-string (type-error-expected-type condition)))
+              (datum (maybe-string (type-error-datum condition))))
+          (if (and type datum)
+              (print-unreadable-object (condition stream :type t)
+                (format stream "~@<expected-type: ~A ~_datum: ~A~:@>" type datum))
+              (call-next-method))))
+      (call-next-method)))
+
 ;;; not specified by ANSI, but too useful not to have around.
 (define-condition simple-style-warning (simple-condition style-warning) ())
 (define-condition simple-type-error (simple-condition type-error) ())