[elephant-cvs] CVS elephant/tests

[rread]

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

Modified Files:
	testindexing.lisp 
Log Message:
Improvements in the indexing test


--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/02/05 19:33:46	1.23
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2007/02/06 16:32:02	1.24
@@ -389,15 +389,22 @@
      (stress3 :accessor stress3 :initarg :stress3 :initform 3 :index nil))
     (:metaclass persistent-metaclass)))
 
+(defparameter *stress-count* 700)
+(defparameter *range-size* 10)
+
+(defun non-monotonic-stress-def (i)
+  (- *stress-count* i)
+)
+
 (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))))
+    (setf (get-value i normal-index) (apply #'make-instance class-name :stress1 (non-monotonic-stress-def i) inst-args))))
 
 (defun indexed-stress-setup (count class-name &rest inst-args)  
   (dotimes (i count)
     (progn
-    (apply #'make-instance class-name :stress1 i inst-args))))
+    (apply #'make-instance class-name :stress1 (non-monotonic-stress-def i) inst-args))))
 
 (defun normal-range-lookup (count size)
   "Given stress1 slot has values between 1 and count, extract a range of size size that starts
@@ -410,8 +417,11 @@
 	 (multiple-value-bind (value? key val) (cursor-next cur)
 	   (declare (ignore key))
 	   (cond ((or (not value?)
-		      (and value?
-			   (>= (stress1 val) end)))
+;; I think these lines were in correctly assuming a particular order.
+;;		      (and value?
+;;			   (>= (stress1 val) end)
+;;			   )
+		      )
 		  (return-from normal-range-lookup objects))
 		 ((and value?
 		       (>= (stress1 val) start)
@@ -421,56 +431,52 @@
 
 (defun indexed-range-lookup (class count size)
   (let* ((start (/ count 2))
-	 (end (1- (+ start size))))
+	 (end (1- (+ start size)))
+	 (res
     (get-instances-by-range class 'stress1 start end)))
+    res
+    ))
+
 
-(defparameter *stress-count* 700)
-;;(defparameter *stress-count* 70)
-(defparameter *range-size* 80)
 
 (deftest indexing-timing
     (progn
       (make-stress-classes)
-;;      (trace elephant::drop-pobject)
-;;      (trace remove-kv)
       (let ((insts (get-instances-by-class 'stress-index))
 	    (start nil)
 	    (end nil)
+	    (normal-check nil)
+	    (index-check nil)
 	    (normal-time 0)
 	    (index-time 0))
 	(when insts
 	  (drop-instances insts :sc *store-controller*))
 
-      (format t "Got done with that~%")
-      (format t "~%Stress test normal setup time (~A):~%" *stress-count*)
 	(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))
 
-      (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*))
+	  (push (length (normal-range-lookup *stress-count* *range-size*))
+		normal-check))
 	(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*)
-;;      (trace indexed-range-lookup)
-;;      (trace get-instances-by-range)
 	(setf start (get-internal-run-time))
 	(dotimes (i *range-size*)
 	  (declare (ignore i))
-	  (indexed-range-lookup 'stress-index *stress-count* *range-size*))
+	  (push (length (indexed-range-lookup 'stress-index *stress-count* *range-size*))
+		index-check))
 	(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)))
+	(and (equal normal-check index-check) (> normal-time index-time)))
+      )
   t)