[elephant-cvs] CVS elephant/tests

[ieslick]

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv713/tests

Modified Files:
	testindexing.lisp 
Log Message:

Minor cleanup of indexing tests, declarations and rule-based code.
100% of tests pass under allegro 7.0 and Mac OS X.


--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2006/02/07 23:23:51	1.2
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2006/02/08 03:23:12	1.3
@@ -153,8 +153,7 @@
     nil
   nil)
 
-;; create 10k objects, write each object's
-;; slots 
+;; create 10k objects, write each object's slots 
 
 (defclass stress-normal ()
   ((stress1 :accessor stress1 :initarg :stress1 :initform nil :indexed nil)
@@ -185,13 +184,18 @@
 	 (start (/ count 2))
 	 (end (1- (+ start size))))
     (with-btree-cursor (cur normal-index)
-      (multiple-value-bind (value? key val) (cursor-next cur)
-	(declare (ignore key))
-	(when (and value?
-		   (>= (stress1 val) start)
-		   (<= (stress1 val) end))
-	  (push val objects))))
-    objects))
+      (loop
+	 (multiple-value-bind (value? key val) (cursor-next cur)
+	   (declare (ignore key))
+	   (cond ((or (not value?)
+		      (and value?
+			   (>= (stress1 val) end)))
+		  (return-from normal-range-lookup objects))
+		 ((and value?
+		       (>= (stress1 val) start)
+		       (<= (stress1 val) end))
+		  (push val objects)))))
+      objects)))
 
 (defun indexed-range-lookup (class count size)
   (let* ((start (/ count 2))
@@ -223,10 +227,11 @@
 	 (normal-range-lookup *stress-count* *range-size*)))
 
       (format t "~%Stress test indexed lookup time (~A):~%" *range-size*)
+      (prof:with-profiling (:type :time)
       (time
        (dotimes (i *range-size*)
 	 (declare (ignore i))
-	 (indexed-range-lookup 'stress-index *stress-count* *range-size*)))
+	 (indexed-range-lookup 'stress-index *stress-count* *range-size*))))
       t)
   t)