From: Christophe R. <cr...@us...> - 2006-07-20 11:02:29
|
Update of /cvsroot/sbcl/sbcl/src/pcl In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv6780/src/pcl Modified Files: std-class.lisp Log Message: 0.9.14.29: Make REINITIALIZE-INSTANCE (well, SHARED-INITIALIZE in fact, but I'm pretty sure that's OK) call FINALIZE-INHERITANCE rather than UPDATE-CLASS if the class has already been finalized, as required by AMOP. Index: std-class.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/std-class.lisp,v retrieving revision 1.99 retrieving revision 1.100 diff -u -d -r1.99 -r1.100 --- std-class.lisp 19 Jul 2006 20:44:39 -0000 1.99 +++ std-class.lisp 20 Jul 2006 11:02:19 -0000 1.100 @@ -408,27 +408,10 @@ (push old collect))))) (nreverse collect))) (add-direct-subclasses class direct-superclasses) - (update-class class nil) - (do* ((slots (slot-value class 'slots) (cdr slots)) - (dupes nil)) - ((null slots) (when dupes - (style-warn - ;; FIXME: the indentation request ("~4I") - ;; below appears not to do anything. Finding - ;; out why would be nice. -- CSR, 2003-04-24 - "~@<slot names with the same SYMBOL-NAME but ~ - different SYMBOL-PACKAGE (possible package problem) ~ - for class ~S:~@:_~4I~<~@{~S~^~:@_~}~:>~@:>" - class - dupes))) - (let* ((slot (car slots)) - (oslots (remove (slot-definition-name slot) (cdr slots) - :test #'string/= :key #'slot-definition-name))) - (when oslots - (pushnew (cons (slot-definition-name slot) - (mapcar #'slot-definition-name oslots)) - dupes - :test #'string= :key #'car)))) + (if (class-finalized-p class) + ;; required by AMOP, "Reinitialization of Class Metaobjects" + (finalize-inheritance class) + (update-class class nil)) (add-slot-accessors class direct-slots) (make-preliminary-layout class)) @@ -880,7 +863,25 @@ (wrapper-instance-slots-layout nwrapper) nlayout (wrapper-class-slots nwrapper) nwrapper-class-slots (wrapper-no-of-instance-slots nwrapper) nslots - wrapper nwrapper)) + wrapper nwrapper) + (do* ((slots (slot-value class 'slots) (cdr slots)) + (dupes nil)) + ((null slots) + (when dupes + (style-warn + "~@<slot names with the same SYMBOL-NAME but ~ + different SYMBOL-PACKAGE (possible package problem) ~ + for class ~S:~4I~@:_~<~@{~S~^~:@_~}~:>~@:>" + class dupes))) + (let* ((slot (car slots)) + (oslots (remove (slot-definition-name slot) (cdr slots) + :test #'string/= + :key #'slot-definition-name))) + (when oslots + (pushnew (cons (slot-definition-name slot) + (mapcar #'slot-definition-name oslots)) + dupes + :test #'string= :key #'car))))) (setf (slot-value class 'finalized-p) t) (unless (eq owrapper nwrapper) (update-pv-table-cache-info class) |