From 8f49b7a10a9717890ca98dff2b01799b80ce2761 Mon Sep 17 00:00:00 2001 Message-Id: <8f49b7a10a9717890ca98dff2b01799b80ce2761.1714175595.git.mdw@distorted.org.uk> From: Mark Wooding Date: Wed, 29 Feb 2012 17:00:45 +0000 Subject: [PATCH 1/1] Correctly sort out string-specified getters in virtual-slots.lisp Organization: Straylight/Edgeware From: Rupert Swarbrick The new code basically just punts to the method on compute-slot-reader-function defined in proxy.lisp. --- gffi/virtual-slots.lisp | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/gffi/virtual-slots.lisp b/gffi/virtual-slots.lisp index 66f547f..22a6af3 100644 --- a/gffi/virtual-slots.lisp +++ b/gffi/virtual-slots.lisp @@ -282,17 +282,21 @@ (defmethod compute-effective-slot-definition-initargs ((class virtual-slots-clas (append '(:special t) (call-next-method))) (t (call-next-method)))) -(defmacro vsc-slot-x-using-class (x x-slot-name computer) +(defmacro vsc-slot-x-using-class (x x-slot-name computer &key allow-string-fun-p) (let ((generic-name (intern (concatenate 'string "SLOT-" (string x) "-USING-CLASS")))) `(defmethod ,generic-name ((class virtual-slots-class) (object virtual-slots-object) (slotd effective-virtual-slot-definition)) - (unless (slot-boundp slotd ',x-slot-name) + (unless (and (slot-boundp slotd ',x-slot-name) + ,@(when allow-string-fun-p + `((not + (stringp (slot-value slotd ',x-slot-name)))))) (setf (slot-value slotd ',x-slot-name) (,computer slotd))) (funcall (slot-value slotd ',x-slot-name) object)))) -(vsc-slot-x-using-class value getter compute-slot-reader-function) +(vsc-slot-x-using-class value getter compute-slot-reader-function + :allow-string-fun-p t) (vsc-slot-x-using-class boundp boundp-function compute-slot-boundp-function) (vsc-slot-x-using-class makunbound makunbound-function compute-slot-makunbound-function) -- [mdw]