[elephant-cvs] CVS elephant/tests
ieslick
ieslick at common-lisp.net
Sun Mar 11 05:45:18 UTC 2007
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 )
-
-
More information about the Elephant-cvs
mailing list