1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Sun Aug 31 11:15:14 2003 |
---|
4 | ;;;; Contains: Tests of the - function |
---|
5 | |
---|
6 | (in-package :cl-test) |
---|
7 | |
---|
8 | (compile-and-load "numbers-aux.lsp") |
---|
9 | |
---|
10 | (deftest minus.error.1 |
---|
11 | (signals-error (-) program-error) |
---|
12 | t) |
---|
13 | |
---|
14 | ;;; Unary minus tests |
---|
15 | (deftest minus.1 |
---|
16 | (loop for x in *numbers* |
---|
17 | unless (eql (- (- x)) x) |
---|
18 | collect x) |
---|
19 | nil) |
---|
20 | |
---|
21 | (deftest minus.2 |
---|
22 | (locally |
---|
23 | (declare (notinline -)) |
---|
24 | (loop for x in *numbers* |
---|
25 | unless (eql (- (- x)) x) |
---|
26 | collect x)) |
---|
27 | nil) |
---|
28 | |
---|
29 | (deftest minus.3 |
---|
30 | (loop for x in *reals* |
---|
31 | when (and (integerp x) |
---|
32 | (not (eql (- x) (- 0 x)))) |
---|
33 | collect x) |
---|
34 | nil) |
---|
35 | |
---|
36 | (deftest minus.4 |
---|
37 | (loop for x in *reals* |
---|
38 | for neg = (- x) |
---|
39 | when (and (floatp x) |
---|
40 | (not (zerop x)) |
---|
41 | (not (eql neg (- 0.0s0 x))) |
---|
42 | (eql (float 1.0s0 x) |
---|
43 | (float 1.0s0 neg))) |
---|
44 | collect x) |
---|
45 | nil) |
---|
46 | |
---|
47 | (deftest minus.5 |
---|
48 | (loop for x in *numbers* |
---|
49 | when (and (complexp x) |
---|
50 | (rationalp (realpart x)) |
---|
51 | (not (eql (- x) (- 0 x)))) |
---|
52 | collect x) |
---|
53 | nil) |
---|
54 | |
---|
55 | (deftest minus.6 |
---|
56 | (loop for x in *numbers* |
---|
57 | for neg = (- x) |
---|
58 | when (and (complexp x) |
---|
59 | (floatp (realpart x)) |
---|
60 | (eql (float 1.0s0 (realpart x)) |
---|
61 | (float 1.0s0 (realpart neg))) |
---|
62 | (or (/= neg (- 0 x)) |
---|
63 | (and (not (zerop (realpart x))) |
---|
64 | (not (eqlzt neg (- 0 x)))))) |
---|
65 | collect x) |
---|
66 | nil) |
---|
67 | |
---|
68 | (deftest minus.7 |
---|
69 | (let ((upper-bound most-positive-fixnum) |
---|
70 | (lower-bound most-negative-fixnum)) |
---|
71 | (loop |
---|
72 | for x = (+ (random (- upper-bound lower-bound)) lower-bound) |
---|
73 | for neg = (- x) |
---|
74 | repeat 1000 |
---|
75 | unless (and (integerp neg) |
---|
76 | (eql (abs x) (abs neg)) |
---|
77 | (if (> x 0) (< neg 0) (>= neg 0)) |
---|
78 | (zerop (+ x neg)) |
---|
79 | (eql x (- neg))) |
---|
80 | collect x)) |
---|
81 | nil) |
---|
82 | |
---|
83 | (deftest minus.8 |
---|
84 | (let ((upper-bound (ash 1 1000)) |
---|
85 | (lower-bound (- (ash 1 1000)))) |
---|
86 | (loop |
---|
87 | for x = (+ (random (- upper-bound lower-bound)) lower-bound) |
---|
88 | for neg = (- x) |
---|
89 | repeat 1000 |
---|
90 | unless (and (integerp neg) |
---|
91 | (eql (abs x) (abs neg)) |
---|
92 | (if (> x 0) (< neg 0) (>= neg 0)) |
---|
93 | (zerop (+ x neg)) |
---|
94 | (eql x (- neg))) |
---|
95 | collect x)) |
---|
96 | nil) |
---|
97 | |
---|
98 | ;;; Test that explicit calls to macroexpand in subforms |
---|
99 | ;;; are done in the correct environment |
---|
100 | |
---|
101 | (deftest minus.9 |
---|
102 | (macrolet ((%m (z) z)) (- (expand-in-current-env (%m 1)))) |
---|
103 | -1) |
---|
104 | |
---|
105 | ;;; Binary minus tests |
---|
106 | |
---|
107 | (deftest subtract.1 |
---|
108 | (loop |
---|
109 | for x = (random-fixnum) |
---|
110 | for y = (random-fixnum) |
---|
111 | repeat 1000 |
---|
112 | unless (and (eql (+ x (- y)) (- x y)) |
---|
113 | (eql (+ 1 x (- y)) (- x (1- y))) |
---|
114 | (eql (+ -1 x (- y)) (- x (1+ y)))) |
---|
115 | collect (list x y)) |
---|
116 | nil) |
---|
117 | |
---|
118 | (deftest subtract.2 |
---|
119 | (let ((bound (ash 1 1000))) |
---|
120 | (loop |
---|
121 | for x = (random-from-interval bound (- bound)) |
---|
122 | for y = (random-from-interval bound (- bound)) |
---|
123 | repeat 1000 |
---|
124 | unless (and (eql (+ x (- y)) (- x y)) |
---|
125 | (eql (+ 1 x (- y)) (- x (1- y))) |
---|
126 | (eql (+ -1 x (- y)) (- x (1+ y)))) |
---|
127 | collect (list x y))) |
---|
128 | nil) |
---|
129 | |
---|
130 | (deftest subtract.3 |
---|
131 | (let ((args nil)) |
---|
132 | (loop for i from 1 below (min 256 (1- call-arguments-limit)) |
---|
133 | do (push 1 args) |
---|
134 | always (eql (apply #'- 1000 args) (- 1000 i)))) |
---|
135 | t) |
---|
136 | |
---|
137 | ;;; Float contagion |
---|
138 | |
---|
139 | (deftest subtract.4 |
---|
140 | (loop |
---|
141 | for type1 in '(short-float single-float double-float long-float) |
---|
142 | for bits1 in '(13 24 50 50) |
---|
143 | for bound1 = (ash 1 (- bits1 2)) |
---|
144 | for c1 from 1 |
---|
145 | nconc |
---|
146 | (loop for type2 in '(short-float single-float double-float long-float) |
---|
147 | for bits2 in '(13 24 50 50) |
---|
148 | for bound2 = (ash 1 (- bits2 2)) |
---|
149 | for c2 from 1 |
---|
150 | nconc |
---|
151 | (loop |
---|
152 | for i = (random-from-interval bound1) |
---|
153 | for x = (coerce i type1) |
---|
154 | for j = (random-from-interval bound2) |
---|
155 | for y = (coerce j type2) |
---|
156 | for idiff1 = (- i j) |
---|
157 | for idiff2 = (- j i) |
---|
158 | for diff1 = (- x y) |
---|
159 | for diff2 = (- y x) |
---|
160 | repeat 1000 |
---|
161 | unless (or (zerop idiff1) |
---|
162 | (and (eql idiff1 (- idiff2)) |
---|
163 | (eql diff1 (- diff2)) |
---|
164 | (if (<= c1 c2) |
---|
165 | (eql (float diff1 y) diff1) |
---|
166 | (eql (float diff1 x) diff1)) |
---|
167 | (eql (float idiff1 diff1) diff1))) |
---|
168 | collect (list i x j y idiff1 idiff2 diff1 diff2)))) |
---|
169 | nil) |
---|
170 | |
---|
171 | ;;; Complex subtraction |
---|
172 | |
---|
173 | (deftest subtract.5 |
---|
174 | (loop for i = (random-fixnum) |
---|
175 | for ci = (complex i (+ i 100)) |
---|
176 | for j = (random-fixnum) |
---|
177 | for cj = (complex j (- j 200)) |
---|
178 | for diff = (- ci cj) |
---|
179 | repeat 1000 |
---|
180 | unless (eql diff (complex (- i j) (+ (- i j) 300))) |
---|
181 | collect (list i ci j cj (- ci cj))) |
---|
182 | nil) |
---|
183 | |
---|
184 | ;;; Test that explicit calls to macroexpand in subforms |
---|
185 | ;;; are done in the correct environment |
---|
186 | |
---|
187 | (deftest subtract.6 |
---|
188 | (macrolet ((%m (z) z)) |
---|
189 | (values |
---|
190 | (- (expand-in-current-env (%m 2)) 1) |
---|
191 | (- 17 (expand-in-current-env (%m 5))) |
---|
192 | (- 1/2 (expand-in-current-env (%m 1/6)) |
---|
193 | (expand-in-current-env (%m 0))))) |
---|
194 | 1 12 1/3) |
---|