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
-~----------~----~----~----~------~----~------~--~---
