[elephant-cvs] CVS elephant/tests
ieslick
ieslick at common-lisp.net
Sat Feb 3 04:09:16 UTC 2007
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
More information about the Elephant-cvs
mailing list