[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