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 (file)
--- 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)