From a5d7454651528621c24920193ac4c0c287960d2e Mon Sep 17 00:00:00 2001 From: Blake McBride Date: Sat, 18 Apr 2026 12:50:46 -0500 Subject: [PATCH] Fix for SLOT-MISSING loses slot name under custom metaclasses --- src/org/armedbear/lisp/clos.lisp | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/src/org/armedbear/lisp/clos.lisp b/src/org/armedbear/lisp/clos.lisp index 4ac5b68b0..7e44da9b2 100644 --- a/src/org/armedbear/lisp/clos.lisp +++ b/src/org/armedbear/lisp/clos.lisp @@ -756,8 +756,10 @@ (eq metaclass +the-structure-class+) (eq metaclass +the-funcallable-standard-class+)) (std-slot-value object slot-name) - (slot-value-using-class class object - (find-slot-definition class slot-name))))) + (let ((slot-def (find-slot-definition class slot-name))) + (if slot-def + (slot-value-using-class class object slot-def) + (values (slot-missing class object slot-name 'slot-value))))))) (defun %set-slot-value (object slot-name new-value) (let* ((class (class-of object)) @@ -766,9 +768,12 @@ (eq metaclass +the-structure-class+) (eq metaclass +the-funcallable-standard-class+)) (setf (std-slot-value object slot-name) new-value) - (setf (slot-value-using-class class object - (find-slot-definition class slot-name)) - new-value)))) + (let ((slot-def (find-slot-definition class slot-name))) + (if slot-def + (setf (slot-value-using-class class object slot-def) new-value) + (progn + (slot-missing class object slot-name 'setf new-value) + new-value)))))) (defsetf slot-value %set-slot-value) @@ -776,8 +781,10 @@ (let ((class (class-of object))) (if (std-class-p class) (std-slot-boundp object slot-name) - (slot-boundp-using-class class object - (find-slot-definition class slot-name))))) + (let ((slot-def (find-slot-definition class slot-name))) + (if slot-def + (slot-boundp-using-class class object slot-def) + (and (slot-missing class object slot-name 'slot-boundp) t)))))) (defun std-slot-makunbound (instance slot-name) (let ((location (instance-slot-location instance slot-name))) @@ -793,8 +800,12 @@ (let ((class (class-of object))) (if (std-class-p class) (std-slot-makunbound object slot-name) - (slot-makunbound-using-class class object - (find-slot-definition class slot-name))))) + (let ((slot-def (find-slot-definition class slot-name))) + (if slot-def + (slot-makunbound-using-class class object slot-def) + (progn + (slot-missing class object slot-name 'slot-makunbound) + object)))))) (defun std-slot-exists-p (instance slot-name) (not (null (find slot-name (class-slots (class-of instance))