Fix propagation of class finalization.

Instead of calling reinitialize-instance, directly
invoke finalize on the subclasses. Also remove subclass
links from parents when the superclass list is changed.
This commit is contained in:
Alexander Gavrilov 2009-11-02 20:58:42 +03:00 committed by Juan Jose Garcia Ripoll
parent ce91c03f9d
commit 46671dfbe4
2 changed files with 18 additions and 10 deletions

View file

@ -165,7 +165,8 @@
:lambda-list '(class &rest initargs))
(defmethod reinitialize-instance ((class class) &rest initargs
&key direct-superclasses (direct-slots nil direct-slots-p))
&key (direct-superclasses () direct-superclasses-p)
(direct-slots nil direct-slots-p))
(let ((name (class-name class)))
(when (member name '(CLASS BUILT-IN-CLASS) :test #'eq)
(error "The kernel CLOS class ~S cannot be changed." name)))
@ -183,14 +184,19 @@
collect (canonical-slot-to-direct-slot class s))))
;; set up inheritance checking that it makes sense
(dolist (l (setf (class-direct-superclasses class)
(check-direct-superclasses class direct-superclasses)))
(add-direct-subclass l class))
(when direct-superclasses-p
(setf direct-superclasses
(check-direct-superclasses class direct-superclasses))
(dolist (l (class-direct-superclasses class))
(unless (member l direct-superclasses)
(remove-direct-subclass l class)))
(dolist (l (setf (class-direct-superclasses class)
direct-superclasses))
(add-direct-subclass l class)))
;; if there are no forward references, we can just finalize the class here
(setf (class-finalized-p class) nil)
(unless (find-if #'forward-referenced-class-p (class-direct-superclasses class))
(finalize-inheritance class))
(finalize-unless-forward class)
class)

View file

@ -143,6 +143,10 @@
(defmethod effective-slot-definition-class ((class T) &rest canonicalized-slot)
(find-class 'standard-effective-slot-definition nil))
(defun finalize-unless-forward (class)
(unless (find-if #'forward-referenced-class-p (class-direct-superclasses class))
(finalize-inheritance class)))
(defmethod initialize-instance ((class class) &rest initargs
&key sealedp direct-superclasses direct-slots)
;; convert the slots from lists to direct slots
@ -162,8 +166,7 @@
(dolist (l (setf direct-superclasses (class-direct-superclasses class)))
(add-direct-subclass l class))
(unless (find-if #'forward-referenced-class-p direct-superclasses)
(finalize-inheritance class))
(finalize-unless-forward class)
class)
@ -293,8 +296,7 @@ because it contains a reference to the undefined class~% ~A"
;; invoking FINALIZE-INHERITANCE on all of its children. Obviously,
;; this only makes sense when the class has been defined.
(dolist (subclass (reverse (class-direct-subclasses class)))
(reinitialize-instance subclass
:direct-superclasses (class-direct-superclasses subclass)))
(finalize-unless-forward subclass))
)
(defun std-create-slots-table (class)