sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

finalize-inheritance: do not refinalize when already finalized

Browse source 
We've reinitialized the class even when it was already finalized and
none of its parents has changed with the recomputed information.

That leads to replacing the class slots with a result of COMPUTE-SLOTS
and in effect changing the INSTANCE-SIG (see src/clos/change.lsp).
Next time when ENSURE-UP-TO-DATE-INSTANCE is called (i.e from the
STANDARD-INSTANCE-ACCESS), then the instance is reinitalized.

Behavior was the most notable when we had tried to re-finalize the
STANDARD-EFFECTIVE-SLOT-DEFINITION class, because then /its new/ slots
were by definition obsolete after calling setf on this class and
unbound, what leads to an infinite recursion when we try to signal
unbound-slot condition.

Fixes #568.
This commit is contained in:
Daniel Kochmański 2020-04-05 14:38:23 +02:00
parent f532057a83
commit 49b244db78
1 changed files with 14 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
src/clos/standard.lsp
View file

@ -292,10 +292,14 @@ because it contains a reference to the undefined class~% ~A"
;; which is not yet finalized and rely on the fact that this
;; class will also try to finalize all of its children.
;;
(let ((x (find-if-not #'class-finalized-p cpl :from-end t)))
(unless (or (null x) (eq x class))
(return-from finalize-inheritance
(finalize-inheritance x))))
(when-let ((x (find-if-not #'class-finalized-p (rest cpl) :from-end t)))
(return-from finalize-inheritance
(finalize-inheritance x)))
;; Don't try to finalize a class that is already finalized.
(when (class-finalized-p class)
(return-from finalize-inheritance))
(setf (class-precedence-list class) cpl)
(let ((slots (compute-slots class)))
(setf (class-slots class) slots
@ -352,13 +356,15 @@ because it contains a reference to the undefined class~% ~A"
;; As mentioned above, when a parent is finalized, it is responsible for
;; 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)))
(finalize-unless-forward subclass))
(let ((subclasses (reverse (class-direct-subclasses class))))
(dolist (subclass subclasses)
(setf (class-finalized-p subclass) nil))
(dolist (subclass subclasses)
(finalize-unless-forward subclass)))
;;
;; We create various caches to more rapidly find the slot locations and
;; slot definitions.
(std-create-slots-table class)
)
(std-create-slots-table class))
(defmethod finalize-inheritance ((class std-class))
(call-next-method)