[elephant-cvs] CVS elephant/src/elephant

[ieslick]

Update of /project/elephant/cvsroot/elephant/src/elephant
In directory clnet:/tmp/cvs-serv6422/src/elephant

Modified Files:
	classes.lisp classindex.lisp 
Log Message:
Cleanup indexing tests so we always have a clean slate

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/21 14:29:30	1.23
+++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp	2007/03/24 12:16:03	1.24
@@ -69,8 +69,9 @@
 				       never (eq (class-of superclass) persistent-metaclass))))
     (if (and (not (eq class persistent-object)) not-already-persistent)
 	(apply #'call-next-method class slot-names
-	       :direct-superclasses (cons persistent-object
-					  direct-superclasses) args)
+;;	       :direct-superclasses (cons persistent-object
+;;					  direct-superclasses) args)
+	       :direct-superclasses (append direct-superclasses (list persistent-object)) args)
 	(call-next-method))))
 
 (defmethod finalize-inheritance :around ((instance persistent-metaclass))
--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/23 16:08:10	1.31
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2007/03/24 12:16:03	1.32
@@ -232,34 +232,41 @@
   (let ((class-idx (find-class-index class :sc sc :errorp errorp)))
     (if class-idx 
 	(progn
-	  (wipe-class-indexing class class-idx :sc sc)
+	  (wipe-class-indexing class :sc sc)
 	  (update-indexed-record class nil))
 	(when errorp
 	  (error "No class index exists in persistent store ~A" sc)
 	  (return-from disable-class-indexing nil)))))
 
-(defmethod wipe-class-indexing ((class persistent-metaclass) class-idx &key (sc *store-controller*))
-  ;; Clear out the current class record
-  (with-transaction (:store-controller sc)
-    (with-btree-cursor (cur class-idx)
-      (when (cursor-first cur)
-	(loop while (cursor-delete cur)))))
-  ;; Get the names of all indices & remove them 
-  (let ((names nil))
-    (map-indices (lambda (name secondary-index)
-		   (declare (ignore secondary-index))
-		   (push name names))
-		 class-idx)
-    (dolist (name names)
-      (if (member name (class-slots class))
-	  (remove-class-slot-index class name)
-	  (with-transaction (:store-controller sc)
-	    (remove-index class-idx name)))))
-  ;; Drop the class instance index from the class root
-  (with-transaction (:store-controller sc)
-    (remove-kv (class-name class) (controller-class-root sc)))
-  (setf (%index-cache class) nil)
-  )
+(defmethod wipe-class-indexing ((class persistent-metaclass) &key (sc *store-controller*))
+  (wipe-class-indexing (class-name class) :sc sc))
+
+(defmethod wipe-class-indexing ((class-name symbol) &key (sc *store-controller*))
+  (let ((cindex (get-value class-name (controller-class-root sc)))
+	(class (find-class class-name nil)))
+    (when cindex
+      ;; Delete all the values
+      (with-transaction (:store-controller sc)
+	(with-btree-cursor (cur cindex)
+	  (loop while (cursor-next cur) do
+	       (cursor-delete cur))))
+      ;; Get the names of all indices & remove them 
+      (let ((names nil))
+	(map-indices (lambda (name secondary-index)
+		       (declare (ignore secondary-index))
+		       (push name names))
+		     cindex)
+	(dolist (name names)
+	  (when (member name (class-slots class))
+	    (if class 
+		(remove-class-slot-index class name)
+		(with-transaction (:store-controller sc)
+		  (remove-index cindex name))))))
+      ;; Drop the class instance index from the class root
+      (with-transaction (:store-controller sc)
+	(remove-kv class-name (controller-class-root sc)))
+      (when class
+	(setf (%index-cache class) nil)))))
 
 (defmethod add-class-slot-index ((class symbol) slot-name &key (sc *store-controller*))
   (add-class-slot-index (find-class class) slot-name :sc sc))