1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Sun Aug 31 20:20:15 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 "division-aux.lsp") |
---|
10 | |
---|
11 | (deftest /.error.1 |
---|
12 | (signals-error (/) program-error) |
---|
13 | t) |
---|
14 | |
---|
15 | (deftest /.error.2 |
---|
16 | (divide-by-zero-test 0)) |
---|
17 | |
---|
18 | (deftest /.error.3 |
---|
19 | (divide-by-zero-test 1 0)) |
---|
20 | |
---|
21 | (deftest /.error.4 |
---|
22 | (divide-by-zero-test 17 10 0 11)) |
---|
23 | |
---|
24 | (deftest /.error.5 |
---|
25 | (divide-by-zero-test 0.0s0)) |
---|
26 | |
---|
27 | (deftest /.error.6 |
---|
28 | (divide-by-zero-test 0.0f0)) |
---|
29 | |
---|
30 | (deftest /.error.7 |
---|
31 | (divide-by-zero-test 0.0d0)) |
---|
32 | |
---|
33 | (deftest /.error.8 |
---|
34 | (divide-by-zero-test 0.0l0)) |
---|
35 | |
---|
36 | ;;;;;;;;;; |
---|
37 | |
---|
38 | (deftest /.1 |
---|
39 | (/ 1) |
---|
40 | 1) |
---|
41 | |
---|
42 | (deftest /.2 |
---|
43 | (/ -1) |
---|
44 | -1) |
---|
45 | |
---|
46 | (deftest /.3 |
---|
47 | (loop for i = (random-fixnum) |
---|
48 | repeat 1000 |
---|
49 | unless (or (zerop i) |
---|
50 | (let ((q1 (/ i)) |
---|
51 | (q2 (/ 1 i))) |
---|
52 | (and (rationalp q1) |
---|
53 | (eql (denominator q1) (abs i)) |
---|
54 | (eql (numerator q1) (signum i)) |
---|
55 | (eql q1 q2) |
---|
56 | (eql (* q1 i) 1)))) |
---|
57 | collect i) |
---|
58 | nil) |
---|
59 | |
---|
60 | (deftest /.4 |
---|
61 | (loop for i = (random-from-interval 1000000 1) |
---|
62 | for j = (random-from-interval 1000000 1) |
---|
63 | for g = (gcd i j) |
---|
64 | for q = (/ i j) |
---|
65 | for q2 = (/ j) |
---|
66 | repeat 1000 |
---|
67 | unless (and (integerp g) |
---|
68 | (zerop (mod i g)) |
---|
69 | (zerop (mod j g)) |
---|
70 | (eql (numerator q) (/ i g)) |
---|
71 | (eql (denominator q) (/ j g)) |
---|
72 | (eql (/ q) (/ j i)) |
---|
73 | (eql q (* i q2))) |
---|
74 | collect (list i j q)) |
---|
75 | nil) |
---|
76 | |
---|
77 | (deftest /.5 |
---|
78 | (loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20) |
---|
79 | nconc |
---|
80 | (loop for i = (1+ (random bound)) |
---|
81 | for r1 = (/ i) |
---|
82 | for r2 = (/ 1 i) |
---|
83 | repeat 1000 |
---|
84 | unless (eql r1 r2) |
---|
85 | collect (list i r1 r2))) |
---|
86 | nil) |
---|
87 | |
---|
88 | ;; Complex division |
---|
89 | (deftest /.6 |
---|
90 | (loop for i1 = (random-fixnum) |
---|
91 | for i = (if (zerop i1) 1 i1) |
---|
92 | for c = (complex 0 i) |
---|
93 | for r = (/ c) |
---|
94 | repeat 1000 |
---|
95 | unless (eql r (complex 0 (- (/ i)))) |
---|
96 | collect (list i c r)) |
---|
97 | nil) |
---|
98 | |
---|
99 | #| |
---|
100 | (deftest /.7 |
---|
101 | (loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20) |
---|
102 | nconc |
---|
103 | (loop for i = (1+ (random bound)) |
---|
104 | for c = (complex 0 i) |
---|
105 | for r = (/ c) |
---|
106 | repeat 1000 |
---|
107 | unless (= r (complex 0 (- (/ i)))) |
---|
108 | collect (list i c r (complex 0 (- (/ i)))))) |
---|
109 | nil) |
---|
110 | |# |
---|
111 | |
---|
112 | (deftest /.8 |
---|
113 | (loop for bound in (list 1.0s5 1.0f10 1.0d20 1.0l20) |
---|
114 | for one = (float 1.0 bound) |
---|
115 | for zero = (float 0.0 bound) |
---|
116 | nconc |
---|
117 | (loop for i = (1+ (random bound)) |
---|
118 | for c = (complex i zero) |
---|
119 | for q = (/ c c) |
---|
120 | repeat 100 |
---|
121 | unless (eql q (complex one zero)) |
---|
122 | collect (list i c q (complex one zero)))) |
---|
123 | nil) |
---|
124 | |
---|
125 | |
---|
126 | (deftest /.9 |
---|
127 | (loop for a = (random-fixnum) |
---|
128 | for b = (random-fixnum) |
---|
129 | for m = (+ (* a a) (* b b)) |
---|
130 | repeat 1000 |
---|
131 | unless |
---|
132 | (or (zerop m) |
---|
133 | (let* ((q (/ (complex a b))) |
---|
134 | (c (/ a m)) |
---|
135 | (d (/ (- b) m)) |
---|
136 | (expected (complex c d))) |
---|
137 | (eql q expected))) |
---|
138 | collect (list a b (/ (complex a b)))) |
---|
139 | nil) |
---|
140 | |
---|
141 | (deftest /.10 |
---|
142 | (let ((bound 1000000000000000000)) |
---|
143 | (loop for a = (random-from-interval bound) |
---|
144 | for b = (random-from-interval bound) |
---|
145 | for m = (+ (* a a) (* b b)) |
---|
146 | repeat 1000 |
---|
147 | unless |
---|
148 | (or (zerop m) |
---|
149 | (let* ((q (/ (complex a b))) |
---|
150 | (c (/ a m)) |
---|
151 | (d (/ (- b) m)) |
---|
152 | (expected (complex c d))) |
---|
153 | (eql q expected))) |
---|
154 | collect (list a b (/ (complex a b))))) |
---|
155 | nil) |
---|
156 | |
---|
157 | (deftest /.11 |
---|
158 | (loop for a = (random-fixnum) |
---|
159 | for b = (random-fixnum) |
---|
160 | for n = (complex (random-fixnum) (random-fixnum)) |
---|
161 | for m = (+ (* a a) (* b b)) |
---|
162 | repeat 1000 |
---|
163 | unless |
---|
164 | (or (zerop m) |
---|
165 | (let* ((q (/ n (complex a b))) |
---|
166 | (c (/ a m)) |
---|
167 | (d (/ (- b) m)) |
---|
168 | (expected (* n (complex c d)))) |
---|
169 | (eql q expected))) |
---|
170 | collect (list a b (/ n (complex a b)))) |
---|
171 | nil) |
---|
172 | |
---|
173 | ;;; More floating point tests |
---|
174 | |
---|
175 | (deftest /.12 |
---|
176 | (loop for type in '(short-float single-float double-float long-float) |
---|
177 | for lower in (mapcar |
---|
178 | #'rational-safely |
---|
179 | (list |
---|
180 | least-positive-short-float least-positive-single-float |
---|
181 | least-positive-double-float least-positive-long-float)) |
---|
182 | for upper in (mapcar |
---|
183 | #'rational-safely |
---|
184 | (list |
---|
185 | most-positive-short-float most-positive-single-float |
---|
186 | most-positive-double-float most-positive-long-float)) |
---|
187 | for one = (coerce 1 type) |
---|
188 | for radix = (float-radix one) |
---|
189 | nconc |
---|
190 | (loop |
---|
191 | for i from 1 |
---|
192 | for rpos = radix then (* rpos radix) |
---|
193 | for rneg = (/ radix) then (/ rneg radix) |
---|
194 | while (<= lower rneg rpos upper) |
---|
195 | unless |
---|
196 | (let ((frpos (float rpos one)) |
---|
197 | (frneg (float rneg one))) |
---|
198 | (and (eql (/ frpos) (/ one frpos)) |
---|
199 | (eql (/ frpos) (/ 1.0s0 frpos)) |
---|
200 | (eql (/ frpos) (/ 1 frpos)) |
---|
201 | (eql (/ frpos) frneg) |
---|
202 | (eql (/ frneg) (/ 1.0s0 frneg)) |
---|
203 | (eql (/ frneg) (/ 1 frneg)) |
---|
204 | (eql (/ frneg) frpos))) |
---|
205 | collect (list i rpos rneg (float rpos one) (float rneg one)))) |
---|
206 | nil) |
---|
207 | |
---|
208 | ;;; Test that explicit calls to macroexpand in subforms |
---|
209 | ;;; are done in the correct environment |
---|
210 | |
---|
211 | (deftest /.13 |
---|
212 | (macrolet ((%m (z) z)) |
---|
213 | (values |
---|
214 | (/ (expand-in-current-env (%m 1/2))) |
---|
215 | (/ (expand-in-current-env (%m 2)) 3) |
---|
216 | (/ 5 (expand-in-current-env (%m 7))))) |
---|
217 | 2 2/3 5/7) |
---|