[elephant-cvs] CVS elephant/tests
rread
rread at common-lisp.net
Mon Feb 5 19:33:46 UTC 2007
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))
More information about the Elephant-cvs
mailing list