Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp:/tmp/cvs-serv7130/tests
Modified Files: elephant-tests.lisp mop-tests.lisp testcollections.lisp testindexing.lisp testmigration.lisp testserializer.lisp testsleepycat.lisp Log Message: See elephant-devel mail for changes...and take a big, deep breath...
--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/02/17 22:45:21 1.13 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/02/19 04:53:02 1.14 @@ -60,86 +60,102 @@ ;; Putting this in to make the test work; I have no idea what it means... (deftype array-or-pointer-char () '(or array t))
- -(defvar *testdb-path* - (namestring - (merge-pathnames - #p"tests/testdb/" - (asdf:component-pathname (asdf:find-system 'elephant-tests))))) - -(defvar *testdb-path2* - (namestring - (merge-pathnames - #p"tests/testdb2/" - (asdf:component-pathname (asdf:find-system 'elephant-tests))))) - -(defvar *sleepycatdb-path* - (namestring - (merge-pathnames - #p"tests/testsleepycat/" - (asdf:component-pathname (asdf:find-system 'elephant-tests))))) - -(defvar *testpg-path* -'(:postgresql "localhost.localdomain" "test" "postgres" "")) - -(defvar *testsqlite3-path* -;; This is of the form '(filename &optional init-function), -;; and using :memory: as a file name will get you an completely in-memory system... -;; '(":memory:") - '(:sqlite3 "sqlite3-test.db") -) - -(defvar *test-path-primary* - *testdb-path* -) - -(defvar *test-path-secondary* - *testdb-path2* -) - -(defun do-all-tests() - (progn - (do-all-tests-spec *testdb-path*) - (do-all-tests-spec *testsqlite3-path*) - )) - -(defun do-test-spec (testname &optional (spec *testdb-path*)) - "For easy interactive running of tests while debugging" - (when spec +(defvar *testbdb-spec* + `(:bdb + ,(namestring + (merge-pathnames + #p"tests/testdb/" + (asdf:component-pathname (asdf:find-system 'elephant-tests))))) + "The primary test spec for testing sleepycat") + +(defvar *testbdb-spec2* + `(:bdb + ,(namestring + (merge-pathnames + #p"tests/testdb2/" + (asdf:component-pathname (asdf:find-system 'elephant-tests))))) + "A second bdb test directory for bdb-to-bdb tests") + +(defvar *testpg-spec* + '(:clsql (:postgresql "localhost.localdomain" "test" "postgres" ""))) + +(defvar *testsqlite3-spec* + '(:clsql (:sqlite3 "sqlite3-test.db")) + "This is of the form '(filename &optional init-function),") + +(defvar *testsqlite3-memory-spec* + '(:clsql (:sqlite3 :memory)) + "Using :memory: as a file name will get you an completely in-memory system") + + +;; +;; GUIDE TO TESTING +;; +;; 1) Set *default-spec* to the above spec of your choice +;; 2) Call (do-backend-tests) to test the standard API +;; 3) To test migration: (do-migration *default-spec* <second-spec>) inserting a second +;; spec, typically a bdb spec or create another instance of a sql db depending on +;; your configuration +;; 4) A backend is green if it passes do-backend-tests and can succesfully be +;; used as spec1 or spec2 argument in the migration test +;; + +(defvar *default-spec* nil + "Set this at the REPL to have the following interfaces default to a given spec + mostly here to save typing...") + +(defun do-backend-tests (&optional (spec *default-spec*)) + "Will test a specific backend based on the spec. Note, + if you run a :bdb backend test it will load sleepycat + specific tests which should silently succeed if you + test another backend" + (when (and (consp spec) (symbolp (car spec))) (with-open-store (spec) + (cond ((eq (car spec) :bdb) + (asdf:operate 'asdf:load-op :elephant-tests-bdb))) (let ((*auto-commit* nil)) - (do-test testname))))) - -(defun do-all-tests-spec(spec) + (do-tests))))) + +(defun do-test-spec (testname &optional (spec *default-spec*)) + "For easy interactive running of single tests while debugging" (when spec (with-open-store (spec) (let ((*auto-commit* nil)) - (declare (special *auto-commit*) - (dynamic-extent *auto-commit*)) - (do-tests))))) + (do-test testname)))))
-(defun do-indexing-tests () - (declare (special *old-store*)) - (setq *old-store* *store-controller*) - (unwind-protect - (progn - (let ((*auto-commit* nil)) - (declare (special *auto-commit*) - (dynamic-extent *auto-commit*)) - (open-store *testdb-path*) - (print (do-test 'indexing-basic)) - (print (do-test 'indexing-inherit)) - (print (do-test 'indexing-range)) - (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)) - (close-store))) - (setq *store-controller* *old-store*))) +(defun do-migration-tests (spec1 spec2) + "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*)) + (print (do-test 'remove-element)) + (print (do-test 'migrate1)) + (print (do-test 'migrate2)) + (print (do-test 'migrate3)) + (print (do-test 'migrate4)) + (print (do-test 'migrate5)))) + + + +;; +;; Various test groups +;; + +(defun do-indexing-tests (&optional (spec *default-spec*)) + "Just test indexing" + (with-open-store (spec) + (print (do-test 'indexing-basic)) + (print (do-test 'indexing-inherit)) + (print (do-test 'indexing-range)) + (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() - (open-store *testpg-path*) + "Specific problematic pg tests" + (open-store *testpg-spec*) (do-test 'indexed-btree-make) (do-test 'add-indices) (do-test 'test-indices) @@ -148,24 +164,23 @@ (close-store) )
-(defun do-migrate-test-spec(spud) - (with-open-store(spud) - (let ((*auto-commit* nil)) - (assert (equal (do-test 'remove-element) 'remove-element)) - (assert (equal (do-test 'migrate1) 'migrate1)) - (assert (equal (do-test 'migrate2) 'migrate2)) - (assert (equal (do-test 'migrate3) 'migrate3)) - (assert (equal (do-test 'migrate4) 'migrate4)) - (assert (equal (do-test 'migrate5) 'migrate5)) - t - ) - )) - (defun find-slot-def (class-name slot-name) (find-if #'(lambda (slot-def) (eq (slot-definition-name slot-def) slot-name)) (class-slots (find-class class-name))))
+ +(defvar *sleepycatdb-spec* + `(:bdb . ,(namestring + (merge-pathnames + #p"tests/testsleepycat/" + (asdf:component-pathname (asdf:find-system 'elephant-tests)))))) + + +;; +;; UTILITIES +;; + (defmacro finishes (&body body) `(handler-case (progn ,@body) --- /project/elephant/cvsroot/elephant/tests/mop-tests.lisp 2006/02/05 23:13:08 1.10 +++ /project/elephant/cvsroot/elephant/tests/mop-tests.lisp 2006/02/19 04:53:02 1.11 @@ -221,16 +221,19 @@ (slot2 foo)))) 1 2)
-(deftest change-class2 - (with-transaction (:store-controller *store-controller*) - (let ((foo (build-btree *store-controller*))) - (change-class foo (find-class - (if (typep *store-controller* 'bdb-store-controller) - 'bdb-indexed-btree - 'sql-indexed-btree) - )) - (is-not-null (indices foo)))) - t) +;; +;; ISE NOTE: This violates single backend testing, I've removed it for now +;; +;; (deftest change-class2 +;; (with-transaction (:store-controller *store-controller*) +;; (let ((foo (make-btree *store-controller*))) +;; (change-class foo (find-class +;; (if (typep *store-controller* 'bdb-store-controller) +;; 'bdb-indexed-btree +;; 'sql-indexed-btree) +;; )) +;; (is-not-null (indices foo)))) +;; t)
(deftest change-class3 (progn --- /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2006/02/07 23:23:51 1.11 +++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2006/02/19 04:53:02 1.12 @@ -22,8 +22,7 @@ (let ((x (gensym))) (add-to-root "x" x) ;; Clear instances - (setf (elephant::instance-cache *store-controller*) - (elephant::make-cache-table :test #'eql)) + (flush-instance-cache *store-controller*) ;; Are gensyms equal across db instantiations? ;; This forces a refetch of the object from db (setq rv (equal (format nil "~A" x) @@ -55,17 +54,9 @@ (defvar bt)
(deftest btree-make - (finishes (setq bt (build-btree *store-controller*))) + (finishes (setq bt (make-btree *store-controller*))) t)
-;; This is a very dangerous and naughty statement. -;; It was probably placed in this file for a good reason, -;; but nothing seems to reset it. The result is that after loading -;; theses tests, nothing works as you expect it later. -;; It may be that the proper fix is not just to take it out, -;; but that is the best that I can do right now. -;; (setq *auto-commit* nil) - (deftest btree-put (finishes (with-transaction (:store-controller *store-controller*) @@ -115,7 +106,7 @@
(deftest indexed-btree-make (finishes (with-transaction (:store-controller *store-controller*) - (setq indexed (build-indexed-btree *store-controller*)))) + (setq indexed (make-indexed-btree *store-controller*)))) t)
(defun key-maker (s key value) @@ -134,11 +125,18 @@ (values t (slot2 value))))))) t)
+;; ISE NOTE: indices accessor is not portable across backends in current +;; system so I'm using alternate access (map-indices) instead (deftest test-indices (values - (= (hash-table-count (indices indexed)) 2) - (eq index1 (gethash 'slot1 (indices indexed))) - (eq index2 (gethash 'slot2 (indices indexed)))) + ;; (= (hash-table-count (indices indexed)) 2) + (let ((count 0)) + (map-indices (lambda (x y) (declare (ignore x y)) (incf count)) indexed) + (eq count 2)) + ;; (gethash 'slot1 (indices indexed))) + (eq index1 (get-index indexed 'slot1)) + ;; (eq index2 (gethash 'slot2 (indices indexed)))) + (eq index2 (get-index indexed 'slot2))) t t t)
#| @@ -321,7 +319,7 @@
(deftest rem-kv (with-transaction (:store-controller *store-controller*) - (let ((ibt (build-indexed-btree *store-controller*))) + (let ((ibt (make-indexed-btree *store-controller*))) (loop for i from 0 to 10 do (setf (get-value i ibt) (* i i))) @@ -346,7 +344,7 @@
(deftest rem-idexkv (with-transaction (:store-controller *store-controller*) - (let* ((ibt (build-indexed-btree *store-controller*)) + (let* ((ibt (make-indexed-btree *store-controller*)) (id1 (add-index ibt :index-name 'idx1 :key-form 'odd))) (loop for i from 0 to 10 do @@ -387,7 +385,7 @@
(deftest make-indexed2 (finishes (with-transaction (:store-controller *store-controller*) - (setq indexed2 (build-indexed-btree *store-controller*)))) + (setq indexed2 (make-indexed-btree *store-controller*)))) t)
(defun crunch (s k v) @@ -473,7 +471,7 @@ ;; Note: If this is not done inside a transaction, ;; it HANGS BDB! (with-transaction (:store-controller *store-controller*) - (let* ((ibt (build-indexed-btree *store-controller*)) + (let* ((ibt (make-indexed-btree *store-controller*)) (id1 (add-index ibt :index-name 'idx1 :key-form 'odd))) (loop for i from 0 to 10 do @@ -533,7 +531,7 @@
(deftest cur-del2 (with-transaction (:store-controller *store-controller*) - (let* ((ibt (build-indexed-btree *store-controller*)) + (let* ((ibt (make-indexed-btree *store-controller*)) (id1 (add-index ibt :index-name 'idx1 :key-form 'odd))) (loop for i from 0 to 10 do @@ -691,12 +689,12 @@ (setq *auto-commit* t) (remove-from-root key) (setf exists1 - (from-root-existsp key) + (root-existsp key) ) (add-to-root key 'a) - (setf exists2 (from-root-existsp key)) + (setf exists2 (root-existsp key)) (remove-from-root key) - (setf exists3 (from-root-existsp key)) + (setf exists3 (root-existsp key)) ) (setq *auto-commit* *prev-commit*) ) @@ -709,7 +707,7 @@ ;; This test not only does not work, it appears to ;; hang sleepycat forcing a recovery!?!?!?! ;; (deftest cursor-put -;; (let* ((ibt (build-indexed-btree *store-controller*))) +;; (let* ((ibt (make-indexed-btree *store-controller*))) ;; (let ( ;; (index ;; (add-index ibt :index-name 'crunch :key-form 'crunch --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/10 01:39:13 1.4 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/19 04:53:02 1.5 @@ -20,12 +20,16 @@ (trace elephant::db-transaction-commit) )
+(defvar inst1) +(defvar inst2) +(defvar inst3) + ;; put list of objects, retrieve on value, range and by class (deftest indexing-basic (progn -;; (format t "Global vars:~%") -;; (format t "~%basic store: ~A ~A~%" *store-controller* (controller-path *store-controller*)) -;; (format t "auto-commit: ~A~%" *auto-commit*) + ;;(format t "Global vars:~%") + ;;(format t "~%basic store: ~A ~A~%" *store-controller* (elephant::controller-spec *store-controller*)) + ;;(format t "auto-commit: ~A~%" *auto-commit*) (disable-class-indexing 'idx-one :errorp nil) (setf (find-class 'idx-one) nil)
--- /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/02/05 23:13:08 1.6 +++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/02/19 04:53:02 1.7 @@ -14,50 +14,53 @@ (in-package :ele-tests)
(deftest remove-element - (if (or (null *test-path-secondary*) - (null *test-path-primary*)) + (if (or (not (boundp '*test-spec-secondary*)) + (null *test-spec-secondary*)) (progn - (format t "*test-path-secondary* and *test-path-primary* not both set, skipping this test.") + (format t "~%Single store mode: ignoring") t) - (let ((a (vector 'a 'b 'c)) - (ans (vector 'a 'c))) - (setf a (ele::remove-indexed-element-and-adjust 1 a)) - (and (equal (aref a 0) (aref ans 0)) - (equal (aref a 1) (aref ans 1)) - (equal (length a) (length ans))))) + (let ((a (vector 'a 'b 'c)) + (ans (vector 'a 'c))) + (setf a (ele::remove-indexed-element-and-adjust 1 a)) + (and (equal (aref a 0) (aref ans 0)) + (equal (aref a 1) (aref ans 1)) + (equal (length a) (length ans))))) t)
- (deftest migrate1 - (if (or (null *test-path-secondary*) - (null *test-path-primary*)) + (if (or (not (boundp '*test-spec-secondary*) ) + (null *test-spec-secondary*)) (progn - (format t "*test-path-secondary* and *test-path-primary* not both set, skipping this test.") + (format t "~%Single store mode: ignoring") t) (let ((old-store *store-controller*) (*prev-commit* *auto-commit*) (*auto-commit* t) - (rv nil)) - (unwind-protect - (let ( - (sc1 (open-store *test-path-primary*)) - (sc2 (open-store *test-path-secondary*))) - (add-to-root "x" "y" :store-controller sc1) - (copy-from-key "x" sc1 sc2) - (setf rv (equal (get-from-root "x" :store-controller sc1) - (get-from-root "x" :store-controller sc2)))) - (progn - (setq *store-controller* old-store) - (setq *auto-commit* *prev-commit*))) + (rv nil) + (sc1 nil) + (sc2 nil)) + (unwind-protect + (progn + (setf sc1 (open-store *test-spec-primary*)) + (setf sc2 (open-store *test-spec-secondary*)) + (add-to-root "x" "y" :store-controller sc1) + (copy-from-key "x" sc1 sc2) + (setf rv (equal (get-from-root "x" :store-controller sc1) + (get-from-root "x" :store-controller sc2)))) + (progn + (when sc1 (close-store sc1)) + (when sc2 (close-store sc2)) + (setq *store-controller* old-store) + (setq *auto-commit* *prev-commit*))) rv)) - t) + t)
(deftest migrate2 - (if (or (null *test-path-secondary*) - (null *test-path-primary*)) + (if (or (not (boundp '*test-spec-secondary*) ) + (null *test-spec-secondary*)) (progn - (format t "*test-path-secondary* and *test-path-primary* not both set, skipping this test.") + (format t "~%Single store mode: ignoring") nil) (let ((old-store *store-controller*) (*prev-commit* *auto-commit*) @@ -65,8 +68,8 @@ (rv nil)) (unwind-protect (let - ((sc1 (open-store *test-path-primary*)) - (sc2 (open-store *test-path-secondary*))) + ((sc1 (open-store *test-spec-primary*)) + (sc2 (open-store *test-spec-secondary*))) (let ((ibt (build-btree sc1))) (loop for i from 0 to 10 do @@ -80,18 +83,18 @@
(deftest migrate3 - (if (or (null *test-path-secondary*) - (null *test-path-primary*)) + (if (or (not (boundp '*test-spec-secondary*) ) + (null *test-spec-secondary*)) (progn - (format t "*test-path-secondary* and *test-path-primary* not both set, skipping this test.") + (format t "~%Single store mode: ignoring") t) (let ((old-store *store-controller*) (*prev-commit* *auto-commit*) (*auto-commit* t) (rv nil)) (unwind-protect - (let ((sc1 (open-store *test-path-primary*)) - (sc2 (open-store *test-path-secondary*)) + (let ((sc1 (open-store *test-spec-primary*)) + (sc2 (open-store *test-spec-secondary*)) ) (let* ((ibt (build-indexed-btree sc1))) (let ( @@ -125,10 +128,10 @@
(deftest migrate4 - (if (or (null *test-path-secondary*) - (null *test-path-primary*)) + (if (or (not (boundp '*test-spec-secondary*) ) + (null *test-spec-secondary*)) (progn - (format t "*test-path-secondary* and *test-path-primary* not both set, skipping this test.") + (format t "~%Single store mode: ignoring") t) (finishes (let ((old-store *store-controller*) @@ -137,8 +140,8 @@ (rv nil)) (unwind-protect (let* ( - (sc1 (open-store *test-path-primary*)) - (sc2 (open-store *test-path-secondary*)) + (sc1 (open-store *test-spec-primary*)) + (sc2 (open-store *test-spec-secondary*)) ) (let* ((ibt (build-indexed-btree sc1))) (let ( @@ -158,34 +161,34 @@ t)
(deftest migrate5 - (if (or (null *test-path-secondary*) - (null *test-path-primary*)) + (if (or (not (boundp '*test-spec-secondary*) ) + (null *test-spec-secondary*)) (progn - (format t "*test-path-secondary* and *test-path-primary* not both set, skipping this test.") + (format t "~%Single store mode: ignoring") t) (let ((*prev-commit* *auto-commit*)) - (prog2 - (setq *auto-commit* t) - (let ( - (sc1 (open-store *test-path-primary*)) - (sc2 (open-store *test-path-secondary*))) - (let* ((f1 (make-instance 'pfoo :sc sc1)) - (f2 (make-instance 'pfoo :slot1 "this is a string" :sc sc1)) - (b1 (make-instance 'pbar :slot2 "another string" :sc sc1)) - ) - (let ((fm1 - (ele::migraten-pobj - sc2 f1 - #'(lambda (dst src) - (if (slot-boundp src 'slot1) - (setf (slot1 dst) (slot1 src)))))) + (prog2 + (setq *auto-commit* t) + (let ( + (sc1 (open-store *test-spec-primary*)) + (sc2 (open-store *test-spec-secondary*))) + (let* ((f1 (make-instance 'pfoo :sc sc1)) + (f2 (make-instance 'pfoo :slot1 "this is a string" :sc sc1)) + (b1 (make-instance 'pbar :slot2 "another string" :sc sc1)) + ) + (let ((fm1 + (migrate ;; (ele::migraten-pobj + sc2 f1 + #'(lambda (dst src) + (if (slot-boundp src 'slot1) + (setf (slot1 dst) (slot1 src)))))) (fm2 - (ele::migraten-pobj + (migrate ;; (ele::migraten-pobj sc2 f2 #'(lambda (dst src) (if (slot-boundp src 'slot1) (setf (slot1 dst) (slot1 src)))))) - (bm1 (ele::migraten-pobj + (bm1 (migrate ;; (ele::migraten-pobj sc2 b1 #'(lambda (dst src) (if (slot-boundp src 'slot2) --- /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2006/02/04 22:25:10 1.9 +++ /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2006/02/19 04:53:02 1.10 @@ -375,7 +375,7 @@ ;; test it both ways...since we won't know how they will want it ;; implemented, we will have to somehow make a choice here, maybe ;; based on the stype of *store-controller* - (h (build-btree *store-controller*))) + (h (make-btree *store-controller*))) (are-not-null (in-out-eq f1) (in-out-eq f2) --- /project/elephant/cvsroot/elephant/tests/testsleepycat.lisp 2006/02/04 22:25:10 1.6 +++ /project/elephant/cvsroot/elephant/tests/testsleepycat.lisp 2006/02/19 04:53:02 1.7 @@ -13,12 +13,13 @@
(in-package "ELE-TESTS")
+ (defvar env) (defvar db)
-(defun prepare-sleepycat() +(defun prepare-sleepycat () (setq env (sleepycat::db-env-create)) - (sleepycat::db-env-open env *sleepycatdb-path* :create t :init-txn t :init-lock t + (sleepycat::db-env-open env (cdr *sleepycatdb-spec*) :create t :init-txn t :init-lock t :init-mpool t :init-log t :thread t :recover-fatal t)
@@ -27,11 +28,12 @@ :auto-commit t :create t :thread t))
(deftest prepares-sleepycat - (if (not (find-package 'ele-bdb)) + (progn + (if (not (find-package :sleepycat)) (progn - (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%") - t) - (finishes (prepare-sleepycat))) + (format t "sleepycat db not valid, so not runnning test prepares-sleepycat~%") + t) + (finishes (prepare-sleepycat)))) t)
#| @@ -77,7 +79,7 @@ (deftest test-seq1 (if (not (find-package 'ele-bdb)) (progn - (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%") + (format t "database db not valid, so not runnning test test-seq1~%") t) (finishes (test-sequence1))) t) @@ -98,11 +100,11 @@ finally (sleepycat::db-sequence-remove seq :auto-commit t))))
(deftest test-seq2 - (if (not (find-package 'ele-bdb)) + (if (not db) (progn - (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%") - t) - (finishes (test-sequence2))) + (format t "sleepycat db not valid, so not runnning test test-seq2~%") + t) + (finishes (test-sequence2))) t)
(defun cleanup-sleepycat () @@ -113,9 +115,9 @@ (sleepycat::db-env-remove env "test"))
(deftest cleansup-sleepycat - (if (not (find-package 'ele-bdb)) + (if (not db) (progn - (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%") + (format t "sleepycat db not valid, so not runnning test cleanup-sleepycat~%") t) (finishes (cleanup-sleepycat))) t)