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)