Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv2234/src
Modified Files: classes.lisp Log Message: added preliminary support for change-class (though redef class is broken.)
Date: Tue Sep 21 21:35:29 2004 Author: blee
Index: elephant/src/classes.lisp diff -u elephant/src/classes.lisp:1.11 elephant/src/classes.lisp:1.12 --- elephant/src/classes.lisp:1.11 Sun Sep 19 19:47:44 2004 +++ elephant/src/classes.lisp Tue Sep 21 21:35:29 2004 @@ -111,6 +111,20 @@ ;; let the implementation initialize the transient slots (apply #'call-next-method instance transient-slot-inits initargs)))))
+(defmethod update-instance-for-different-class :around ((previous persistent) (current persistent) &rest initargs &key) + "Need to also update the persistent-slots, which have +:class allocation." + (let ((new-persistent-slots + (loop for slotd in (class-slots (class-of current)) + for slot-name = (slot-definition-name slotd) + with old-slot-names = (mapcar #'slot-definition-name + (class-slots (class-of previous))) + when (and (not (member slot-name old-slot-names :test #'eq)) + (persistent-p slotd)) + collect slot-name))) + (apply #'shared-initialize current new-persistent-slots initargs) + (call-next-method))) + (defmethod slot-value-using-class :around (class (instance persistent-object) (slot-def persistent-slot-definition)) "Get the slot value from the database." (declare (optimize (speed 3))