[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
- To: CommonLoops.pa@Xerox.COM
- Subject: change-class-internal bug
- From: kanderso@WILMA.BBN.COM
- Date: Fri, 18 Mar 88 09:11:19 -0500
- Cc: kanderson@WILMA.BBN.COM
- Redistributed: CommonLoops.pa
;;; -*- Package: PCL -*-
Bug using SLOT-VALUE of an instance of class obsolete-class.
You get into infinte recursion as i've indicated in the code below.
Basically CHANGE-CLASS-INTERNAL cannot use the normal ALL-SLOTS mechanism
because that winds up using SLOT-VALUE again. I remeber this in the old PCL
we must have patched it locally.
(defun slot-value (object slot-name)
(SLOT-VALUE-USING-CLASS (CLASS-OF OBJECT) OBJECT SLOT-NAME)) ; <-
(defmethod slot-value-using-class ((class obsolete-class)
(CHANGE-CLASS OBJECT ; <-
(CADR (SLOT-VALUE CLASS 'CLASS-PRECEDENCE-LIST)))
(class-of object) object slot-name dont-call-slot-missing-p default))
(defun change-class (object new-class)
(or (classp new-class)
(setq new-class (class-named new-class)))
(let ((new-object (make-instance new-class)))
;; Call change-class-internal so that a user-defined method
;; (or the default method) can copy the information from the
;; old instance to the dummy instance of the new class.
(CHANGE-CLASS-INTERNAL OBJECT NEW-OBJECT) ; <-
;; Now that the dummy new-object has the right information,
;; move all that stuff into the old-instance.
(setf (iwmc-class-class-wrapper object)
(setf (iwmc-class-static-slots object)
(setf (iwmc-class-dynamic-slots object)
(defmethod change-class-internal ((old object) (new object))
(let ((all-slots (ALL-SLOTS OLD))) ; <-
(iterate ((name in all-slots by cddr)
(value in (cdr all-slots) by cddr))
(put-slot-always new name value))))
(defun all-slots (object)
(ALL-SLOTS-USING-CLASS (CLASS-OF OBJECT) OBJECT)) ; <-
(defmethod all-slots-using-class ((class standard-class) object)
(append (iterate ((slotd in (class-instance-slots class)))
(collect (slotd-name slotd))
(collect (SLOT-VALUE OBJECT (SLOTD-NAME SLOTD)))) ; <- OOPS!