[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