Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv19168
Modified Files: elephant-tests.lisp testindexing.lisp Log Message: Some things to test just pieces
--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/02/04 10:08:28 1.23 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/02/05 19:33:46 1.24 @@ -161,6 +161,7 @@ (defun do-indexing-tests (&optional (spec *default-spec*)) "Just test indexing" (with-open-store (spec) + (make-stress-classes) (print (do-test 'indexing-basic)) (print (do-test 'indexing-inherit)) (print (do-test 'indexing-range)) @@ -169,6 +170,76 @@ (print (do-test 'indexing-redef-class)) (print (do-test 'indexing-timing))))
+(defun do-collection-tests (&optional (spec *default-spec*)) + "Just test indexing" + (with-open-store (spec) + (print (do-test 'basicpersistence)) + (print (do-test 'testoid)) + (print (do-test 'btree-make)) + (print (do-test 'btree-put)) + (print (do-test 'btree-get)) + (print (do-test 'remove-kv)) + (print (do-test 'removed)) + (print (do-test 'map-btree)) + (print (do-test 'indexed-btree-make)) + (print (do-test 'indexed-btree-make)) + (print (do-test 'add-indices)) + (print (do-test 'test-indices)) + (print (do-test 'indexed-put)) + (print (do-test 'indexed-get)) + (print (do-test 'simple-slot-get)) + (print (do-test 'indexed-get-from-slot1)) + (print (do-test 'indexed-get-from-slot2)) + (print (do-test 'remove-kv-indexed)) + (print (do-test 'no-key-nor-indices)) + (print (do-test 'remove-kv-from-slot1)) + (print (do-test 'no-key-nor-indices-slot1)) + (print (do-test 'remove-kv-from-slot2)) + (print (do-test 'no-key-nor-indices-slot2)) + (print (do-test 'map-indexed)) + (print (do-test 'get-first)) + (print (do-test 'get-first2)) + (print (do-test 'get-last)) + (print (do-test 'get-last2)) + (print (do-test 'set)) + (print (do-test 'set2)) + (print (do-test 'set-range)) + (print (do-test 'set-range2)) + (print (do-test 'rem-kv)) + (print (do-test 'rem-idexkv)) + (print (do-test 'make-indexed2)) + (print (do-test 'add-indices2)) + (print (do-test 'put-indexed2)) + (print (do-test 'get-indexed2)) + (print (do-test 'get-from-index3)) + (print (do-test 'dup-test)) + (print (do-test 'nodup-test)) + (print (do-test 'prev-nodup-test)) + (print (do-test 'pnodup-test)) + (print (do-test 'pprev-nodup-test)) + (print (do-test 'cur-del1)) + (print (do-test 'indexed-delete)) + (print (do-test 'test-deleted)) + (print (do-test 'indexed-delete2)) + (print (do-test 'test-deleted2)) + (print (do-test 'cur-del2)) + (print (do-test 'get-both)) + (print (do-test 'pget-both)) + (print (do-test 'pget-both-range)) + (print (do-test 'pcursor)) + (print (do-test 'newindex)) + (print (do-test 'pcursor2)) + (print (do-test 'add-get-remove)) + (print (do-test 'add-get-remove-symbol)) + (print (do-test 'existsp)) + )) + +(defun do-cur-del2-test (&optional (spec *default-spec*)) + "Just test indexing" + (with-open-store (spec) + (print (do-test 'cur-del2)) + )) + (defun do-crazy-pg-tests() "Specific problematic pg tests" (open-store *testpg-spec*) --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/02/03 04:09:14 1.22 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/02/05 19:33:46 1.23 @@ -321,7 +321,6 @@ (:metaclass persistent-metaclass)) (disable-class-indexing 'idx-eight :errorp nil) (setf (find-class 'idx-eight nil) nil)) - ;; (format t "sc: ~A ct: ~A~%" *store-controller* *current-transaction*) (defclass idx-eight () ((slot1 :accessor slot1 :initarg :slot1 :index t) @@ -330,13 +329,11 @@ (slot4 :accessor slot4 :initarg :slot4 :index t) (slot5 :accessor slot5 :initarg :slot5)) (:metaclass persistent-metaclass)) - (let ((o1 nil) (o2 nil)) (with-transaction () (setf o1 (make-instance 'idx-eight :slot1 1 :slot2 2 :slot3 3 :slot4 4 :slot5 5)) (setf o2 (make-instance 'idx-eight :slot1 10 :slot2 20 :slot3 30 :slot4 40 :slot5 50))) - (defclass idx-eight () ((slot1 :accessor slot1 :initarg :slot1 :initform 11) (slot2 :accessor slot2 :initarg :slot2 :initform 12 :index t) @@ -344,23 +341,35 @@ (slot6 :accessor slot6 :initarg :slot6 :initform 14 :index t) (slot7 :accessor slot7 :initarg :slot7)) (:metaclass persistent-metaclass)) - - (values - (and (eq (slot1 o1) 1) - (signals-error (get-instances-by-value 'idx-eight 'slot1 1))) - (and (eq (slot2 o1) 2) - (eq (length (get-instances-by-value 'idx-eight 'slot2 2)) 1)) - (eq (slot3 o1) 13) ;; transient values not preserved (would be inconsistent) - (and (not (slot-exists-p o1 'slot4)) - (not (slot-exists-p o1 'slot5)) - (signals-error (get-instances-by-value 'idx-eight 'slot4 4))) - (eq (slot6 o1) 14) - (eq (length (get-instances-by-value 'idx-eight 'slot6 14)) 2) - (and ;;(slot-exists-p o1 'slot7) - (not (slot-boundp o1 'slot7))) - (and ;;(slot-exists-p o2 'slot7) - (not (slot-boundp o2 'slot7)))))) - t t t t t t t t) + ;; (format t "indexing redef-class d~%") + (let (( + v1 + (and (eq (slot1 o1) 1) + (signals-error (get-instances-by-value 'idx-eight 'slot1 1)))) + ;; (v1x (format t "indexing redef-class v1x~%")) + (v2 (and (eq (slot2 o1) 2) + (eq (length (get-instances-by-value 'idx-eight 'slot2 2)) 1))) + ;; (v2x (format t "indexing redef-class v2x~%")) + (v3 (eq (slot3 o1) 13)) ;; transient values not preserved (would be inconsistent) + ;; (v3x (format t "indexing redef-class v3x~%")) + (v4 (and (not (slot-exists-p o1 'slot4)) + (not (slot-exists-p o1 'slot5)) + (signals-error (get-instances-by-value 'idx-eight 'slot4 4)))) + ;; (v4x (format t "indexing redef-class v4x~%")) + (v5 (eq (slot6 o1) 14)) + ;; (v5x (format t "indexing redef-class v5x~%")) + (v6 (eq (length (get-instances-by-value 'idx-eight 'slot6 14)) 2)) + ;; (v6x (format t "indexing redef-class v6x~%")) + (v7 (and ;;(slot-exists-p o1 'slot7) + (not (slot-boundp o1 'slot7)))) + ;; (v7x (format t "indexing redef-class v7x~%")) + (v8 (and ;;(slot-exists-p o2 'slot7) + (not (slot-boundp o2 'slot7)))) + ;; (v8x (format t "indexing redef-class v8x~%"))) + ) + (values + v1 v2 v3 v4 v5 v6 v7 v8)))) + t t t t t t t t)
;; create 500 objects, write each object's slots
@@ -387,7 +396,8 @@
(defun indexed-stress-setup (count class-name &rest inst-args) (dotimes (i count) - (apply #'make-instance class-name :stress1 i inst-args))) + (progn + (apply #'make-instance class-name :stress1 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 @@ -415,11 +425,14 @@ (get-instances-by-range class 'stress1 start end)))
(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) @@ -428,15 +441,16 @@ (when insts (drop-instances insts :sc *store-controller*))
-;; (format t "~%Stress test normal setup time (~A):~%" *stress-count*) + (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*) + (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*) + (format t "~%Stress test normal lookup time (~A):~%" *range-size*) (setf start (get-internal-run-time)) (dotimes (i *range-size*) (declare (ignore i)) @@ -444,7 +458,9 @@ (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*) + (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))