[elephant-cvs] CVS elephant/tests

[rread]

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv13327/tests

Modified Files:
	BerkeleyDB-tests.lisp SQLDB-tests.lisp testindexing.lisp 
Log Message:
New Configuration mechanism.  Minor test changes.  At least to SQL-side fixes.


--- /project/elephant/cvsroot/elephant/tests/BerkeleyDB-tests.lisp	2006/02/05 23:46:41	1.1
+++ /project/elephant/cvsroot/elephant/tests/BerkeleyDB-tests.lisp	2006/02/22 20:18:52	1.2
@@ -5,17 +5,11 @@
 ;;; as governed by the terms of the Lisp Lesser GNU Public License
 ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 
-(asdf:operate 'asdf:load-op :elephant)
-(asdf:operate 'asdf:load-op :ele-bdb)
 (asdf:operate 'asdf:load-op :elephant-tests)
 
 (in-package "ELEPHANT-TESTS")
 
-;; The primary and secondary test-paths are 
-;; use for the migration tests.
-;; 
-(setq *test-path-primary* *testdb-path*)
-(setq *test-path-secondary* nil)
+(setf *default-spec* *testbdb-spec*)
 
-(do-all-tests-spec *test-path-primary*)
+(do-backend-tests)
 
--- /project/elephant/cvsroot/elephant/tests/SQLDB-tests.lisp	2006/02/05 23:46:41	1.1
+++ /project/elephant/cvsroot/elephant/tests/SQLDB-tests.lisp	2006/02/22 20:18:52	1.2
@@ -11,26 +11,11 @@
 ;;; as governed by the terms of the Lisp Lesser GNU Public License
 ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 
-(asdf:operate 'asdf:load-op :elephant)
-(asdf:operate 'asdf:load-op :ele-clsql)
 (asdf:operate 'asdf:load-op :elephant-tests)
 
-;; For postgres use this...
-(asdf:oos 'asdf:load-op :clsql-postgresql-socket)
-;; For sqllite3... use this...
-;; (asdf:operate 'asdf:load-op :ele-sqlite3)
-
 (in-package "ELEPHANT-TESTS")
 
-;; The primary and secondary test-paths are 
-;; use for the migration tests.
-;; You may have to change these from the defaults set in
-;; elephant-tests.lisp to point to your database.
-(setq *test-path-primary* *testpg-path*)
-
-;; This is an alternative
-;; (setq *test-path-primary* *testsqlite3-path*)
+(setf *default-spec* *testpg-spec*)
 
-(setq *test-path-secondary* nil)
+(do-backend-tests)
 
-(do-all-tests-spec *test-path-primary*)
--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2006/02/22 17:15:49	1.8
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2006/02/22 20:18:54	1.9
@@ -24,15 +24,35 @@
 (defvar inst2)
 (defvar inst3)
 
+(deftest indexing-basic-trivial
+    (progn
+      (disable-class-indexing 'idx-one :errorp nil)
+      (setf (find-class 'idx-one) nil)
+      
+      (defclass idx-one ()
+	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
+	(:metaclass persistent-metaclass))
+      (length (get-instances-by-class 'idx-one))
+      (with-transaction (:store-controller *store-controller*)
+	(setq inst1 (make-instance 'idx-one :slot1 1 :sc *store-controller*)))
+;; The real problem is that this call doesn't seem to see it, and the make-instance
+;; doesn't seem to think it needs to write anything!
+      (length (get-instances-by-class 'idx-one))
+      (length (get-instances-by-class 'idx-one))
+      )
+  1)
+
 ;; 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* (elephant::controller-spec *store-controller*))
       ;;(format t "auto-commit: ~A~%" *auto-commit*)
-      (when (find-class 'idx-one nil)
-	(disable-class-indexing 'idx-one :errorp nil)
-	(setf (find-class 'idx-one) nil))
+
+      (disable-class-indexing 'idx-one :errorp nil)
+
+;; Possibly under SBCL this really hoses things up!
+;;      (setf (find-class 'idx-one) nil)
       
       (defclass idx-one ()
 	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
@@ -40,16 +60,16 @@
 
       (progn
 	(with-transaction (:store-controller *store-controller*)
-	  (setq inst1 (make-instance 'idx-one :slot1 1 :sc *store-controller*))
-	  (setq inst2 (make-instance 'idx-one :slot1 1 :sc *store-controller*))
-	  (setq inst3 (make-instance 'idx-one :slot1 3 :sc *store-controller*)))
+	  (setq inst1 (make-instance 'idx-one :slot1 40 :sc *store-controller*))
+	  (setq inst2 (make-instance 'idx-one :slot1 40 :sc *store-controller*))
+	  (setq inst3 (make-instance 'idx-one :slot1 41 :sc *store-controller*)))
 
 ;;	(format t "Starting gathering of instances~%")
 	(values (length (get-instances-by-class 'idx-one))
-		(length (get-instances-by-value 'idx-one 'slot1 1))
-		(length (get-instances-by-value 'idx-one 'slot1 3))
-		(eq (first (get-instances-by-value 'idx-one 'slot1 3)) inst3)
-		(length (get-instances-by-range 'idx-one 'slot1 1 3)))))
+		(length (get-instances-by-value 'idx-one 'slot1 40))
+		(length (get-instances-by-value 'idx-one 'slot1 41))
+		(equal (first (get-instances-by-value 'idx-one 'slot1 41)) inst3)
+		(length (get-instances-by-range 'idx-one 'slot1 40 41)))))
   3 2 1 t 3)
 
 ;; test inherited slots
@@ -100,7 +120,7 @@
 
 (deftest indexing-range
     (progn
-;;      (format t "range store: ~A  ~A~%" *store-controller* (controller-path *store-controller*))
+      ;;      (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))
@@ -115,19 +135,26 @@
       (with-transaction ()
 	(mapc #'make-idx-four '(1 1 1 2 2 4 5 5 5 6 10)))
 
-      ;; Range should get multiple & single keys inclusive of
-      ;; start and end
-      (values (equal (mapcar #'slot1 (get-instances-by-range 'idx-four 'slot1 2 6))
-		     '(2 2 4 5 5 5 6)) ;; interior range
-	      (equal (mapcar #'slot1 (get-instances-by-range 'idx-four 'slot1 0 2))
-		     '(1 1 1 2 2))
-	      (equal (mapcar #'slot1 (get-instances-by-range 'idx-four 'slot1 6 15))
-		     '(6 10))))
+      (let ((x1 (get-instances-by-range 'idx-four 'slot1 2 6))
+	    (x2 (get-instances-by-range 'idx-four 'slot1 0 2))
+	    (x3 (get-instances-by-range 'idx-four 'slot1 6 15))
+	    )
+	;;	(format t " x1 = ~A~%" (mapcar #'slot1 x1))
+	;;	(format t " x2 = ~A~%" (mapcar #'slot1 x2))
+	;;	(format t " x3 = ~A~%" (mapcar #'slot1 x3))
+	(values (equal (mapcar #'slot1 x1)
+		       '(2 2 4 5 5 5 6)) ;; interior range
+		(equal (mapcar #'slot1 x2)
+		       '(1 1 1 2 2))
+		(equal (mapcar #'slot1 x3)
+		       '(6 10))
+		))
+      )
   t t t)
 
 (deftest indexing-reconnect-db
     (progn 
-;;      (format t "connect store: ~A  ~A~%" *store-controller* (controller-path *store-controller*))
+      (format t "connect store: ~A  ~A~%" *store-controller* (elephant::controller-spec *store-controller*))
 
       (when (find-class 'idx-five nil)
 	(disable-class-indexing 'idx-five :errorp nil)
@@ -142,7 +169,8 @@
       (let ((*old-default* *default-indexed-class-synch-policy*)
 	    (*default-indexed-class-synch-policy* :db))
 
-	(with-transaction ()
+      (format t "connect store: ~A  ~A~%" *store-controller* (elephant::controller-spec *store-controller*))
+	(with-transaction (:store-controller *store-controller*)
 	  (make-instance 'idx-five))
 	
 	;; Wipe out the class so it's not a redefinition