ViewVC logotype

Diff of /flexichain/rtester.lisp

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

revision 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)
3  (defparameter *instructions* '())  (defparameter *instructions* '())
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))))))
63  (defun add-inst (inst)  (defun add-inst (inst)
64    (push inst *instructions*))    (push inst *instructions*))
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*))
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*))
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*))
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))
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 
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))))
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)))
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))))
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)))
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))))

Removed from v.  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.5