[elephant-cvs] CVS elephant/tests

ieslick ieslick at common-lisp.net
Sun Feb 19 04:53:03 UTC 2006


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 , at 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)




More information about the Elephant-cvs mailing list