source: trunk/source/tests/ansi-tests/times.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 9.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Aug 28 10:41:34 2003
4;;;; Contains: Tests of the multiplication function *
5
6(in-package :cl-test)
7
8(compile-and-load "numbers-aux.lsp")
9(compile-and-load "times-aux.lsp")
10
11(deftest *.1
12  (*)
13  1)
14
15(deftest *.2
16  (loop for x in *numbers*
17        unless (eql x (* x))
18        collect x)
19  nil)
20
21(deftest *.3
22  (loop for x in *numbers*
23        for x1 = (* x 1)
24        for x2 = (* 1 x)
25        unless (and (eql x x1) (eql x x2) (eql x1 x2))
26        collect (list x x1 x2))
27  nil)
28
29(deftest *.4
30  (loop for x in *numbers*
31        for x1 = (* x 0)
32        for x2 = (* 0 x)
33        unless (and (= x1 0) (= x2 0))
34        collect (list x x1 x2))
35  nil)
36
37(deftest *.5
38  (loop for bound in '(1.0s0 1.0f0 1.0d0 1.0l0)
39        nconc
40        (loop for x = (random bound)
41              for x1 = (* x -1)
42              for x2 = (* -1 x)
43              for x3 = (* x bound)
44              for x4 = (* bound x)
45              repeat 1000
46              unless (and (eql (- x) x1) (eql (- x) x2)
47                          (eql x x3) (eql x x4))
48              collect (list x x1 x2 x3 x4)))
49  nil)
50
51(deftest *.6
52  (let* ((upper-bound (* 1000 1000 1000 1000))
53         (lower-bound (- upper-bound))
54         (spread (1+ (- upper-bound lower-bound))))
55    (loop for x = (random-from-interval upper-bound)
56          for y = (random-from-interval upper-bound)
57          for prod = (* x y)
58          for prod2 = (integer-times x y)
59          repeat 1000
60          unless (eql prod prod2)
61          collect (list x y prod prod2)))
62  nil)
63
64(deftest *.7
65  (let* ((upper-bound (* 1000 1000 1000))
66         (lower-bound (- upper-bound))
67         (spread (1+ (- upper-bound lower-bound))))
68    (loop for x = (+ (rational (random (float spread 1.0f0))) lower-bound)
69          for y = (+ (rational (random (float spread 1.0f0))) lower-bound)
70          for prod = (* x y)
71          for prod2 = (rat-times x y)
72          repeat 1000
73          unless (eql prod prod2)
74          collect (list x y prod prod2)))
75  nil)
76
77;; Testing of multiplication by integer constants
78(deftest *.8
79  (let ((bound (isqrt most-positive-fixnum)))
80    (loop
81     for x = (random bound)
82     for y = (random bound)
83     for f = (eval `(function (lambda (z)
84                                (declare (optimize (speed 3) (safety 0)))
85                                (declare (type (integer 0 (,bound)) z))
86                                (* ,x z))))
87     for prod = (funcall f y)
88     repeat 100
89     unless (and (eql prod (* x y))
90                 (eql prod (integer-times x y)))
91     collect (progn (format t "Failed on ~A~%" (list x y prod))
92                    (list x y prod (* x y) (integer-times x y)))))
93  nil)
94
95(deftest *.9
96  (let* ((upper-bound (* 1000 1000 1000 1000)))
97    (flet ((%r () (random-from-interval upper-bound)))
98      (loop for xr = (%r)
99            for xc = (%r)
100            for x = (complex xr xc)
101            for yr = (%r)
102            for yc = (%r)
103            for y = (complex yr yc)
104            for prod = (* x y)
105            repeat 1000
106            unless (and (eql (realpart prod) (- (integer-times xr yr)
107                                                (integer-times xc yc)))
108                        (eql (imagpart prod) (+ (integer-times xr yc)
109                                                (integer-times xc yr))))
110            collect (list x y prod))))
111  nil)
112
113(deftest *.10
114  (let* ((upper-bound (* 1000 1000 1000 1000))
115         (lower-bound (- upper-bound))
116         (spread (1+ (- upper-bound lower-bound))))
117    (flet ((%r () (+ (rational (random (float spread 1.0f0))) lower-bound)))
118      (loop for xr = (%r)
119            for xc = (%r)
120            for x = (complex xr xc)
121            for yr = (%r)
122            for yc = (%r)
123            for y = (complex yr yc)
124            for prod = (* x y)
125            repeat 1000
126            unless (and (eql (realpart prod) (- (rat-times xr yr)
127                                                (rat-times xc yc)))
128                        (eql (imagpart prod) (+ (rat-times xr yc)
129                                                (rat-times xc yr))))
130          collect (list x y prod))))
131  nil)
132
133(deftest *.11
134  (let ((prod 1) (args nil))
135    (loop for i from 1 to (min 256 (1- call-arguments-limit))
136          do (push i args)
137          do (setq prod (* prod i))
138          always (eql (apply #'* args) prod)))
139  t)
140
141(deftest *.12
142  (loop
143   for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
144   for radix = (float-radix x)
145   for (k eps-r eps-f) = (multiple-value-list (find-epsilon x))
146   nconc
147   (loop for i from 1 to k
148         for y = (+ x (expt radix (- i)))
149         nconc
150         (loop for j from 1 to (- k i)
151               for z = (+ x (expt radix (- j)))
152               unless (eql (* y z)
153                           (+ x
154                              (expt radix (- i))
155                              (expt radix (- j))
156                              (expt radix (- (+ i j)))))
157               collect (list x i j))))
158  nil)
159
160(deftest *.13
161  (loop
162   for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
163   for radix = (float-radix x)
164   for (k eps-r eps-f) = (multiple-value-list (find-epsilon x))
165   nconc
166   (loop for i from 1 to k
167         for y = (- x (expt radix (- i)))
168         nconc
169         (loop for j from 1 to (- k i)
170               for z = (- x (expt radix (- j)))
171               unless (eql (* y z)
172                           (+ x
173                              (- (expt radix (- i)))
174                              (- (expt radix (- j)))
175                              (expt radix (- (+ i j)))))
176               collect (list x i j))))
177  nil)
178
179;;; Float contagion
180
181(deftest *.14
182  (let ((bound (- (sqrt most-positive-short-float) 1)))
183    (loop for x = (random-from-interval bound)
184          for y = (random-from-interval bound)
185          for p = (* x y)
186          repeat 1000
187          unless (and (eql p (* y x))
188                      (typep p 'short-float))
189          collect (list x y p)))
190  nil) 
191
192(deftest *.15
193  (let ((bound (- (sqrt most-positive-single-float) 1)))
194    (loop for x = (random-from-interval bound)
195          for y = (random-from-interval bound)
196          for p = (* x y)
197          repeat 1000
198          unless (and (eql p (* y x))
199                      (typep p 'single-float))
200          collect (list x y p)))
201  nil) 
202
203(deftest *.16
204  (let ((bound (- (sqrt most-positive-double-float) 1)))
205    (loop for x = (random-from-interval bound)
206          for y = (random-from-interval bound)
207          for p = (* x y)
208          repeat 1000
209          unless (and (eql p (* y x))
210                      (typep p 'double-float))
211          collect (list x y p)))
212  nil)
213
214(deftest *.17
215  (let ((bound (- (sqrt most-positive-long-float) 1)))
216    (loop for x = (random-from-interval bound)
217          for y = (random-from-interval bound)
218          for p = (* x y)
219          repeat 1000
220          unless (and (eql p (* y x))
221                      (typep p 'long-float))
222          collect (list x y p)))
223  nil)
224
225(deftest *.18
226  (let ((bound (- (sqrt most-positive-short-float) 1))
227        (bound2 (- (sqrt most-positive-single-float) 1)))
228    (loop for x = (random-from-interval bound)
229          for y = (random-from-interval bound2)
230          for p = (* x y)
231          repeat 1000
232          unless (and (eql p (* y x))
233                      (typep p 'single-float))
234          collect (list x y p)))
235  nil)
236
237(deftest *.19
238  (let ((bound (- (sqrt most-positive-short-float) 1))
239        (bound2 (- (sqrt most-positive-double-float) 1)))
240    (loop for x = (random-from-interval bound)
241          for y = (random-from-interval bound2)
242          for p = (* x y)
243          repeat 1000
244          unless (and (eql p (* y x))
245                      (typep p 'double-float))
246          collect (list x y p)))
247  nil)
248
249(deftest *.20
250  (let ((bound (- (sqrt most-positive-short-float) 1))
251        (bound2 (- (sqrt most-positive-long-float) 1)))
252    (loop for x = (random-from-interval bound)
253          for y = (random-from-interval bound2)
254          for p = (* x y)
255          repeat 1000
256          unless (and (eql p (* y x))
257                      (typep p 'long-float))
258          collect (list x y p)))
259  nil)
260
261(deftest *.21
262  (let ((bound (- (sqrt most-positive-single-float) 1))
263        (bound2 (- (sqrt most-positive-double-float) 1)))
264    (loop for x = (random-from-interval bound)
265          for y = (random-from-interval bound2)
266          for p = (* x y)
267          repeat 1000
268          unless (and (eql p (* y x))
269                      (typep p 'double-float))
270          collect (list x y p)))
271  nil)
272
273(deftest *.22
274  (let ((bound (- (sqrt most-positive-single-float) 1))
275        (bound2 (- (sqrt most-positive-long-float) 1)))
276    (loop for x = (random-from-interval bound)
277          for y = (random-from-interval bound2)
278          for p = (* x y)
279          repeat 1000
280          unless (and (eql p (* y x))
281                      (typep p 'long-float))
282          collect (list x y p)))
283  nil)
284
285(deftest *.23
286  (let ((bound (- (sqrt most-positive-double-float) 1))
287        (bound2 (- (sqrt most-positive-long-float) 1)))
288    (loop for x = (random-from-interval bound)
289          for y = (random-from-interval bound2)
290          for p = (* x y)
291          repeat 1000
292          unless (and (eql p (* y x))
293                      (typep p 'long-float))
294          collect (list x y p)))
295  nil)
296
297(deftest *.24
298  (loop
299   for type in '(short-float single-float double-float long-float)
300   for bits in '(13 24 50 50)
301   for bound = (ash 1 (floor bits 2))
302   nconc
303   (loop for i = (random bound)
304         for x = (coerce i type)
305         for j = (random bound)
306         for y = (coerce j type)
307         for prod = (* x y)
308         repeat 1000
309         unless (and (eql prod (coerce (* i j) type))
310                     (eql prod (* y x)))
311         collect (list i j x y (* x y) (coerce (* i j) type))))
312  nil)
313
314(deftest *.25
315  (loop
316   for type in '(short-float single-float double-float long-float)
317   for bits in '(13 24 50 50)
318   for bound = (ash 1 (- bits 2))
319   when (= (float-radix (coerce 1.0 type)) 2)
320   nconc
321   (loop for i = (random bound)
322         for x = (coerce i type)
323         for j = (* i 2)
324         for y = (coerce j type)
325         repeat 1000
326         unless (eql (* 2 x) y)
327         collect (list i j x (* 2 x) y)))
328  nil)
329
330;;; Shows a compiler bug in sbcl/cmucl
331(deftest *.26
332  (eqlt (funcall (compile nil
333                          '(lambda (x y)
334                             (declare (type (single-float -10.0 10.0) x)
335                                      (type (double-float -1.0d100 1.0d100) y))
336                             (* x y)))
337                 1.0f0 1.0d0)
338        1.0d0)
339  t)
340
341(deftest *.27
342  (loop
343   for type in '(short-float single-float double-float long-float)
344   for bits in '(13 24 50 50)
345   for bound = (ash 1 (floor bits 2))
346   nconc
347   (loop for i = (random bound)
348         for x = (coerce i type)
349         for j = (random bound)
350         for y = (coerce j type)
351         for one = (coerce 1.0 type)
352         for cx = (complex one x)
353         for cy = (complex one y)
354         for prod = (* cx cy)
355         repeat 1000
356         unless (and (eql prod (complex (coerce (- 1 (* i j)) type)
357                                        (coerce (+ i j) type)))
358                     (eql prod (* cy cx)))
359         collect (list type i j x y (* cx cy))))
360  nil)
361
362;;; Test that explicit calls to macroexpand in subforms
363;;; are done in the correct environment
364
365(deftest *.28
366  (macrolet ((%m (z) z))
367            (values
368             (* (expand-in-current-env (%m 2)))
369             (* (expand-in-current-env (%m 3)) 4)
370             (* 5 (expand-in-current-env (%m 3)))))
371  2 12 15)
372
373;;; Order of evaluation tests
374
375(deftest times.order.1
376  (let ((i 0) x y)
377    (values
378     (* (progn (setf x (incf i)) 2)
379        (progn (setf y (incf i)) 3))
380     i x y))
381  6 2 1 2)
382
383(deftest times.order.2
384  (let ((i 0) x y z)
385    (values
386     (* (progn (setf x (incf i)) 2)
387        (progn (setf y (incf i)) 3)
388        (progn (setf z (incf i)) 5))
389     i x y z))
390  30 3 1 2 3)
Note: See TracBrowser for help on using the repository browser.