From 49b244db78836e91cde1328380c82abf899bb532 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 5 Apr 2020 14:38:23 +0200 Subject: [PATCH] finalize-inheritance: do not refinalize when already finalized 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. --- src/clos/standard.lsp | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/src/clos/standard.lsp b/src/clos/standard.lsp index 10d52978c..be80e443d 100644 --- a/src/clos/standard.lsp +++ b/src/clos/standard.lsp @@ -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)