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