[elephant-cvs] CVS elephant/tests
ieslick
ieslick at common-lisp.net
Sat Mar 24 12:16:03 UTC 2007
Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv6422/tests
Modified Files:
testindexing.lisp
Log Message:
Cleanup indexing tests so we always have a clean slate
--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/03/08 21:29:53 1.35
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/03/24 12:16:03 1.36
@@ -42,18 +42,22 @@
(deftest indexing-basic-trivial
(progn
- (when (class-indexedp-by-name 'idx-one)
- (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))
+ (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))
+
(defmethod print-object ((obj idx-one) stream)
(if (slot-boundp obj 'slot1)
(format stream "slot1 = ~A~%" (slot1 obj))
(format stream "slot1 unbound~&")
))
+
(with-transaction (:store-controller *store-controller*)
(setq inst1 (make-instance 'idx-one :slot1 101 :sc *store-controller*))
(setq inst1 (make-instance 'idx-one :slot1 101 :sc *store-controller*))
@@ -73,9 +77,12 @@
;;(format t "Global vars:~%")
;;(format t "~%basic store: ~A ~A~%" *store-controller* (elephant::controller-spec *store-controller*))
- (when (class-indexedp-by-name 'idx-one)
- (disable-class-indexing 'idx-one :errorp nil)
- (setf (find-class 'idx-one nil) nil))
+ (defclass idx-one ()
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
+ (:metaclass persistent-metaclass))
+
+ (disable-class-indexing 'idx-one :errorp nil)
+ (setf (find-class 'idx-one nil) nil)
(defclass idx-one ()
((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
@@ -104,8 +111,12 @@
(deftest indexing-class-opt
(progn
- (when (class-indexedp-by-name 'idx-cslot)
- (disable-class-indexing 'idx-cslot :errorp nil))
+ (defclass idx-cslot ()
+ ((slot1 :initarg :slot1 :initform 0 :accessor slot1))
+ (:metaclass persistent-metaclass)
+ (:index t))
+
+ (disable-class-indexing 'idx-cslot :errorp nil)
(setf (find-class 'idx-cslot) nil)
(defclass idx-cslot ()
@@ -124,14 +135,6 @@
(progn
;; (format t "inherit store: ~A ~A~%" *store-controller* (controller-path *store-controller*))
- (when (class-indexedp-by-name 'idx-two )
- (disable-class-indexing 'idx-two :sc *store-controller* :errorp nil)
- (setf (find-class 'idx-two) nil))
-
- (when (class-indexedp-by-name 'idx-three )
- (disable-class-indexing 'idx-three :sc *store-controller* :errorp nil)
- (setf (find-class 'idx-three) nil))
-
(defclass idx-two ()
((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
(slot2 :initarg :slot2 :initform 2 :accessor slot2 :index t)
@@ -145,6 +148,24 @@
(slot4 :initarg :slot4 :initform 40 :accessor slot4 :index t))
(:metaclass persistent-metaclass))
+ (disable-class-indexing 'idx-two :sc *store-controller* :errorp nil)
+ (setf (find-class 'idx-two) nil)
+
+ (disable-class-indexing 'idx-three :sc *store-controller* :errorp nil)
+ (setf (find-class 'idx-three) nil)
+
+ (defclass idx-two ()
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
+ (slot2 :initarg :slot2 :initform 2 :accessor slot2 :index t)
+ (slot3 :initarg :slot3 :initform 3 :accessor slot3)
+ (slot4 :initarg :slot4 :initform 4 :accessor slot4 :transient t))
+ (:metaclass persistent-metaclass))
+
+ (defclass idx-three (idx-two)
+ ((slot2 :initarg :slot2 :initform 20 :accessor slot2)
+ (slot3 :initarg :slot3 :initform 30 :accessor slot3 :index t)
+ (slot4 :initarg :slot4 :initform 40 :accessor slot4 :index t))
+ (:metaclass persistent-metaclass))
(progn
(with-transaction ()
@@ -168,12 +189,13 @@
(deftest indexing-range
(progn
;; (format t "range store: ~A ~A~%" *store-controller* (controller-path *store-controller*))
- (when (class-indexedp-by-name 'idx-four )
- (defclass idx-four ()
- ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
- (:metaclass persistent-metaclass))
- (disable-class-indexing 'idx-four :errorp nil)
- (setf (find-class 'idx-four nil) nil))
+
+ (defclass idx-four ()
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
+ (:metaclass persistent-metaclass))
+
+ (disable-class-indexing 'idx-four :errorp nil)
+ (setf (find-class 'idx-four nil) nil)
(defclass idx-four ()
((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
@@ -205,9 +227,13 @@
(deftest indexing-slot-makunbound
(progn
- (when (class-indexedp-by-name 'idx-unbound-del)
- (disable-class-indexing 'idx-unbound-del :errorp nil)
- (setf (find-class 'idx-five-del) nil))
+
+ (defclass idx-unbound-del ()
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
+ (:metaclass persistent-metaclass))
+
+ (disable-class-indexing 'idx-unbound-del :errorp nil)
+ (setf (find-class 'idx-five-del) nil)
(defclass idx-unbound-del ()
((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
@@ -227,8 +253,12 @@
(deftest indexing-wipe-index
(progn
- (when (class-indexedp-by-name 'idx-five-del)
- (disable-class-indexing 'idx-five-del :errorp nil))
+
+ (defclass idx-five-del ()
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
+ (:metaclass persistent-metaclass))
+
+ (disable-class-indexing 'idx-five-del :errorp nil)
(setf (find-class 'idx-five-del) nil)
(defclass idx-five-del ()
@@ -253,14 +283,15 @@
(deftest indexing-reconnect-db
(progn
- (when (class-indexedp-by-name 'idx-five)
- (defclass idx-five ()
- ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
- (slot2 :initarg :slot2 :initform 2 :accessor slot2)
- (slot3 :initarg :slot3 :initform 3 :accessor slot3 :index t))
- (:metaclass persistent-metaclass))
- (disable-class-indexing 'idx-five :errorp nil)
- (setf (find-class 'idx-five) nil))
+
+ (defclass idx-five ()
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
+ (slot2 :initarg :slot2 :initform 2 :accessor slot2)
+ (slot3 :initarg :slot3 :initform 3 :accessor slot3 :index t))
+ (:metaclass persistent-metaclass))
+
+ (disable-class-indexing 'idx-five :errorp nil)
+ (setf (find-class 'idx-five) nil)
(defclass idx-five ()
((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
@@ -295,21 +326,22 @@
(deftest indexing-change-class
(progn
- (when (class-indexedp-by-name 'idx-six)
- (defclass idx-six ()
- ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
- (slot2 :initarg :slot2 :initform 2 :accessor slot2 :index t))
- (:metaclass persistent-metaclass))
- (disable-class-indexing 'idx-six :errorp nil)
- (setf (find-class 'idx-six) nil))
- (when (class-indexedp-by-name 'idx-seven)
- (defclass idx-seven ()
- ((slot1 :initarg :slot1 :initform 10 :accessor slot1 :index nil)
- (slot3 :initarg :slot3 :initform 30 :accessor slot3 :index t)
- (slot4 :initarg :slot4 :initform 40 :accessor slot4 :index t))
- (:metaclass persistent-metaclass))
- (disable-class-indexing 'idx-seven :errorp nil)
- (setf (find-class 'idx-seven) nil))
+ (defclass idx-six ()
+ ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
+ (slot2 :initarg :slot2 :initform 2 :accessor slot2 :index t))
+ (:metaclass persistent-metaclass))
+
+ (disable-class-indexing 'idx-six :errorp nil)
+ (setf (find-class 'idx-six) nil)
+
+ (defclass idx-seven ()
+ ((slot1 :initarg :slot1 :initform 10 :accessor slot1 :index nil)
+ (slot3 :initarg :slot3 :initform 30 :accessor slot3 :index t)
+ (slot4 :initarg :slot4 :initform 40 :accessor slot4 :index t))
+ (:metaclass persistent-metaclass))
+
+ (disable-class-indexing 'idx-seven :errorp nil)
+ (setf (find-class 'idx-seven) nil)
(defclass idx-six ()
((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t)
@@ -350,16 +382,17 @@
(deftest indexing-redef-class
(progn
- (when (class-indexedp-by-name 'idx-eight)
- (defclass idx-eight ()
- ((slot1 :accessor slot1 :initarg :slot1 :index t)
- (slot2 :accessor slot2 :initarg :slot2)
- (slot3 :accessor slot3 :initarg :slot3 :transient t)
- (slot4 :accessor slot4 :initarg :slot4 :index t)
- (slot5 :accessor slot5 :initarg :slot5))
- (:metaclass persistent-metaclass))
- (disable-class-indexing 'idx-eight :errorp nil)
- (setf (find-class 'idx-eight nil) nil))
+
+ (defclass idx-eight ()
+ ((slot1 :accessor slot1 :initarg :slot1 :index t)
+ (slot2 :accessor slot2 :initarg :slot2)
+ (slot3 :accessor slot3 :initarg :slot3 :transient t)
+ (slot4 :accessor slot4 :initarg :slot4 :index t)
+ (slot5 :accessor slot5 :initarg :slot5))
+ (:metaclass persistent-metaclass))
+
+ (disable-class-indexing 'idx-eight :errorp nil)
+ (setf (find-class 'idx-eight nil) nil)
;; (format t "sc: ~A ct: ~A~%" *store-controller* *current-transaction*)
(defclass idx-eight ()
((slot1 :accessor slot1 :initarg :slot1 :index t)
@@ -368,11 +401,13 @@
(slot4 :accessor slot4 :initarg :slot4 :index t)
(slot5 :accessor slot5 :initarg :slot5))
(:metaclass persistent-metaclass))
+
(let ((o1 nil)
(o2 nil))
(with-transaction ()
(setf o1 (make-instance 'idx-eight :slot1 1 :slot2 2 :slot3 3 :slot4 4 :slot5 5))
(setf o2 (make-instance 'idx-eight :slot1 10 :slot2 20 :slot3 30 :slot4 40 :slot5 50)))
+
(defclass idx-eight ()
((slot1 :accessor slot1 :initarg :slot1 :initform 11)
(slot2 :accessor slot2 :initarg :slot2 :initform 12 :index t)
More information about the Elephant-cvs
mailing list