/[flexichain]/flexichain/rtester.lisp
ViewVC logotype

Diff of /flexichain/rtester.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by rkreuter, Thu Feb 9 02:51:06 2006 UTC revision 1.2 by charmon, Sun Jan 27 06:05:37 2008 UTC
# Line 40  Line 40 
40  (defun compare ()  (defun compare ()
41    ;; check that they are the same length    ;; check that they are the same length
42    (assert (= (flexichain:nb-elements *fc-real*)    (assert (= (flexichain:nb-elements *fc-real*)
43               (stupid:nb-elements *fc-fake*)))               (stupid:nb-elements *fc-fake*)))
44    ;; check that they have the same elements in the same places    ;; check that they have the same elements in the same places
45    (loop for pos from 0 below (flexichain:nb-elements *fc-real*)    (loop for pos from 0 below (flexichain:nb-elements *fc-real*)
46          do (assert (= (flexichain:element* *fc-real* pos)          do (assert (= (flexichain:element* *fc-real* pos)
47                        (stupid:element* *fc-fake* pos))))                        (stupid:element* *fc-fake* pos))))
48    ;; check all the cursors    ;; check all the cursors
49    (loop for x in *cursors-real*    (loop for x in *cursors-real*
50          for y in *cursors-fake*          for y in *cursors-fake*
51          do (assert (= (flexichain:cursor-pos x)          do (assert (= (flexichain:cursor-pos x)
52                        (stupid:cursor-pos y)))                        (stupid:cursor-pos y)))
53             (unless (zerop (flexichain:cursor-pos x))             (unless (zerop (flexichain:cursor-pos x))
54               (assert (= (flexichain:element< x)               (assert (= (flexichain:element< x)
55                          (stupid:element< y))))                          (stupid:element< y))))
56             (unless (= (flexichain:cursor-pos x)             (unless (= (flexichain:cursor-pos x)
57                        (flexichain:nb-elements *fc-real*))                        (flexichain:nb-elements *fc-real*))
58               (assert (= (flexichain:element> x)               (assert (= (flexichain:element> x)
59                          (stupid:element> y))))))                          (stupid:element> y))))))
60    
61  (defun add-inst (inst)  (defun add-inst (inst)
62    (push inst *instructions*))    (push inst *instructions*))
63    
64  (defun i* (&optional  (defun i* (&optional
65             (pos (random (1+ (stupid:nb-elements *fc-fake*))))             (pos (random (1+ (stupid:nb-elements *fc-fake*))))
66             (elem (random 1000000)))             (elem (random 1000000)))
67    (add-inst `(i* ,pos ,elem))    (add-inst `(i* ,pos ,elem))
68    (flexichain:insert* *fc-real* pos elem)    (flexichain:insert* *fc-real* pos elem)
69    (stupid:insert* *fc-fake* pos elem))    (stupid:insert* *fc-fake* pos elem))
# Line 80  Line 80 
80    (unless (zerop (stupid:nb-elements *fc-fake*))    (unless (zerop (stupid:nb-elements *fc-fake*))
81      (unless pos      (unless pos
82        (setf pos (random (stupid:nb-elements *fc-fake*))        (setf pos (random (stupid:nb-elements *fc-fake*))
83              elem (random 1000000)))              elem (random 1000000)))
84      (add-inst `(se* ,pos ,elem))      (add-inst `(se* ,pos ,elem))
85      (setf (flexichain:element* *fc-real* pos) elem)      (setf (flexichain:element* *fc-real* pos) elem)
86      (setf (stupid:element* *fc-fake* pos) elem)))      (setf (stupid:element* *fc-fake* pos) elem)))
# Line 88  Line 88 
88  (defun mlc ()  (defun mlc ()
89    (add-inst `(mlc))    (add-inst `(mlc))
90    (push (make-instance 'flexichain:left-sticky-flexicursor :chain *fc-real*)    (push (make-instance 'flexichain:left-sticky-flexicursor :chain *fc-real*)
91          *cursors-real*)          *cursors-real*)
92    (push (make-instance 'stupid:left-sticky-flexicursor :chain *fc-fake*)    (push (make-instance 'stupid:left-sticky-flexicursor :chain *fc-fake*)
93          *cursors-fake*))          *cursors-fake*))
94    
95  (defun mrc ()  (defun mrc ()
96    (add-inst `(mrc))    (add-inst `(mrc))
97    (push (make-instance 'flexichain:right-sticky-flexicursor :chain *fc-real*)    (push (make-instance 'flexichain:right-sticky-flexicursor :chain *fc-real*)
98          *cursors-real*)          *cursors-real*)
99    (push (make-instance 'stupid:right-sticky-flexicursor :chain *fc-fake*)    (push (make-instance 'stupid:right-sticky-flexicursor :chain *fc-fake*)
100          *cursors-fake*))          *cursors-fake*))
101    
102    
103  (defun cc (&optional (elt (random (length *cursors-real*))))  (defun cc (&optional (elt (random (length *cursors-real*))))
# Line 106  Line 106 
106    (push (stupid:clone-cursor (elt *cursors-fake* elt)) *cursors-fake*))    (push (stupid:clone-cursor (elt *cursors-fake* elt)) *cursors-fake*))
107    
108  (defun scp (&optional  (defun scp (&optional
109              (elt (random (length *cursors-real*)))              (elt (random (length *cursors-real*)))
110              (pos (random (1+ (flexichain:nb-elements *fc-real*)))))              (pos (random (1+ (flexichain:nb-elements *fc-real*)))))
111    (add-inst `(scp ,elt ,pos))    (add-inst `(scp ,elt ,pos))
112    (setf (flexichain:cursor-pos (elt *cursors-real* elt)) pos)    (setf (flexichain:cursor-pos (elt *cursors-real* elt)) pos)
113    (setf (stupid:cursor-pos (elt *cursors-fake* elt)) pos))    (setf (stupid:cursor-pos (elt *cursors-fake* elt)) pos))
114    
115  (defun ii (&optional  (defun ii (&optional
116             (elt (random (length *cursors-fake*)))             (elt (random (length *cursors-fake*)))
117             (elem (random 1000000)))             (elem (random 1000000)))
118    (add-inst `(ii ,elt ,elem))    (add-inst `(ii ,elt ,elem))
119    (flexichain:insert (elt *cursors-real* elt) elem)    (flexichain:insert (elt *cursors-real* elt) elem)
120    (stupid:insert (elt *cursors-fake* elt) elem))    (stupid:insert (elt *cursors-fake* elt) elem))
# Line 127  Line 127 
127    
128  (defun d> (&optional (elt (random (length *cursors-fake*))))  (defun d> (&optional (elt (random (length *cursors-fake*))))
129    (unless (= (stupid:cursor-pos (elt *cursors-fake* elt))    (unless (= (stupid:cursor-pos (elt *cursors-fake* elt))
130               (stupid:nb-elements (stupid:chain (elt *cursors-fake* elt))))               (stupid:nb-elements (stupid:chain (elt *cursors-fake* elt))))
131      (add-inst `(d> ,elt))      (add-inst `(d> ,elt))
132      (flexichain:delete> (elt *cursors-real* elt))      (flexichain:delete> (elt *cursors-real* elt))
133      (stupid:delete> (elt *cursors-fake* elt))))      (stupid:delete> (elt *cursors-fake* elt))))
134    
135  (defun s< (&optional  (defun s< (&optional
136             (elt (random (length *cursors-real*)))             (elt (random (length *cursors-real*)))
137             (elem (random 1000000)))             (elem (random 1000000)))
138    (unless (zerop (stupid:cursor-pos (elt *cursors-fake* elt)))    (unless (zerop (stupid:cursor-pos (elt *cursors-fake* elt)))
139      (add-inst `(s< ,elt ,elem))      (add-inst `(s< ,elt ,elem))
140      (setf (flexichain:element< (elt *cursors-real* elt)) elem)      (setf (flexichain:element< (elt *cursors-real* elt)) elem)
141      (setf (stupid:element< (elt *cursors-fake* elt)) elem)))      (setf (stupid:element< (elt *cursors-fake* elt)) elem)))
142    
143  (defun s> (&optional  (defun s> (&optional
144             (elt (random (length *cursors-real*)))             (elt (random (length *cursors-real*)))
145             (elem (random 1000000)))             (elem (random 1000000)))
146    (unless (= (stupid:cursor-pos (elt *cursors-fake* elt))    (unless (= (stupid:cursor-pos (elt *cursors-fake* elt))
147               (stupid:nb-elements (stupid:chain (elt *cursors-fake* elt))))               (stupid:nb-elements (stupid:chain (elt *cursors-fake* elt))))
148      (add-inst `(s> ,elt ,elem))      (add-inst `(s> ,elt ,elem))
149      (setf (flexichain:element> (elt *cursors-real* elt)) elem)      (setf (flexichain:element> (elt *cursors-real* elt)) elem)
150      (setf (stupid:element> (elt *cursors-fake* elt)) elem)))      (setf (stupid:element> (elt *cursors-fake* elt)) elem)))
# Line 152  Line 152 
152  (defmacro randomcase (&body clauses)  (defmacro randomcase (&body clauses)
153    `(ecase (random ,(length clauses))    `(ecase (random ,(length clauses))
154       ,@(loop for clause in clauses       ,@(loop for clause in clauses
155               for i from 0               for i from 0
156               collect `(,i ,clause))))               collect `(,i ,clause))))
157    
158  (defun i-or-d ()  (defun i-or-d ()
159    (if *ins-del-state*    (if *ins-del-state*
# Line 185  Line 185 
185    (mlc)    (mlc)
186    (mrc)    (mrc)
187    (loop repeat n    (loop repeat n
188          do (test-step)))          do (test-step)))
189    
190  (defun replay (instructions)  (defun replay (instructions)
191    (let ((*instructions* '()))    (let ((*instructions* '()))
192      (reset-all)      (reset-all)
193      (loop for inst in (reverse instructions)      (loop for inst in (reverse instructions)
194            do (apply (car inst) (cdr inst))            do (apply (car inst) (cdr inst))
195               (compare))))               (compare))))

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.5