[gsharp-cvs] CVS update: gsharp/Flexichain/rtester.lisp

[Robert Strandh]

Update of /project/gsharp/cvsroot/gsharp/Flexichain
In directory common-lisp.net:/tmp/cvs-serv16406

Modified Files:
	rtester.lisp 
Log Message:
Removed generation of move< and move> instructions.

Fixed a bug in the delete test which sometimes generated delete
operations on empty chains.

Added comparison of the two implementations during a replay.

Made the stupid implementation the reference (since presumably 
that is the correct one).


Date: Mon Sep  6 13:21:49 2004
Author: rstrandh

Index: gsharp/Flexichain/rtester.lisp
diff -u gsharp/Flexichain/rtester.lisp:1.2 gsharp/Flexichain/rtester.lisp:1.3
--- gsharp/Flexichain/rtester.lisp:1.2	Thu Sep  2 08:23:50 2004
+++ gsharp/Flexichain/rtester.lisp	Mon Sep  6 13:21:49 2004
@@ -21,8 +21,6 @@
 ;; (setf element*)
 ;; clone-cursor fcu
 ;; (setf cursor-pos)
-;; move> fcu &optional (n 1)
-;; move< fcu &optional (n 1)
 ;; insert fcu obj
 ;; delete< fcu
 ;; delete> fcu
@@ -64,21 +62,24 @@
   (push inst *instructions*))
 
 (defun i* (&optional
-	   (pos (random (1+ (flexichain:nb-elements *fc-real*))))
+	   (pos (random (1+ (stupid:nb-elements *fc-fake*))))
 	   (elem (random 1000000)))   
   (add-inst `(i* ,pos ,elem))
   (flexichain:insert* *fc-real* pos elem)
   (stupid:insert* *fc-fake* pos elem))
 
-(defun d* (&optional (pos (random (flexichain:nb-elements *fc-real*))))
-  (add-inst `(d* ,pos))
-  (flexichain:delete* *fc-real* pos)
-  (stupid:delete* *fc-fake* pos))
+(defun d* (&optional pos)
+  (unless (zerop (stupid:nb-elements *fc-fake*))
+    (unless pos
+      (setf pos (random (stupid:nb-elements *fc-fake*))))
+    (add-inst `(d* ,pos))
+    (flexichain:delete* *fc-real* pos)
+    (stupid:delete* *fc-fake* pos)))
 
 (defun se* (&optional pos elem)
   (unless (zerop (stupid:nb-elements *fc-fake*))
     (unless pos
-      (setf pos (random (flexichain:nb-elements *fc-real*))
+      (setf pos (random (stupid:nb-elements *fc-fake*))
 	    elem (random 1000000)))
     (add-inst `(se* ,pos ,elem))
     (setf (flexichain:element* *fc-real* pos) elem)
@@ -111,19 +112,6 @@
   (setf (flexichain:cursor-pos (elt *cursors-real* elt)) pos)
   (setf (stupid:cursor-pos (elt *cursors-fake* elt)) pos))
 
-(defun m< (&optional (elt (random (length *cursors-real*))))
-  (unless (zerop (stupid:cursor-pos (elt *cursors-fake* elt)))
-    (add-inst `(m< ,elt))
-    (flexichain:move< (elt *cursors-real* elt))
-    (stupid:move< (elt *cursors-fake* elt))))
-      
-(defun m> (&optional (elt (random (length *cursors-fake*))))
-  (unless (= (stupid:cursor-pos (elt *cursors-fake* elt))
-	     (stupid:nb-elements (stupid:chain (elt *cursors-fake* elt))))
-    (add-inst `(m> ,elt))
-    (flexichain:move> (elt *cursors-real* elt))
-    (stupid:move> (elt *cursors-fake* elt))))
-
 (defun ii (&optional
 	   (elt (random (length *cursors-fake*)))
 	   (elem (random 1000000)))
@@ -178,14 +166,11 @@
 (defun mc ()
   (randomcase (mlc) (mrc)))
 
-(defun mov ()
-  (randomcase  (m<) (m>)))
-
 (defun test-step ()
-  (compare)
   (when (zerop (random 200))
     (setf *ins-del-state* (not *ins-del-state*)))
-  (randomcase (i-or-d) (setel) (mc) (cc) (scp) (mov)))
+  (randomcase (i-or-d) (setel) (mc) (cc) (scp))
+  (compare))
 
 (defun reset-all ()
   (setf *instructions* '())
@@ -195,15 +180,16 @@
   (setf *fc-real* (make-instance 'flexichain:standard-cursorchain))
   (setf *fc-fake* (make-instance 'stupid:standard-cursorchain)))
   
-(defun tester ()
+(defun tester (&optional (n 1))
   (reset-all)
   (mlc)
   (mrc)
-  (loop repeat 100000
+  (loop repeat n
 	do (test-step)))
 
 (defun replay (instructions)
   (let ((*instructions* '()))
     (reset-all)
     (loop for inst in (reverse instructions)
-	  do (apply (car inst) (cdr inst)))))
+	  do (apply (car inst) (cdr inst))
+	     (compare))))