Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp:/tmp/cvs-serv18474/tests
Modified Files: elephant-tests.lisp testindexing.lisp Log Message:
Quick fix for config.lisp not having a package designator. Also my tweaks to fix a BDB bug, adding transacctions to btree writes for increased safety and various tweaks I made trying to fix the slot-boundp bug in indexing-redef-class
--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/02/21 19:40:08 1.17 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/02/22 21:03:48 1.18 @@ -155,7 +155,6 @@ (print (do-test 'indexing-reconnect-db)) (print (do-test 'indexing-change-class)) (print (do-test 'indexing-redef-class)) - (print (do-test 'indexing-explicit-changes)) (print (do-test 'indexing-timing))))
(defun do-crazy-pg-tests() --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/22 20:18:54 1.9 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/22 21:03:48 1.10 @@ -47,12 +47,11 @@ (progn ;;(format t "Global vars:~%") ;;(format t "~%basic store: ~A ~A~%" *store-controller* (elephant::controller-spec *store-controller*)) - ;;(format t "auto-commit: ~A~%" *auto-commit*) +;; (format t "auto-commit: ~A~%" *auto-commit*)
- (disable-class-indexing 'idx-one :errorp nil) - -;; Possibly under SBCL this really hoses things up! -;; (setf (find-class 'idx-one) nil) + (when (find-class 'idx-one nil) + (disable-class-indexing 'idx-one :errorp nil) + (setf (find-class 'idx-one nil) nil))
(defclass idx-one () ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) @@ -76,7 +75,7 @@ (deftest indexing-inherit (progn ;; (format t "inherit store: ~A ~A~%" *store-controller* (controller-path *store-controller*)) - + (when (find-class 'idx-two nil) (disable-class-indexing 'idx-two :sc *store-controller* :errorp nil) (setf (find-class 'idx-two) nil)) @@ -123,7 +122,7 @@ ;; (format t "range store: ~A ~A~%" *store-controller* (controller-path *store-controller*)) (when (find-class 'idx-four nil) (disable-class-indexing 'idx-four :errorp nil) - (setf (find-class 'idx-four) nil)) + (setf (find-class 'idx-four nil) nil))
(defclass idx-four () ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)) @@ -166,8 +165,7 @@ (slot3 :initarg :slot3 :initform 3 :accessor slot3 :index t)) (:metaclass persistent-metaclass))
- (let ((*old-default* *default-indexed-class-synch-policy*) - (*default-indexed-class-synch-policy* :db)) + (let ((*default-indexed-class-synch-policy* :db))
(format t "connect store: ~A ~A~%" *store-controller* (elephant::controller-spec *store-controller*)) (with-transaction (:store-controller *store-controller*) @@ -250,6 +248,8 @@ (disable-class-indexing 'idx-eight :errorp nil) (setf (find-class 'idx-eight nil) nil))
+;; (format t "sc: ~A ct: ~A~%" *store-controller* *current-transaction*) + (defclass idx-eight () ((slot1 :accessor slot1 :initarg :slot1 :index t) (slot2 :accessor slot2 :initarg :slot2) @@ -268,8 +268,8 @@ ((slot1 :accessor slot1 :initarg :slot1 :initform 11) (slot2 :accessor slot2 :initarg :slot2 :initform 12 :index t) (slot3 :accessor slot3 :initarg :slot3 :initform 13) - (slot6 :accessor slot6 :initarg :slot6 :initform 14 :index t) - (slot7 :accessor slot7 :initarg :slot7)) + (slot7 :accessor slot7 :initarg :slot7) + (slot6 :accessor slot6 :initarg :slot6 :index t)) (:metaclass persistent-metaclass))
(values @@ -280,10 +280,13 @@ (eq (slot3 o1) 13) ;; transient values not preserved (would be inconsistent) (and (not (slot-exists-p o1 'slot4)) (not (slot-exists-p o1 'slot5)) - (signals-error (get-instances-by-value 'idx-eight 'slot4))) + (signals-error (get-instances-by-value 'idx-eight 'slot4 4))) (and (eq (slot6 o1) 14) (eq (length (get-instances-by-value 'idx-eight 'slot6 14)) 2)) - (and (not (slot-boundp o1 'slot7)))))) + (and (slot-exists-p o1 'slot7) + (not (slot-boundp o1 'slot7))) + (and (slot-exists-p o2 'slot7) + (not (slot-boundp o2 'slot7)))))) t t t t t t)
;; create 500 objects, write each object's slots