[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