[elephant-cvs] CVS elephant/tests
ieslick
ieslick at common-lisp.net
Thu Jan 25 18:18:00 UTC 2007
Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv27212/tests
Modified Files:
elephant-tests.lisp
Log Message:
Symbol ID hack removed from BDB; Allegro/MacOS/x86 passes
--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/11/11 18:41:11 1.21
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/01/25 18:18:00 1.22
@@ -216,3 +216,71 @@
`(values
,@(loop for form in forms
collect `(is-not-null ,form))))
+
+
+(defpclass performance-test ()
+ ((slot1-is-a-test-slot :accessor perfslot1 :initarg :s1 :initform 1)
+ (slot2-is-a-really-long-symbol :accessor perfslot2 :initarg :s2 :initform 2)
+ (slot3-is-so-long-we-shouldnt-even-talk-about-it-lest-we-die :accessor perfslot3 :initarg :s3 :initform 3)))
+
+(defun performance-test ()
+ (let ((a (make-array 500))
+ (b (make-array 500 :element-type 'fixnum)))
+
+ (loop for j from 0 to 20 do
+ (with-transaction ()
+ (loop for i from 0 below 500 do
+ (setf (aref a i) (make-instance 'performance-test :s1 10 :s2 20 :s3 30))))
+ (with-transaction ()
+ (loop for i from 0 below 500 do
+ (setf (perfslot2 (aref a i)) 30)
+ (setf (aref b i) (+ (* (perfslot2 (aref a i))
+ (perfslot3 (aref a i)))
+ (perfslot1 (aref a i))))))
+ (every (lambda (elt) (= elt 910)) b))))
+
+
+(defun serializer-performance-test ()
+ (elephant-memutil::with-buffer-streams (key val)
+ (loop for i from 0 upto 1000000 do
+ (serialize 'persistent-symbol-test key *store-controller*)
+ (deserialize key *store-controller*)
+ (elephant-memutil::reset-buffer-stream key))))
+
+(defun slot-access-test ()
+ (let ((pt (make-instance 'performance-test))
+ (var 0))
+ (loop for i from 0 upto 1000000 do
+ (setq var (perfslot1 pt)))))
+
+(defclass simple-class ()
+ ((slot1 :accessor slot1 :initform 20)
+ (slot-number-two :accessor slot2 :initform "This is a test")
+ (slot3 :accessor slot3 :initform 'state-is-idle)
+ (slot4 :accessor slot4 :initform 'test)))
+
+(defun regular-class-test (sc)
+ (let ((src (make-array 500))
+ (targ (make-array 500))
+ (bt (make-btree sc)))
+ (loop for i from 0 below 500 do
+ (setf (aref src i)
+ (make-instance 'simple-class)))
+ (time
+ (loop for j from 0 upto 20 do
+ (with-transaction (:store-controller sc)
+ (loop for elt across src
+ for i from 0 do
+ (setf (get-value i bt) elt)))
+ (with-transaction (:store-controller sc)
+ (loop for elt across src
+ for i from 0 do
+ (setf (aref targ i) (get-value i bt))))))))
+
+(defun serializer-stdclass-test ()
+ (let ((inst (make-instance 'simple-class)))
+ (elephant-memutil::with-buffer-streams (key val)
+ (loop for i from 0 upto 100000 do
+ (serialize inst key *store-controller*)
+ (deserialize key *store-controller*)
+ (elephant-memutil::reset-buffer-stream key)))))
More information about the Elephant-cvs
mailing list