[elephant-cvs] CVS elephant/src/elephant
ieslick
ieslick at common-lisp.net
Wed Feb 21 06:29:32 UTC 2007
Update of /project/elephant/cvsroot/elephant/src/elephant
In directory clnet:/tmp/cvs-serv26319/src/elephant
Modified Files:
classes.lisp classindex.lisp
Log Message:
Fix to slot-makunbound handling for indexed slots and a regression test to validate
--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/18 23:38:18 1.14
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/21 06:29:31 1.15
@@ -263,11 +263,10 @@
(call-next-method)))))
(defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
- "Deletes the slot from the database."
- ;; NOTE: call remove-indexed-slot here instead?
-;; (when (indexed slot-def)
-;; (unregister-indexed-slot class (slot-definition-name slot-def)))
- (persistent-slot-makunbound (get-con instance) instance (slot-definition-name slot-def)))
+ "Removes the slot value from the database."
+ (if (indexed class)
+ (indexed-slot-makunbound class instance slot-def)
+ (persistent-slot-makunbound (get-con instance) instance (slot-definition-name slot-def))))
;; ======================================================
;; Handling metaclass overrides of normal slot operation
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/21 04:47:42 1.21
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/21 06:29:31 1.22
@@ -76,14 +76,23 @@
(if (no-indexing-needed? class instance slot-def oid)
(persistent-slot-writer con new-value instance slot-name)
(let ((class-idx (find-class-index class)))
-;; (format t "Indexing object: ~A oid: ~A~%" instance oid)
(ensure-transaction (:store-controller con)
;; NOTE: Quick and dirty hack to ensure consistency -- needs performance improvement
+
(when (get-value oid class-idx)
(remove-kv oid class-idx))
(persistent-slot-writer con new-value instance slot-name)
(setf (get-value oid class-idx) instance))))))
+(defmethod indexed-slot-makunbound ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
+ (let ((class-idx (find-class-index class))
+ (oid (oid instance))
+ (sc (get-con instance)))
+ (ensure-transaction (:store-controller sc)
+ (let ((obj (get-value oid class-idx)))
+ (remove-kv oid class-idx)
+ (persistent-slot-makunbound sc instance (slot-definition-name slot-def))
+ (setf (get-value oid class-idx) obj)))))
(defun no-indexing-needed? (class instance slot-def oid)
(declare (ignore instance))
More information about the Elephant-cvs
mailing list