X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/1d2032d45fc8c2603685f5f8f606c066b9418e6e..8f49b7a10a9717890ca98dff2b01799b80ce2761:/gffi/virtual-slots.lisp

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)