Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv24007/tests
Modified Files: delscript.sh elephant-tests.lisp testmigration.lisp Log Message: Added support for maintaining oid-to-oid map in an external database; cleaned up tests and do-migration-tests to allow validation
--- /project/elephant/cvsroot/elephant/tests/delscript.sh 2007/02/05 17:22:58 1.4 +++ /project/elephant/cvsroot/elephant/tests/delscript.sh 2007/03/11 05:45:17 1.5 @@ -1,14 +1,14 @@ rm testdb/__* rm testdb/%* rm testdb/log* -rm testdb/VERSION rm testdb2/__* rm testdb2/%* rm testdb2/log* -rm testdb2/VERSION +rm testdb-oid/__* +rm testdb-oid/%* +rm testdb-oid/log* rm testbdb/testsbdb rm testbdb/__* rm testbdb/log* -rm testbdb/VERSION rm sqlite3-test.db rm sqlite3-test2.db \ No newline at end of file --- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/03/11 03:31:10 1.27 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/03/11 05:45:17 1.28 @@ -76,6 +76,13 @@ (asdf:component-pathname (asdf:find-system 'elephant-tests))))) "A second bdb test directory for bdb-to-bdb tests")
+(defvar *testbdb-spec-oid* + `(:bdb + ,(namestring + (merge-pathnames + #p"tests/testdb-oid/" + (asdf:component-pathname (asdf:find-system 'elephant-tests)))))) + (defvar *testpg-spec* '(:clsql (:postgresql "localhost.localdomain" "test" "postgres" "")))
@@ -135,18 +142,23 @@ (let ((*auto-commit* nil)) (do-test testname)))))
-(defun do-migration-tests (spec1 spec2) +(defun do-migration-tests (spec1 spec2 &optional oid-spec) "Interface to do explicit migration tests between backends" (let ((*test-spec-primary* spec1) (*test-spec-secondary* spec2)) (declare (special *test-spec-primary* *test-spec-secondary*)) + (if oid-spec + (set-oid-spec oid-spec) + (set-oid-spec nil)) (print (do-test 'remove-element)) (print (do-test 'migrate-basic)) (print (do-test 'migrate-btree)) (print (do-test 'migrate-idx-btree)) (print (do-test 'migrate-pclass)) (print (do-test 'migrate-mult-pclass)) - (print (do-test 'migrate-ipclass)))) + (print (do-test 'migrate-ipclass)) + (when oid-spec + (set-oid-spec nil))))
(defun do-migration-test-spec (test spec1 spec2) (let ((*test-spec-primary* spec1) --- /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2007/03/11 03:31:10 1.15 +++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2007/03/11 05:45:17 1.16 @@ -39,10 +39,12 @@ (sc2 (open-store *test-spec-secondary* :recover t))) (unwind-protect (progn + (elephant::initialize-migrate-duplicate-detection) (add-to-root "x" "y" :store-controller sc1) (migrate sc2 sc1) (equal (get-from-root "x" :store-controller sc1) (get-from-root "x" :store-controller sc2))) + (elephant::clear-migrate-duplicate-detection) (close-store sc1) (close-store sc2)))) t) @@ -59,13 +61,16 @@ (sc2 (open-store *test-spec-secondary* :recover t))) (declare (special *store-controller*)) (unwind-protect - (let ((ibt (make-btree sc1))) - (with-transaction (:store-controller sc1) - (loop for i from 0 to 10 - do - (setf (get-value i ibt) (* i i)))) - (let ((mig (migrate sc2 ibt))) - (btree-differ-p ibt mig))) + (progn + (elephant::initialize-migrate-duplicate-detection) + (let ((ibt (make-btree sc1))) + (with-transaction (:store-controller sc1) + (loop for i from 0 to 10 + do + (setf (get-value i ibt) (* i i)))) + (let ((mig (migrate sc2 ibt))) + (btree-differ-p ibt mig)))) + (elephant::clear-migrate-duplicate-detection) (close-store sc1) (close-store sc2)))) nil) @@ -84,6 +89,7 @@ (sc2 (open-store *test-spec-secondary* :recover t))) (unwind-protect (let* ((ibt (make-indexed-btree sc1))) + (elephant::initialize-migrate-duplicate-detection) (let ((index (add-index ibt :index-name 'crunch :key-form 'crunch :populate t))) @@ -105,6 +111,7 @@ ))) (not (btree-differ-p ibt mig))))) (progn + (elephant::clear-migrate-duplicate-detection) (setq *store-controller* old-store) (close-store sc1) (close-store sc2))))) @@ -123,6 +130,7 @@ (declare (special *store-controller*)) (unwind-protect (progn + (elephant::initialize-migrate-duplicate-detection) ;; Make instances (let* ((f1 (with-transaction (:store-controller sc1) (make-instance 'pfoo :sc sc1))) @@ -140,48 +148,72 @@ (equal (slot1 fm2) (slot1 f2)) (equal (slot2 bm1) (slot2 b1))) ))) + (elephant::clear-migrate-duplicate-detection) (close-store sc1) (close-store sc2)))) t)
+(defclass simple-class () + ((slot1 :accessor slot1 :initarg :slot1) + (slot2 :accessor slot2 :initarg :slot2))) + +(defstruct simple-struct s1 s2) + (deftest migrate-mult-pclass (progn - (let* ((*store-controller* nil) - (sc1 (open-store *test-spec-primary* :recover t :deadlock-detect t)) - (sc2 (open-store *test-spec-secondary* :recover t :deadlock-detect t))) + (let* ((sc1 (open-store *test-spec-primary* :recover t :deadlock-detect t)) + (sc2 (open-store *test-spec-secondary* :recover t :deadlock-detect t)) + (*store-controller* nil)) + (declare (special *store-controller*)) (unwind-protect - (progn (elephant::reset-migrate-duplicate-detection) + (progn (elephant::initialize-migrate-duplicate-detection) (let* ((simplesrc (make-instance 'pfoo :slot1 0 :sc sc1)) (i1 (make-instance 'pfoo :slot1 1 :sc sc1)) (i2 (make-instance 'pfoo :slot1 2 :sc sc1)) (i3 (make-instance 'pfoo :slot1 3 :sc sc1)) + (i4 (make-instance 'pfoo :slot1 4 :sc sc1)) + (i5 (make-instance 'pfoo :slot1 5 :sc sc1)) (list (list i1 i1)) (array (make-array '(2 2) :initial-contents `((,i2 1) (,i2 2)))) - (hash (make-hash-table))) - (setf (gethash 1 hash) i3) - (setf (gethash 2 hash) i3) - (let* ((newsimple (migrate sc2 simplesrc)) - (newlist (migrate sc2 list)) - (newarray (migrate sc2 array)) - (newhash (migrate sc2 hash))) - (values (and (and (slot-boundp newsimple 'slot1) - (eq (slot1 newsimple) 0))) - (and (not (eq i1 (first newlist))) - (eq (first newlist) (second newlist)) - (and (slot-boundp (first newlist) 'slot1) - (eq (slot1 (first newlist)) 1))) - (and (not (eq i2 (aref newarray 0 0))) - (eq (aref newarray 0 0) (aref newarray 1 0)) - (and (slot-boundp (aref newarray 0 0) 'slot1) - (eq (slot1 (aref newarray 0 0)) 2))) - (and (not (eq i3 (gethash 1 newhash))) - (eq (gethash 1 newhash) (gethash 2 newhash)) - (and (slot-boundp (gethash 1 newhash) 'slot1) - (eq (slot1 (gethash 1 newhash)) 3))))))) + (hash (make-hash-table)) + (object (make-instance 'simple-class :slot1 i4 :slot2 i4)) + (struct (make-simple-struct :s1 i5 :s2 i5))) + (setf (gethash 1 hash) i3) + (setf (gethash 2 hash) i3) + (let* ((newsimple (migrate sc2 simplesrc)) + (newlist (migrate sc2 list)) + (newarray (migrate sc2 array)) + (newhash (migrate sc2 hash)) + (newobject (migrate sc2 object)) + (newstruct (migrate sc2 struct))) + (values (and (and (slot-boundp newsimple 'slot1) + (eq (slot1 newsimple) 0))) + (and (not (eq i1 (first newlist))) + (eq (first newlist) (second newlist)) + (and (slot-boundp (first newlist) 'slot1) + (eq (slot1 (first newlist)) 1))) + (and (not (eq i2 (aref newarray 0 0))) + (eq (aref newarray 0 0) (aref newarray 1 0)) + (and (slot-boundp (aref newarray 0 0) 'slot1) + (eq (slot1 (aref newarray 0 0)) 2))) + (and (not (eq i3 (gethash 1 newhash))) + (eq (gethash 1 newhash) (gethash 2 newhash)) + (and (slot-boundp (gethash 1 newhash) 'slot1) + (eq (slot1 (gethash 1 newhash)) 3))) + (and (not (eq i4 (slot1 newobject))) + (eq (slot1 newobject) (slot2 newobject)) + (and (slot-boundp (slot1 newobject) 'slot1) + (eq (slot1 (slot1 newobject)) 4))) + (and (not (eq i5 (simple-struct-s1 newstruct))) + (eq (simple-struct-s1 newstruct) + (simple-struct-s2 newstruct)) + (and (slot-boundp (simple-struct-s1 newstruct) 'slot1) + (eq (slot1 (simple-struct-s1 newstruct)) 5))))))) (close-store sc1) - (close-store sc2)))) - t t t t t t t t t t) + (close-store sc2) + (elephant::clear-migrate-duplicate-detection)))) + t t t t t t)
(defpclass ipfoo () ((slot1 :accessor slot1 :initarg :slot1 :index t))) @@ -241,5 +273,3 @@ (close-store sc2))))) 3 1 1 1 1 10 20 )
- -