That solved that problem, but it now appears that accessors are not
generated for the slots.
(progn
(defpclass foo () ((ff :accessor foo-ff)))
(defpclass bar () ((bb :accessor bar-bb)))
(let (f b list)
(setf f (make-instance (weblocks-elephant::return-
proxy-classname 'foo)))
(weblocks::push-end (weblocks-elephant::base-
class f) list)
(foo-ff f) ; failure #1 -- reader not existent
(setf (foo-ff f) 'ff-val) ; failure #1 -- writer
not existent
(setf b (make-instance (weblocks-elephant::return-
proxy-classname 'bar)))
(weblocks::push-end (weblocks-elephant::base-
class b) list)
(weblocks::push-end (weblocks-elephant::base-
class f) list)
list))
This code fails as indicated in code comments. I presume the previous
methods did somehow establish the accessors, but failed with
initializing the base, this one initializes the base fine, but the
proxy definition is incomplete.
Yarek
On Dec 27, 3:18 pm, Ian Eslick <[email protected]> wrote:
> Thanks for the clear test case. This was a misunderstanding on my
> part of inheritance of class allocated slots. I just pushed a quick
> patch to weblocks-ian which fixes this. Here's the raw diff.
>
> Ian
>
> diff -r ca886fa7919c src/store/elephant/proxy.lisp
> --- a/src/store/elephant/proxy.lisp Sat Dec 06 22:40:30 2008 +0000
> +++ b/src/store/elephant/proxy.lisp Sat Dec 27 18:15:42 2008 -0500
> @@ -4,22 +4,22 @@
> (defvar *view-proxies* (make-hash-table))
>
> (defclass persistent-proxy ()
> - ((base-class :accessor base-class :initarg :base :allocation :class)
> - (proxy-oid :accessor proxy-oid :initarg :oid :initform nil)))
> + ((proxy-oid :accessor proxy-oid :initarg :oid :initform nil)))
>
> (defun return-proxy-classname (classname)
> (if (gethash classname *proxies*)
> (gethash classname *proxies*)
> - (let* ((persistent-class (find-class classname))
> - (new-name (intern (format nil "~A-~A" classname (gensym))
> *package*))
> - (visible-slot-defs (class-visible-slots-impl persistent-class))
> - (class-def `(defclass ,new-name (persistent-proxy)
> - (,@(mapcar #'def-to-proxy-slot
> - visible-slot-defs))
> - (:default-initargs :base ',classname))))
> - (eval class-def)
> - (setf (gethash classname *proxies* new-name)
> - new-name))))
> + (let* ((persistent-class (find-class classname))
> + (new-name (intern (format nil "~A-~A" classname (gensym))
> *package*))
> + (visible-slot-defs (class-visible-slots-impl persistent-class))
> + (class-def `(defclass ,new-name (persistent-proxy)
> + ((base-class :accessor base-class :allocation
> :class
> + :initform ',classname)
> + ,@(mapcar #'def-to-proxy-slot
> + visible-slot-defs)))))
> + (eval class-def)
> + (setf (gethash classname *proxies* new-name)
> + new-name))))
>
> (defun def-to-proxy-slot (def)
> `(,(weblocks::slot-definition-name def)
>
> On Dec 27, 2008, at 5:02 PM, Yarek Kowalik wrote:
>
>
>
> > Every time I create a new instance of a new proxy object for a
> > persistent class, it redefines the base-class in the previously
> > created instances, even when these instances are not of the same
> > class. For example:
>
> > PROJECT_FOO> (progn
> > (defpclass foo () ())
> > (defpclass bar () ())
> > (let (f b list)
> > (setf f (make-instance (weblocks-elephant::return-
> > proxy-classname 'foo)))
> > (weblocks::push-end (weblocks-elephant::base-
> > class f) list)
> > (setf b (make-instance (weblocks-elephant::return-
> > proxy-classname 'bar)))
> > (weblocks::push-end (weblocks-elephant::base-
> > class b) list)
> > (weblocks::push-end (weblocks-elephant::base-
> > class f) list)
> > list))
> > (FOO BAR BAR)
>
> > This is unexpected: the output should be (FOO BAR FOO), and it causes
> > serious problems. Is there something amiss in the way proxy classes
> > are defined?
>
> > Note: This is on SBCL 1.0.20.
>
> > Yarek
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"weblocks" group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to
[email protected]
For more options, visit this group at
http://groups.google.com/group/weblocks?hl=en
-~----------~----~----~----~------~----~------~--~---
