From: Attila Lendvai <attila.lendvai@gmail.com>
Date: Sun, 2 Jan 2011 15:41:47 +0000 (+0100)
Subject: Make the printing of a slot-unbound error more error tolerant.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=41791073db3aa668ad5699598edcb567d4eed966;p=sbcl.git

Make the printing of a slot-unbound error more error tolerant.

Especially against errors coming from custom PRINT-OBJECT methods, in which
case only print the TYPE-OF the instance. Also, print fully qualified
symbol names.

Slightly modified by Paul Khuong.
---

diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp
index 71746aa..2ae32b0 100644
--- a/src/pcl/slots.lisp
+++ b/src/pcl/slots.lisp
@@ -28,9 +28,19 @@
 (define-condition unbound-slot (cell-error)
   ((instance :reader unbound-slot-instance :initarg :instance))
   (:report (lambda (condition stream)
-             (format stream "The slot ~S is unbound in the object ~S."
-                     (cell-error-name condition)
-                     (unbound-slot-instance condition)))))
+             (handler-case
+                 (format stream "~@<The slot ~/sb-ext:print-symbol-with-prefix/ ~
+                         is unbound in the object ~A.~@:>"
+                         (cell-error-name condition)
+                         (unbound-slot-instance condition))
+               (serious-condition ()
+                 ;; In case of an error try again avoiding custom PRINT-OBJECT's.
+                 (format stream "~&Error during printing.~%~@<The slot ~
+                         ~/sb-ext:print-symbol-with-prefix/ ~
+                         is unbound in an instance of ~
+                         ~/sb-ext:print-symbol-with-prefix/.~@:>"
+                         (cell-error-name condition)
+                         (type-of (unbound-slot-instance condition))))))))
 
 (defmethod wrapper-fetcher ((class standard-class))
   'std-instance-wrapper)