[elephant-cvs] CVS elephant/tests

[ieslick]

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv9359/tests

Modified Files:
	testindexing.lisp 
Log Message:

Corrections for SBCL serialization and index testing.



--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2006/04/26 17:53:45	1.16
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2006/04/26 21:41:25	1.17
@@ -371,22 +371,23 @@
 
 (defvar normal-index nil)
 
-(defclass stress-normal ()
-  ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index nil)
-   (stress2 :accessor stress2 :initarg :stress2 :initform nil :index nil))
-  (:metaclass persistent-metaclass))
+(defun make-stress-classes ()
+  (defclass stress-normal ()
+    ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index nil)
+     (stress2 :accessor stress2 :initarg :stress2 :initform nil :index nil))
+    (:metaclass persistent-metaclass))
+
+  (defclass stress-index ()
+    ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index t)
+     (stress2 :accessor stress2 :initarg :stress2 :initform 2 :index t)
+     (stress3 :accessor stress3 :initarg :stress3 :initform 3 :index nil))
+    (:metaclass persistent-metaclass)))
 
 (defun normal-stress-setup (count class-name &rest inst-args)
   (setf normal-index (make-btree))
   (dotimes (i count)
     (setf (get-value i normal-index) (apply #'make-instance class-name :stress1 i inst-args))))
 
-(defclass stress-index ()
-  ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index t)
-   (stress2 :accessor stress2 :initarg :stress2 :initform 2 :index t)
-   (stress3 :accessor stress3 :initarg :stress3 :initform 3 :index nil))
-  (:metaclass persistent-metaclass))
-
 (defun indexed-stress-setup (count class-name &rest inst-args)  
   (dotimes (i count)
     (apply #'make-instance class-name :stress1 i inst-args)))
@@ -421,43 +422,42 @@
 
 (deftest indexing-timing
     (progn
+      (make-stress-classes)
       (let ((insts (get-instances-by-class 'stress-index))
 	    (start nil)
 	    (end nil)
 	    (normal-time 0)
 	    (index-time 0))
 	(when insts
-	  (drop-instances insts)))
+	  (drop-instances insts :sc *store-controller*))
 
 ;;      (format t "~%Stress test normal setup time (~A):~%" *stress-count*)
-      (with-transaction ()
-	 (normal-stress-setup *stress-count* 'stress-normal :stress2 10)
-	)
+	(with-transaction ()
+	  (normal-stress-setup *stress-count* 'stress-normal :stress2 10))
 	
 ;;      (format t "~%Stress test indexed setup time (~A):~%" *stress-count*)
-      (with-transaction ()
-	(indexed-stress-setup *stress-count* 'stress-index :stress2 10)
-      )
+	(with-transaction ()
+	  (indexed-stress-setup *stress-count* 'stress-index :stress2 10))
 
 ;;      (format t "~%Stress test normal lookup time (~A):~%" *range-size*)
-      (setf start (get-internal-run-time))
-      (dotimes (i *range-size*)
-	(declare (ignore i))
-	(normal-range-lookup *stress-count* *range-size*))
-      (setf end (get-internal-run-time))
-      (setf normal-time (/ (- end start 0.0) internal-time-units-per-second))
+	(setf start (get-internal-run-time))
+	(dotimes (i *range-size*)
+	  (declare (ignore i))
+	  (normal-range-lookup *stress-count* *range-size*))
+	(setf end (get-internal-run-time))
+	(setf normal-time (/ (- end start 0.0) internal-time-units-per-second))
 
 ;;      (format t "~%Stress test indexed lookup time (~A):~%" *range-size*)
-      (setf start (get-internal-run-time))
-       (dotimes (i *range-size*)
-	 (declare (ignore i))
-	 (indexed-range-lookup 'stress-index *stress-count* *range-size*))
-      (setf end (get-internal-run-time))
-      (setf index-time (/ (- end start 0.0) internal-time-units-per-second))
-
-      (format t "~%Ranged get of ~A/~A objects = Linear: ~A sec Indexed: ~A sec~%"
-	      *range-size* *stress-count* normal-time index-time)
-      (> normal-time index-time))
+	(setf start (get-internal-run-time))
+	(dotimes (i *range-size*)
+	  (declare (ignore i))
+	  (indexed-range-lookup 'stress-index *stress-count* *range-size*))
+	(setf end (get-internal-run-time))
+	(setf index-time (/ (- end start 0.0) internal-time-units-per-second))
+	
+	(format t "~%Ranged get of ~A/~A objects = Linear: ~A sec Indexed: ~A sec~%"
+		*range-size* *stress-count* normal-time index-time)
+	(> normal-time index-time)))
   t)