mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-16 06:12:25 -08:00
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:
parent
ce91c03f9d
commit
46671dfbe4
2 changed files with 18 additions and 10 deletions
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue