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)