Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv11297/tests
Modified Files: mop-tests.lisp testcollections.lisp testindexing.lisp testmigration.lisp Log Message: Clean up auto-commit usage in tests; change buffer-stream to unsigned-char - this may break things for sbcl but works for Allegro on Mac OS X
--- /project/elephant/cvsroot/elephant/tests/mop-tests.lisp 2006/02/19 04:53:02 1.11 +++ /project/elephant/cvsroot/elephant/tests/mop-tests.lisp 2007/02/03 04:09:14 1.12 @@ -151,15 +151,13 @@ t)
(deftest initform-test - (let ((*auto-commit* t)) - (slot-value (make-instance 'p-initform-test :sc *store-controller*) 'slot1)) + (slot-value (make-instance 'p-initform-test :sc *store-controller*) 'slot1) 10)
(deftest initarg-test - (let ((*auto-commit* t)) - (values - (slot-value (make-instance 'p-initform-test-2 :sc *store-controller*) 'slot1) - (slot-value (make-instance 'p-initform-test-2 :slot1 20 :sc *store-controller*) 'slot1))) + (values + (slot-value (make-instance 'p-initform-test-2 :sc *store-controller*) 'slot1) + (slot-value (make-instance 'p-initform-test-2 :slot1 20 :sc *store-controller*) 'slot1)) 10 20)
(deftest no-eval-initform @@ -167,8 +165,7 @@ (defclass no-eval-initform () ((slot1 :initarg :slot1 :initform (error "Shouldn't be called"))) (:metaclass persistent-metaclass)) - (let ((*auto-commit* t)) - (make-instance 'no-eval-initform :slot1 "something" :sc *store-controller* )) + (make-instance 'no-eval-initform :slot1 "something" :sc *store-controller* ) t) t)
@@ -192,8 +189,7 @@ (defclass update-class () ((slot1 :initform 1 :accessor slot1)) (:metaclass persistent-metaclass)) - (let* ((*auto-commit* t) - (foo (make-instance 'update-class :sc *store-controller*))) + (let* ((foo (make-instance 'update-class :sc *store-controller*))) (defclass update-class () ((slot2 :initform 2 :accessor slot2)) (:metaclass persistent-metaclass)) @@ -213,8 +209,7 @@ (slot2 :initform 2 :accessor slot2)) (:metaclass persistent-metaclass))
- (let* ((*auto-commit* t) - (foo (make-instance 'class-one :sc *store-controller*))) + (let* ((foo (make-instance 'class-one :sc *store-controller*))) (change-class foo (find-class 'class-two)) (values (slot1 foo) @@ -246,8 +241,7 @@ (slot2 :initform 2 :accessor slot2)) (:metaclass persistent-metaclass))
- (let* ((*auto-commit* t) - (foo (make-instance 'class-one :sc *store-controller*))) + (let* ((foo (make-instance 'class-one :sc *store-controller*))) (change-class foo (find-class 'class-two)) (values (slot1 foo) --- /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2006/11/11 18:41:11 1.13 +++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2007/02/03 04:09:14 1.14 @@ -15,20 +15,15 @@ (in-package :ele-tests)
(deftest basicpersistence - (let ((*prev-commit* *auto-commit*) - (*auto-commit* t) - (rv nil)) - (unwind-protect - (let ((x (gensym))) - (add-to-root "x" x) - ;; Clear instances - (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) - (format nil "~A" (get-from-root "x"))))) - (progn - (setq *auto-commit* *prev-commit*))) + (let ((rv nil)) + (let ((x (gensym))) + (add-to-root "x" x) + ;; Clear instances + (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) + (format nil "~A" (get-from-root "x"))))) rv) t)
@@ -626,26 +621,19 @@
(deftest add-get-remove (let ((r1 '()) - (r2 '()) - (*prev-commit* *auto-commit*)) - (unwind-protect - (progn - (setq *auto-commit* t) - (add-to-root "x1" "y1") - (add-to-root "x2" "y2") - (setf r1 (get-from-root "x1")) - (setf r2 (get-from-root "x2")) - (remove-from-root "x1") - (remove-from-root "x2") - (and - (equal "y1" r1) - (equal "y2" r2) - (equal nil (get-from-root "x1")) - (equal nil (get-from-root "x2")) - ) - ) - (setq *auto-commit* *prev-commit*) - )) + (r2 '())) + (add-to-root "x1" "y1") + (add-to-root "x2" "y2") + (setf r1 (get-from-root "x1")) + (setf r2 (get-from-root "x2")) + (remove-from-root "x1") + (remove-from-root "x2") + (and + (equal "y1" r1) + (equal "y2" r2) + (equal nil (get-from-root "x1")) + (equal nil (get-from-root "x2")) + )) t)
(deftest add-get-remove-symbol @@ -654,52 +642,34 @@ (f1 '()) (f2 '()) (b1 '()) - (b2 '()) - (*prev-commit* *auto-commit*)) - (unwind-protect - (progn - (setq *auto-commit* t) - (add-to-root "my key" foo) - (add-to-root "my other key" foo) - (setf f1 (get-from-root "my key")) - (setf f2 (get-from-root "my other key")) - (add-to-root "my key" bar) - (add-to-root "my other key" bar) - (setf b1 (get-from-root "my key")) - (setf b2 (get-from-root "my other key")) - (and - (equal f1 f2) - (equal b1 b2) - (equal f1 foo) - (equal b1 bar) - )) - (setq *auto-commit* *prev-commit*) - )) + (b2 '())) + (add-to-root "my key" foo) + (add-to-root "my other key" foo) + (setf f1 (get-from-root "my key")) + (setf f2 (get-from-root "my other key")) + (add-to-root "my key" bar) + (add-to-root "my other key" bar) + (setf b1 (get-from-root "my key")) + (setf b2 (get-from-root "my other key")) + (and + (equal f1 f2) + (equal b1 b2) + (equal f1 foo) + (equal b1 bar))) t)
(deftest existsp (let ((exists1 '()) (exists2 '()) (exists3 '()) - (key "my key") - (*prev-commit* *auto-commit*) - ) - (unwind-protect - (progn - (setq *auto-commit* t) - (remove-from-root key) - (setf exists1 - (root-existsp key) - ) - (add-to-root key 'a) - (setf exists2 (root-existsp key)) - (remove-from-root key) - (setf exists3 (root-existsp key)) - ) - (setq *auto-commit* *prev-commit*) - ) - (values exists1 exists2 exists3) - ) + (key "my key")) + (remove-from-root key) + (setf exists1 (root-existsp key)) + (add-to-root key 'a) + (setf exists2 (root-existsp key)) + (remove-from-root key) + (setf exists3 (root-existsp key)) + (values exists1 exists2 exists3)) nil t nil )
--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/01/25 19:37:55 1.21 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/02/03 04:09:14 1.22 @@ -72,7 +72,6 @@ (let ((n 105)) ;;(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 (class-indexedp-by-name 'idx-one) (disable-class-indexing 'idx-one :errorp nil) @@ -289,11 +288,7 @@ &key) (setf (slot3 new) (slot2 old)))
- (let ((*auto-commit* t) - (foo nil)) - (declare (special *auto-commit*) - (dynamic-extent *auto-commit*)) - (setf foo (make-instance 'idx-six)) + (let ((foo (make-instance 'idx-six))) (change-class foo 'idx-seven) (values --- /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/04/26 19:19:12 1.13 +++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2007/02/03 04:09:14 1.14 @@ -35,7 +35,6 @@ (format t "~%Single store mode: ignoring") t) (let* ((*store-controller*) - (*auto-commit* t) (sc1 (open-store *test-spec-primary* :recover t)) (sc2 (open-store *test-spec-secondary* :recover t))) (unwind-protect @@ -56,10 +55,9 @@ (format t "~%Single store mode: ignoring") nil) (let ((*store-controller* nil) - (*auto-commit* t) (sc1 (open-store *test-spec-primary* :recover t)) (sc2 (open-store *test-spec-secondary* :recover t))) - (declare (special *store-controller* *auto-commit*)) + (declare (special *store-controller*)) (unwind-protect (let ((ibt (make-btree sc1))) (with-transaction (:store-controller sc1) @@ -81,12 +79,9 @@ t) (let ((old-store *store-controller*) (*store-controller* nil) - (*prev-commit* *auto-commit*) - (*auto-commit* t) (rv nil) (sc1 (open-store *test-spec-primary* :recover t)) (sc2 (open-store *test-spec-secondary* :recover t))) - (declare (special *auto-commit*)) (unwind-protect (let* ((ibt (make-indexed-btree sc1))) (let ((index @@ -111,7 +106,6 @@ (not (btree-differ ibt mig))))) (progn (setq *store-controller* old-store) - (setq *auto-commit* *prev-commit*) (close-store sc1) (close-store sc2))))) t) @@ -123,11 +117,10 @@ (progn (format t "~%Single store mode: ignoring") t) - (let ((*auto-commit* t) - (*store-controller* nil) + (let ((*store-controller* nil) (sc1 (open-store *test-spec-primary* :recover t)) (sc2 (open-store *test-spec-secondary* :recover t))) - (declare (special *auto-commit* *store-controller*)) + (declare (special *store-controller*)) (unwind-protect (progn ;; Make instances @@ -163,11 +156,10 @@ (values 3 1 1 1 1 10 20 )) (progn ;; (format t "Opening store~%") - (let ((*auto-commit* nil) - (sc2 (open-store *test-spec-secondary* :recover t)) + (let ((sc2 (open-store *test-spec-secondary* :recover t)) (sc1 (open-store *test-spec-primary* :recover t)) (*store-controller* nil)) - (declare (special *auto-commit* *store-controller*)) + (declare (special *store-controller*)) (unwind-protect ;; ensure class index is initialized in sc1 (progn