/[gcl]/gcl/ansi-tests/random-int-form.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/random-int-form.lsp

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

revision 1.1 by pfdietz, Thu Sep 11 11:46:53 2003 UTC revision 1.2 by pfdietz, Fri Sep 12 02:37:33 2003 UTC
# Line 84  Line 84 
84                  (mapcar #'(lambda (range)                  (mapcar #'(lambda (range)
85                              (let ((lo (car range))                              (let ((lo (car range))
86                                    (hi (cadr range)))                                    (hi (cadr range)))
87                                (random-from-interval lo (1+ hi))))                                (random-from-interval (1+ hi) lo)))
88                          var-ranges)))                          var-ranges)))
89             (setq *int-form-vals* vals)             (setq *int-form-vals* vals)
90             (let ((opt-result (apply unoptimized-compiled-fn vals))             (let ((opt-result (apply unoptimized-compiled-fn vals))
# Line 130  Line 130 
130              (- (random r) (floor (/ r 2))))              (- (random r) (floor (/ r 2))))
131          (random-from-seq vars))          (random-from-seq vars))
132      ;; (> size 1)      ;; (> size 1)
133      (ecase (random 7)      (ecase (random 9)
134       ;; Unary ops       ;; Unary ops
135       ((0 1)       ((0 1)
136        (let ((op (random-from-seq '(- abs signum 1+ 1- identity        (let ((op (random-from-seq '(- abs signum 1+ 1- identity
# Line 141  Line 141 
141        (let* ((op (random-from-seq        (let* ((op (random-from-seq
142                    '(+ - * logand min max ;; gcd lcm                    '(+ - * logand min max ;; gcd lcm
143                        logandc1 logandc2 logeqv logior lognand lognor logorc1                        logandc1 logandc2 logeqv logior lognand lognor logorc1
144                        logorc2 logxor)))                        logorc2 logxor))))
145               (leftsize (random size)))          (destructuring-bind (leftsize rightsize)
146          `(,op ,(make-random-integer-form leftsize vars)              (random-partition (1- size) 2)
147                ,(make-random-integer-form (- size 1 leftsize) vars))))            `(,op ,(make-random-integer-form leftsize vars)
148                    ,(make-random-integer-form rightsize vars)))))
149       ;; conditionals       ;; conditionals
150       (6       (6
151        (let* ((cond-size (random (max 1 (floor size 2))))        (let* ((cond-size (random (max 1 (floor size 2))))
# Line 154  Line 155 
155               (then-part (make-random-integer-form then-size vars))               (then-part (make-random-integer-form then-size vars))
156               (else-part (make-random-integer-form else-size vars)))               (else-part (make-random-integer-form else-size vars)))
157          `(if ,pred ,then-part ,else-part)))          `(if ,pred ,then-part ,else-part)))
158         (7
159          (destructuring-bind (s1 s2 s3) (random-partition (1- size) 3)
160            `(,(random-from-seq '(deposit-field dpb))
161              ,(make-random-integer-form s1 vars)
162              ,(make-random-byte-spec-form s2 vars)
163              ,(make-random-integer-form s3 vars))))
164         (8
165          (destructuring-bind (s1 s2) (random-partition (1- size) 2)
166              `(,(random-from-seq '(ldb mask-field))
167                ,(make-random-byte-spec-form s1 vars)
168                ,(make-random-integer-form s2 vars))))
169       )))       )))
170    
171  (defun make-random-pred-form (size vars)  (defun make-random-pred-form (size vars)
# Line 161  Line 173 
173        (ecase (random 3)        (ecase (random 3)
174          (0 (if (coin) t nil))          (0 (if (coin) t nil))
175          ((1 2)          ((1 2)
176           `(,(random-from-seq '(< <= = > >= /=))           `(,(random-from-seq '(< <= = > >= /= eql equal))
177             ,(make-random-integer-form size vars)             ,(make-random-integer-form size vars)
178             ,(make-random-integer-form size vars))))             ,(make-random-integer-form size vars))))
179      (ecase (random 5)      (ecase (random 6)
180        (0 (if (coin) t nil))        (0 (if (coin) t nil))
181        (1 `(not ,(make-random-pred-form (1- size) vars)))        (1 `(not ,(make-random-pred-form (1- size) vars)))
182        (2 (let* ((leftsize (random size))        (2 (destructuring-bind (leftsize rightsize)
183                  (rightsize (- size 1 leftsize)))               (random-partition (1- size) 2)
184             `(,(random-from-seq '(and or))             `(,(random-from-seq '(and or))
185               ,(make-random-pred-form leftsize vars)               ,(make-random-pred-form leftsize vars)
186               ,(make-random-pred-form rightsize vars))))               ,(make-random-pred-form rightsize vars))))
187        (3 (let* ((leftsize (random size))        (3 (destructuring-bind (leftsize rightsize)
188                  (rightsize (- size 1 leftsize)))               (random-partition (1- size) 2)
189             `(,(random-from-seq '(< <= > >= = /=))             `(,(random-from-seq '(< <= > >= = /= eql equal))
190               ,(make-random-integer-form leftsize vars)               ,(make-random-integer-form leftsize vars)
191               ,(make-random-integer-form rightsize vars))))               ,(make-random-integer-form rightsize vars))))
192        (4 (let* ((cond-size (random (max 1 (floor size 2))))        (4 (let* ((cond-size (random (max 1 (floor size 2))))
# Line 184  Line 196 
196                  (then-part (make-random-pred-form then-size vars))                  (then-part (make-random-pred-form then-size vars))
197                  (else-part (make-random-pred-form else-size vars)))                  (else-part (make-random-pred-form else-size vars)))
198             `(if ,pred ,then-part ,else-part)))             `(if ,pred ,then-part ,else-part)))
199          (5 (destructuring-bind (s1 s2)
200                 (random-partition (1- size) 2)
201               `(ldb-test ,(make-random-byte-spec-form s1 vars)
202                          ,(make-random-integer-form s2 vars))))
203    
204        )))        )))
205    
206        (defun make-random-byte-spec-form (size vars)
207      (declare (ignore size vars))
208      (let* ((pform (random 33))
209             (sform (random 33)))
210        `(byte ,sform ,pform)))
211                    
212                (defun random-partition (n p)
213      "Partition n into p numbers, each >= 1.  Return list of numbers."
214      (assert (<= 1 p))
215      (cond
216       ((= p 1) (list n))
217       ((< n p) (make-list p :initial-element 1))
218       (t
219        (let ((n1 (1+ (random (floor n p)))))
220          (cons n1 (random-partition (- n n1) (1- p)))))))

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

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26