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

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.5