(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)
\f
;;; FIXME: AMOP says that allocate-instance imples finalize-inheritance
;;; if the class is not yet finalized, but we don't seem to be taking
-;;; care of this for non-standard-classes.x
+;;; care of this for non-standard-classes.
(defmethod allocate-instance ((class standard-class) &rest initargs)
(declare (ignore initargs))
(unless (class-finalized-p class)
(funcall constructor)
(error "Don't know how to allocate ~S" class))))
-;;; FIXME: It would be nicer to have allocate-instance return
-;;; uninitialized objects for conditions as well.
(defmethod allocate-instance ((class condition-class) &rest initargs)
(declare (ignore initargs))
- (make-condition (class-name class)))
+ (allocate-condition (class-name class)))
(defmethod allocate-instance ((class built-in-class) &rest initargs)
(declare (ignore initargs))