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