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) |
---|