source: trunk/source/tests/ansi-tests/plus.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: 10.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Aug 31 04:34:17 2003
4;;;; Contains: Tests of the function +
5
6(in-package :cl-test)
7
8(compile-and-load "numbers-aux.lsp")
9;;; (compile-and-load "plus-aux.lsp")
10
11(deftest plus.1
12  (+)
13  0)
14
15(deftest plus.2
16  (loop for x in *numbers*
17        unless (eql x (+ x))
18        collect x)
19  nil)
20
21(deftest plus.3
22  (loop for x in *numbers*
23        for x1 = (+ x 0)
24        for x2 = (+ 0 x)
25        unless (and (eql x x1) (eql x x2) (eql x1 x2))
26        collect (list x x1 x2))
27  nil)
28
29(deftest plus.4
30  (loop for x in *numbers*
31        for x1 = (- x x)
32        unless (= x1 0)
33        collect (list x x1))
34  nil)
35
36(deftest plus.5
37  (let* ((upper-bound most-positive-fixnum)
38         (lower-bound most-negative-fixnum)
39         (spread (- upper-bound lower-bound)))
40    (flet ((%r () (+ (random spread) lower-bound)))
41      (loop for x = (%r)
42            for y = (%r)
43            for z = (%r)
44            for s1 = (+ x y z)
45            for s2 = (+ z y x)
46            for s3 = (+ y x z)
47            for s4 = (+ x z y)
48            for s5 = (+ z x y)
49            for s6 = (+ y z x)
50            repeat 1000
51            unless (and (eql s1 s2) (eql s1 s3) (eql s1 s4)
52                        (eql s1 s5) (eql s1 s6))
53            collect (list x y z s1 s2 s3 s4 s5 s6))))
54  nil)
55
56(deftest plus.6
57  (let* ((upper-bound 1000000000000000)
58         (lower-bound -1000000000000000)
59         (spread (- upper-bound lower-bound)))
60    (flet ((%r () (+ (random spread) lower-bound)))
61      (loop for x = (%r)
62            for y = (%r)
63            for z = (%r)
64            for s1 = (+ x y z)
65            for s2 = (+ z y x)
66            for s3 = (+ y x z)
67            for s4 = (+ x z y)
68            for s5 = (+ z x y)
69            for s6 = (+ y z x)
70            repeat 1000
71            unless (and (eql s1 s2) (eql s1 s3) (eql s1 s4)
72                        (eql s1 s5) (eql s1 s6))
73            collect (list x y z s1 s2 s3 s4 s5 s6))))
74  nil)
75
76(deftest plus.7
77  (let* ((upper-bound most-positive-fixnum)
78         (lower-bound most-negative-fixnum)
79         (spread (- upper-bound lower-bound)))
80    (flet ((%r () (+ (random spread) lower-bound)))
81      (loop for x = (/ (%r) (max 1 (%r)))
82            for y = (/ (%r) (max 1 (%r)))
83            for z = (/ (%r) (max 1 (%r)))
84            for s1 = (+ x y z)
85            for s2 = (+ z y x)
86            for s3 = (+ y x z)
87            for s4 = (+ x z y)
88            for s5 = (+ z x y)
89            for s6 = (+ y z x)
90            repeat 1000
91            unless (and (eql s1 s2) (eql s1 s3) (eql s1 s4)
92                        (eql s1 s5) (eql s1 s6))
93            collect (list x y z s1 s2 s3 s4 s5 s6)
94            unless (= (+ x y)
95                      (let ((xn (numerator x))
96                            (xd (denominator x))
97                            (yn (numerator y))
98                            (yd (denominator y)))
99                        (/ (+ (* xn yd) (* xd yn))
100                           (* xd yd))))
101            collect (list x y))))
102  nil)
103
104(deftest plus.8
105  (let (args)
106    (loop for i from 0 to (min 256 (1- call-arguments-limit))
107          unless (eql (apply #'+ args) (/ (* i (1+ i)) 2))
108          collect i
109          do (push (1+ i) args)))
110  nil)
111
112(deftest plus.9
113  (let* ((upper-bound most-positive-fixnum)
114         (lower-bound most-negative-fixnum)
115         (spread (- upper-bound lower-bound)))
116    (flet ((%r () (+ (random spread) lower-bound)))
117      (loop
118       for xr = (%r)
119       for xi = (%r)
120       for yr = (%r)
121       for yi = (%r)
122       for x = (complex xr xi)
123       for y = (complex yr yi)
124       for s = (+ x y)
125       repeat 1000
126       unless (eql s (complex (+ xr yr) (+ xi yi)))
127       collect (list x y s))))
128  nil)
129
130(deftest plus.10
131  (loop
132   for x in '(0.0s0 0.0f0 0.0d0 0.0l0)
133   for radix = (float-radix x)
134   for (k eps-r eps-f) = (multiple-value-list (find-epsilon x))
135   nconc
136   (loop for i from 1 to k
137         for e1 = (expt radix (- i))
138         for y = (+ x e1)
139         nconc
140         (loop for j from 1 to (- k i)
141               for e2 = (expt radix (- j))
142               for z = (+ x e2)
143               unless (eql (+ y z) (+ x e1 e2))
144               collect (list x i j))))
145  nil)
146
147(deftest plus.11
148  (flet ((%r () (- (random most-positive-short-float) (/ most-positive-short-float 2))))
149    (loop for x = (%r)
150          for y = (%r)
151          for s = (+ x y)
152          repeat 1000
153          unless (and (eql s (+ y x))
154                      (typep s 'short-float))
155          collect (list x y s)))
156  nil)
157
158(deftest plus.12
159  (flet ((%r () (- (random most-positive-single-float) (/ most-positive-single-float 2))))
160    (loop for x = (%r)
161          for y = (%r)
162          for s = (+ x y)
163          repeat 1000
164          unless (and (eql s (+ y x))
165                      (typep s 'single-float))
166          collect (list x y s)))
167  nil)
168
169(deftest plus.13
170  (flet ((%r () (- (random most-positive-double-float) (/ most-positive-double-float 2))))
171    (loop for x = (%r)
172          for y = (%r)
173          for s = (+ x y)
174          repeat 1000
175          unless (and (eql s (+ y x))
176                      (typep s 'double-float))
177          collect (list x y s)))
178  nil)
179
180(deftest plus.14
181  (flet ((%r () (- (random most-positive-long-float) (/ most-positive-long-float 2))))
182    (loop for x = (%r)
183          for y = (%r)
184          for s = (+ x y)
185          repeat 1000
186          unless (and (eql s (+ y x))
187                      (typep s 'long-float))
188          collect (list x y s)))
189  nil)
190
191(deftest plus.15
192  (let ((bound most-positive-short-float)
193        (bound2 most-positive-single-float))
194    (loop for x = (- (random bound) (/ bound 2))
195          for y = (- (random bound2)(/ bound2 2))
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 plus.16
204  (let ((bound most-positive-short-float)
205        (bound2 most-positive-double-float))
206    (loop for x = (- (random bound) (/ bound 2))
207          for y = (- (random bound2)(/ bound2 2))
208          for p = (+ x y)
209          repeat 1000
210          unless (and (eql p (+ y x))
211                      (typep p 'double-float))
212          collect (list x y p)))
213  nil)
214
215(deftest plus.17
216  (let ((bound most-positive-short-float)
217        (bound2 most-positive-long-float))
218    (loop for x = (- (random bound) (/ bound 2))
219          for y = (- (random bound2)(/ bound2 2))
220          for p = (+ x y)
221          repeat 1000
222          unless (and (eql p (+ y x))
223                      (typep p 'long-float))
224          collect (list x y p)))
225  nil)
226
227(deftest plus.18
228  (let ((bound most-positive-single-float)
229        (bound2 most-positive-double-float))
230    (loop for x = (- (random bound) (/ bound 2))
231          for y = (- (random bound2)(/ bound2 2))
232          for p = (+ x y)
233          repeat 1000
234          unless (and (eql p (+ y x))
235                      (typep p 'double-float))
236          collect (list x y p)))
237  nil)
238
239(deftest plus.19
240  (let ((bound most-positive-single-float)
241        (bound2 most-positive-long-float))
242    (loop for x = (- (random bound) (/ bound 2))
243          for y = (- (random bound2)(/ bound2 2))
244          for p = (+ x y)
245          repeat 1000
246          unless (and (eql p (+ y x))
247                      (typep p 'long-float))
248          collect (list x y p)))
249  nil)
250
251(deftest plus.20
252  (let ((bound most-positive-double-float)
253        (bound2 most-positive-long-float))
254    (loop for x = (- (random bound) (/ bound 2))
255          for y = (- (random bound2)(/ bound2 2))
256          for p = (+ x y)
257          repeat 1000
258          unless (and (eql p (+ y x))
259                      (typep p 'long-float))
260          collect (list x y p)))
261  nil)
262
263(deftest plus.21
264  (loop
265   for type in '(short-float single-float double-float long-float)
266   for bits in '(13 24 50 50)
267   for bound = (ash 1 (1- bits))
268   nconc
269   (loop for i = (random bound)
270         for x = (coerce i type)
271         for j = (random bound)
272         for y = (coerce j type)
273         for sum = (+ x y)
274         repeat 1000
275         unless (and (eql sum (coerce (+ i j) type))
276                     (eql sum (+ y x)))
277         collect (list i j x y sum (coerce (+ i j) type))))
278  nil)
279
280(deftest plus.22
281  (loop
282   for type in '(short-float single-float double-float long-float)
283   for bits in '(13 24 50 50)
284   for bound = (ash 1 (1- bits))
285   nconc
286   (loop
287    for one = (coerce 1 type)
288    for i = (random bound)
289    for x = (complex (coerce i type) one)
290    for j = (random bound)
291    for y = (complex (coerce j type) one)
292    for sum = (+ x y)
293    repeat 1000
294    unless (and (eql sum (complex (coerce (+ i j) type)
295                                  (coerce 2 type)))
296                (eql sum (+ y x)))
297    collect (list i j x y sum)))
298  nil)
299
300(deftest plus.23
301  (loop
302   for type in '(short-float single-float double-float long-float)
303   for bits in '(13 24 50 50)
304   for bound = (ash 1 (1- bits))
305   nconc
306   (loop
307    for one = (coerce 1 type)
308    for i = (random bound)
309    for x = (complex one (coerce i type))
310    for j = (random bound)
311    for y = (complex one (coerce j type))
312    for sum = (+ x y)
313    repeat 1000
314    unless (and (eql sum (complex (coerce 2 type)
315                                  (coerce (+ i j) type)))
316                (eql sum (+ y x)))
317    collect (list i j x y sum)))
318  nil)
319
320;;; Negative zero tests (suggested by R. Toy)
321
322(deftest plus.24
323  (funcall
324   (compile nil '(lambda (x) (declare (type short-float x) (optimize (speed 3) (safety 0) (debug 0)))
325                   (+ 0.0s0 x)))
326   -0.0s0)
327  0.0s0)
328
329(deftest plus.25
330  (funcall
331   (compile nil '(lambda (x) (declare (type single-float x) (optimize (speed 3) (safety 0) (debug 0)))
332                   (+ 0.0f0 x)))
333   -0.0f0)
334  0.0f0)
335
336(deftest plus.26
337  (funcall
338   (compile nil '(lambda (x) (declare (type double-float x) (optimize (speed 3) (safety 0) (debug 0)))
339                   (+ 0.0d0 x)))
340   -0.0d0)
341  0.0d0)
342
343(deftest plus.27
344  (funcall
345   (compile nil '(lambda (x) (declare (type long-float x) (optimize (speed 3) (safety 0) (debug 0)))
346                   (+ 0.0l0 x)))
347   -0.0l0)
348  0.0l0)
349
350;;; Test that explicit calls to macroexpand in subforms
351;;; are done in the correct environment
352
353(deftest plus.28
354  (macrolet ((%m (z) z))
355            (values
356             (+ (expand-in-current-env (%m 1)))
357             (+ (expand-in-current-env (%m 2)) 3)
358             (+ 4 (expand-in-current-env (%m 5)))
359             (+ 1/2 (expand-in-current-env (%m 6)) 2/3)))
360  1 5 9 43/6)
361
362;;; Must test combinations of reals and complex arguments.
363
364;;; Order of evaluation tests
365
366(deftest plus.order.1
367  (let ((i 0) x y)
368    (values
369     (+ (progn (setf x (incf i)) '8)
370        (progn (setf y (incf i)) '11))
371     i x y))
372  19 2 1 2)
373
374(deftest plus.order.2
375  (let ((i 0) x y z)
376    (values
377     (+ (progn (setf x (incf i)) '8)
378        (progn (setf y (incf i)) '11)
379        (progn (setf z (incf i)) '100))
380     i x y z))
381  119 3 1 2 3)
382
383;;; Test that compilation does not reassociate float additions
384
385(deftest plus.reassociation.1
386  (loop
387   for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
388   for eps in (list short-float-epsilon single-float-epsilon
389                    double-float-epsilon long-float-epsilon)
390   for eps2 = (* eps 9/10)
391   when (eql
392         (funcall (compile nil `(lambda () (+ ,x (+ ,eps2 ,eps2)))))
393         x)
394   collect (list x eps eps2))
395  nil)
396
397(deftest plus.reassociation.2
398  (loop
399   for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
400   for eps in (list short-float-epsilon single-float-epsilon
401                    double-float-epsilon long-float-epsilon)
402   for eps2 = (* eps 9/10)
403   unless (equal
404           (funcall (compile nil `(lambda () (list (+ (+ ,x ,eps2) ,eps2)
405                                                   (+ ,eps2 (+ ,eps2 ,x))))))
406           (list x x))
407   collect (list x eps eps2))
408  nil)
409
410(deftest plus.reassociation.3
411  (loop
412   for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
413   for eps in (list short-float-epsilon single-float-epsilon
414                    double-float-epsilon long-float-epsilon)
415   for eps2 = (* eps 9/10)
416   when (eql
417         (funcall (compile nil `(lambda (y e) (+ y (+ e e)))) x eps2)
418         x)
419   collect (list x eps eps2))
420  nil)
421
422(deftest plus.reassociation.4
423  (loop
424   for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
425   for eps in (list short-float-epsilon single-float-epsilon
426                    double-float-epsilon long-float-epsilon)
427   for eps2 = (* eps 9/10)
428   unless (equal
429           (funcall (compile nil `(lambda (y e) (list (+ (+ y e) e)
430                                                      (+ e (+ e y)))))
431                    x eps2)
432           (list x x))
433   collect (list x eps eps2))
434  nil)
Note: See TracBrowser for help on using the repository browser.