Skip to content
Snippets Groups Projects
Commit 73cff6ad authored by Pascal Costanza's avatar Pascal Costanza
Browse files

Switched from slot-xxx-using-class to slot-xxx in a shared-initialize definition.

CLisp seems to have problems with calling slot-xxx-using-class functions within shared-initialize under some circumstances, so I switched to calling the plain slot-xxx functions instead.

darcs-hash:3a3047de28575f8dbea39007cdc7d79414a89a37
parent a6954362
No related branches found
No related tags found
No related merge requests found
...@@ -73,23 +73,22 @@ ...@@ -73,23 +73,22 @@
(call-next-method))) (call-next-method)))
(defmethod shared-initialize :after (defmethod shared-initialize :after
((object special-object) ((object special-object) slot-names &rest all-keys)
slot-names &rest all-keys)
"ensure that all initialized special slots are indeed bound to "ensure that all initialized special slots are indeed bound to
a special slot; circumvents possible optimizations in the a special slot; circumvents possible optimizations in the
initialization of standard-class objects" initialization of standard-class objects"
(declare (ignore slot-names all-keys)) (declare (ignore slot-names all-keys))
(loop with class = (class-of object) (loop with class = (class-of object)
for slot in (class-slots class) for slot in (class-slots class)
for slot-name = (slot-definition-name slot)
when (typep slot 'special-effective-slot-definition) when (typep slot 'special-effective-slot-definition)
do (with-symbol-access do (with-symbol-access
(when (slot-boundp-using-class class object slot) (when (slot-boundp object slot-name)
(let ((slot-value (slot-value-using-class class object slot))) (let ((slot-value (slot-value object slot-name)))
(unless (special-symbol-p slot-value) (unless (special-symbol-p slot-value)
(slot-makunbound-using-class class object slot) (slot-makunbound object slot-name)
(without-symbol-access (without-symbol-access
(setf (slot-value-using-class class object slot) (setf (slot-value object slot-name) slot-value))))))))
slot-value))))))))
(defvar *slot-unbound-p* nil) (defvar *slot-unbound-p* nil)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment