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

Modified Files: classes.lisp classindex-utils.lisp classindex.lisp Log Message: Fix reconnect to derived index bug under :class synchronization policy

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/14 04:36:10 1.13 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/18 23:38:18 1.14 @@ -130,14 +130,14 @@ (let* ((class (find-class (class-name (class-of instance)))) (oid (oid instance)) (persistent-slot-names (persistent-slot-names class))) - (flet ((persistent-slot-p (item) + (flet ((persistent-slot-p (item) (member item persistent-slot-names :test #'eq))) (let ((transient-slot-inits (if (eq slot-names t) ; t means all slots (transient-slot-names class) (remove-if #'persistent-slot-p slot-names))) (persistent-slot-inits - (if (eq slot-names t) + (if (eq slot-names t) persistent-slot-names (remove-if-not #'persistent-slot-p slot-names)))) (inhibit-indexing oid) --- /project/elephant/cvsroot/elephant/src/elephant/classindex-utils.lisp 2007/02/02 23:51:58 1.4 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex-utils.lisp 2007/02/18 23:38:18 1.5 @@ -12,6 +12,8 @@

(in-package :elephant)

+(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1))) + ;; ;; Simple utilities for managing synchronization between class ;; definitions and database state @@ -226,7 +228,6 @@ (simple-match-set (synch-rule-lhs rule) features))

(defun simple-match-set (a b) - (declare (optimize (speed 3) (safety 1))) (cond ((null a) t) ((and (not (null a)) (null b)) nil) ((member (first a) b :test #'equal) @@ -252,7 +253,6 @@ (warn (warn "Performing slot synchronization actions: ~A" (synch-rule-rhs rule))))))

(defun apply-synch-rules (class records rule-set) - (declare (optimize (speed 3) (safety 1))) (labels ((slotname (rec) (car rec)) (feature-set (rec) (cdr rec))) (loop for record in records do @@ -267,8 +267,7 @@ (let* ((*store-controller* store-controller) ;; db info (db-indices (find-inverted-index-names class)) - (db-derived (mapcar #'get-derived-name-root - (remove-if-not #'derived-name? db-indices))) + (db-derived (remove-if-not #'derived-name? db-indices)) (db-slot (set-difference db-indices db-derived)) ;; class info (marked-slots (indexing-record-slots (indexed-record class))) --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/14 04:36:10 1.17 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/18 23:38:18 1.18 @@ -266,7 +266,8 @@ (defmethod remove-class-slot-index ((class symbol) slot-name &key (sc *store-controller*)) (remove-class-slot-index (find-class class) slot-name :sc sc)) -(defmethod remove-class-slot-index ((class persistent-metaclass) slot-name &key (sc *store-controller*) (update-class t)) +(defmethod remove-class-slot-index ((class persistent-metaclass) slot-name &key + (sc *store-controller*) (update-class t)) ;; NOTE: Write routines to recover BDB storage when you've wiped an index... ;; NOTE: If the transaction aborts we should not update class slots? (if (find-inverted-index class slot-name :null-on-fail t) @@ -282,7 +283,8 @@ (defmethod add-class-derived-index ((class symbol) name derived-defun &key (sc *store-controller*) (populate t)) (add-class-derived-index (find-class class) name derived-defun :sc sc :populate populate))

-(defmethod add-class-derived-index ((class persistent-metaclass) name derived-defun &key (populate t) (sc *store-controller*) (update-class t)) +(defmethod add-class-derived-index ((class persistent-metaclass) name derived-defun &key + (populate t) (sc *store-controller*) (update-class t)) (let ((class-idx (find-class-index class :sc sc))) (if (find-inverted-index class (make-derived-name name) :null-on-fail t) (error "Duplicate derived index requested named ~A on class ~A" name (class-name class)) @@ -297,7 +299,8 @@ (defmethod remove-class-derived-index ((class symbol) name &key (sc *store-controller*)) (remove-class-derived-index (find-class class) name :sc sc)) -(defmethod remove-class-derived-index ((class persistent-metaclass) name &key (sc *store-controller*) (update-class t)) +(defmethod remove-class-derived-index ((class persistent-metaclass) name &key + (sc *store-controller*) (update-class t)) (if (find-inverted-index class name :null-on-fail t) (progn (when update-class (unregister-derived-index class name))