interaction of print-object with class-prototype breaks inspector, describe

[xristos]

This is similar to #310101

CL-USER> (defclass test-class ()
           ((a1 :initform nil)))
#<STANDARD-CLASS TEST-CLASS>

CL-USER> (sb-mop:finalize-inheritance *)
NIL

CL-USER> (inspect (find-class 'test-class))
The object is a STANDARD-OBJECT of type STANDARD-CLASS.
0. %TYPE: (CLASS #<STANDARD-CLASS TEST-CLASS>)
1. SOURCE: #S(SB-C:DEFINITION-SOURCE-LOCATION
              :NAMESTRING NIL
              :TOPLEVEL-FORM-NUMBER NIL
              :PLIST NIL)
2. PLIST: NIL
3. NAME: TEST-CLASS
4. CLASS-EQ-SPECIALIZER: #<SB-PCL::CLASS-EQ-SPECIALIZER {12669139}>
5. DIRECT-SUPERCLASSES: (#<STANDARD-CLASS STANDARD-OBJECT>)
6. DIRECT-SUBCLASSES: NIL
7. DIRECT-METHODS: (NIL)
8. %DOCUMENTATION: NIL
9. SAFE-P: NIL
10. FINALIZED-P: T
11. %CLASS-PRECEDENCE-LIST: (#<STANDARD-CLASS TEST-CLASS>
                             #<STANDARD-CLASS STANDARD-OBJECT>
                             #<SB-PCL::SLOT-CLASS SB-PCL::SLOT-OBJECT>
                             #<BUILT-IN-CLASS T>)
12. CPL-AVAILABLE-P: T
13. CAN-PRECEDE-LIST: (#<BUILT-IN-CLASS T>
                       #<SB-PCL::SLOT-CLASS SB-PCL::SLOT-OBJECT>
                       #<STANDARD-CLASS STANDARD-OBJECT>)
14. INCOMPATIBLE-SUPERCLASS-LIST: NIL
15. WRAPPER: #<SB-PCL::WRAPPER #<STANDARD-CLASS TEST-CLASS> {12703289}>
16. PROTOTYPE: NIL
17. DIRECT-SLOTS: (#<SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION A1>)
18. SLOTS: (#<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION A1>)
> q

; No value

;; Everything works fine so far

CL-USER> (defmethod print-object ((test test-class) stream)
           (print-unreadable-object (test stream :type t)
             (format t "~A" (slot-value test 'a1))))

#<STANDARD-METHOD PRINT-OBJECT (TEST-CLASS T) {12A7D919}>

CL-USER> (describe (find-class 'test-class))
#<STANDARD-CLASS TEST-CLASS>
  [standard-object]

Class precedence-list: TEST-CLASS, STANDARD-OBJECT, SB-PCL::SLOT-OBJECT,
                       T
Direct superclasses: STANDARD-OBJECT
No subclasses.
Direct slots:
  A1

Slots with :INSTANCE allocation:
  %TYPE = (CLASS #<STANDARD-CLASS TEST-CLASS>)
  SOURCE = #S(SB-C:DEFINITION-SOURCE-LOCATION..
  PLIST = NIL
  NAME = TEST-CLASS
  CLASS-EQ-SPECIALIZER = #<SB-PCL::CLASS-EQ-SPECIALIZER {12669139}>
  DIRECT-SUPERCLASSES = (#<STANDARD-CLASS STANDARD-OBJECT>)
  DIRECT-SUBCLASSES = NIL
  DIRECT-METHODS = ((#<STANDARD-METHOD PRINT-OBJECT (TEST-CLASS T) {12A7D919}>))
  %DOCUMENTATION = NIL
  SAFE-P = NIL
  FINALIZED-P = T
  %CLASS-PRECEDENCE-LIST = (#<STANDARD-CLASS TEST-CLASS> #<STANDARD-CLASS STANDARD-OBJECT>..
  CPL-AVAILABLE-P = T
  CAN-PRECEDE-LIST = (#<BUILT-IN-CLASS T> #<SB-PCL::SLOT-CLASS SB-PCL::SLOT-OBJECT>..
  INCOMPATIBLE-SUPERCLASS-LIST = NIL
  WRAPPER = #<SB-PCL::WRAPPER #<STANDARD-CLASS TEST-CLASS> {12703289}>
  PROTOTYPE = NIL
  DIRECT-SLOTS = (#<SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION A1>)
  SLOTS = (#<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION A1>)
; No value

;; This will fill the prototype slot of the class with a prototype instance

CL-USER> (progn
           (sb-mop:class-prototype (find-class 'test-class))
           (values))
; No value

The object is a STANDARD-OBJECT of type STANDARD-CLASS.
0. %TYPE: (CLASS #<STANDARD-CLASS TEST-CLASS>)
1. SOURCE: #S(SB-C:DEFINITION-SOURCE-LOCATION
              :NAMESTRING NIL
              :TOPLEVEL-FORM-NUMBER NIL
              :PLIST NIL)
2. PLIST: NIL
3. NAME: TEST-CLASS
4. CLASS-EQ-SPECIALIZER: #<SB-PCL::CLASS-EQ-SPECIALIZER {12669139}>
5. DIRECT-SUPERCLASSES: (#<STANDARD-CLASS STANDARD-OBJECT>)
6. DIRECT-SUBCLASSES: NIL
7. DIRECT-METHODS: ((#<STANDARD-METHOD PRINT-OBJECT (TEST-CLASS
                                                     T) {12A7D919}>))
8. %DOCUMENTATION: NIL
9. SAFE-P: NIL
10. FINALIZED-P: T
11. %CLASS-PRECEDENCE-LIST: (#<STANDARD-CLASS TEST-CLASS>
                             #<STANDARD-CLASS STANDARD-OBJECT>
                             #<SB-PCL::SLOT-CLASS SB-PCL::SLOT-OBJECT>
                             #<BUILT-IN-CLASS T>)
12. CPL-AVAILABLE-P: T
13. CAN-PRECEDE-LIST: (#<BUILT-IN-CLASS T>
                       #<SB-PCL::SLOT-CLASS SB-PCL::SLOT-OBJECT>
                       #<STANDARD-CLASS STANDARD-OBJECT>)
14. INCOMPATIBLE-SUPERCLASS-LIST: NIL
15. WRAPPER: #<SB-PCL::WRAPPER #<STANDARD-CLASS TEST-CLASS> {12703289}>
16. PROTOTYPE: #<TEST-CLASS ; Evaluation aborted.

;; ^^ Here unbound-slot condition is raised as print-object is called on the prototype instance

CL-USER> (describe (find-class 'test-class))
#<STANDARD-CLASS TEST-CLASS>
  [standard-object]

Class precedence-list: TEST-CLASS, STANDARD-OBJECT, SB-PCL::SLOT-OBJECT,
                       T
Direct superclasses: STANDARD-OBJECT
No subclasses.
Direct slots:
  A1

Slots with :INSTANCE allocation:
  %TYPE = (CLASS #<STANDARD-CLASS TEST-CLASS>)
  SOURCE = #S(SB-C:DEFINITION-SOURCE-LOCATION..
  PLIST = NIL
  NAME = TEST-CLASS
  CLASS-EQ-SPECIALIZER = #<SB-PCL::CLASS-EQ-SPECIALIZER {12669139}>
  DIRECT-SUPERCLASSES = (#<STANDARD-CLASS STANDARD-OBJECT>)
  DIRECT-SUBCLASSES = NIL
  DIRECT-METHODS = ((#<STANDARD-METHOD PRINT-OBJECT (TEST-CLASS T) {119DF381}>))
  %DOCUMENTATION = NIL
  SAFE-P = NIL
  FINALIZED-P = T
  %CLASS-PRECEDENCE-LIST = (#<STANDARD-CLASS TEST-CLASS> #<STANDARD-CLASS STANDARD-OBJECT>..
  CPL-AVAILABLE-P = T
  CAN-PRECEDE-LIST = (#<BUILT-IN-CLASS T> #<SB-PCL::SLOT-CLASS SB-PCL::SLOT-OBJECT>..
  INCOMPATIBLE-SUPERCLASS-LIST = NIL

;; Same with describe

The slot A1 is unbound in the object .
   [Condition of type UNBOUND-SLOT]

Restarts:
 0: [USE-VALUE] Return a value as the slot-value.
 1: [STORE-VALUE] Store and return a value as the slot-value.
 2: [RETRY] Retry SLIME REPL evaluation request.
 3: [ABORT] Return to SLIME's top level.
 4: [TERMINATE-THREAD] Terminate this thread (#<THREAD "repl-thread" RUNNING {1201AC61}>)

; Evaluation aborted.

This interaction between print-object and class-prototype also manifests in the slime inspector.
When one inspects a class with slime, class-prototype is called by swank and then unbound-slot
conditions are raised. CCL has the 'with-errorfree-printing' macro and uses it in it's inspector
to deal with this issue.

[Tobias C. Rittweiler (tcr)]

FWIW, the problem has been fixed in the Slime inspector by wrapping
some handler-case around the code which prints the parts of the object
being inspected.