1 | ;;; math-tests.lisp |
---|
2 | ;;; |
---|
3 | ;;; Copyright (C) 2005 Peter Graves |
---|
4 | ;;; $Id: math-tests.lisp 13260 2011-04-03 16:02:44Z mevenson $ |
---|
5 | ;;; |
---|
6 | ;;; This program is free software; you can redistribute it and/or |
---|
7 | ;;; modify it under the terms of the GNU General Public License |
---|
8 | ;;; as published by the Free Software Foundation; either version 2 |
---|
9 | ;;; of the License, or (at your option) any later version. |
---|
10 | ;;; |
---|
11 | ;;; This program is distributed in the hope that it will be useful, |
---|
12 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
14 | ;;; GNU General Public License for more details. |
---|
15 | ;;; |
---|
16 | ;;; You should have received a copy of the GNU General Public License |
---|
17 | ;;; along with this program; if not, write to the Free Software |
---|
18 | ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
---|
19 | |
---|
20 | ;;; Some of these tests are based on tests in the CLISP test suite. |
---|
21 | |
---|
22 | (in-package #:abcl.test.lisp) |
---|
23 | |
---|
24 | #+(or abcl cmu sbcl) |
---|
25 | (defmacro set-floating-point-modes (&rest args) |
---|
26 | `(funcall #+abcl 'ext:set-floating-point-modes |
---|
27 | #+cmu 'ext:set-floating-point-modes |
---|
28 | #+sbcl 'sb-int:set-floating-point-modes |
---|
29 | ,@args)) |
---|
30 | |
---|
31 | #+(or abcl cmu sbcl) |
---|
32 | (defmacro get-floating-point-modes () |
---|
33 | #+abcl `(ext:get-floating-point-modes) |
---|
34 | #+cmu `(ext:get-floating-point-modes) |
---|
35 | #+sbcl `(sb-int:get-floating-point-modes)) |
---|
36 | |
---|
37 | #+(or abcl cmu sbcl) |
---|
38 | (defmacro restore-default-floating-point-modes () |
---|
39 | #+abcl |
---|
40 | `(ext:set-floating-point-modes :traps '(:overflow :underflow)) |
---|
41 | #+(or cmu sbcl) |
---|
42 | `(set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero))) |
---|
43 | |
---|
44 | #+(or abcl cmu sbcl) |
---|
45 | (eval-when (:compile-toplevel :load-toplevel :execute) |
---|
46 | (restore-default-floating-point-modes)) |
---|
47 | ;; (ext:set-floating-point-modes :traps '(:overflow :underflow))) |
---|
48 | ;; |
---|
49 | |
---|
50 | (deftest most-negative-fixnum.1 |
---|
51 | (= (/ most-negative-fixnum -1) (- most-negative-fixnum)) |
---|
52 | t) |
---|
53 | |
---|
54 | (deftest most-negative-fixnum.2 |
---|
55 | (= (abs most-negative-fixnum) (- most-negative-fixnum)) |
---|
56 | t) |
---|
57 | |
---|
58 | #+(or abcl cmu sbcl) |
---|
59 | (deftest floating-point-modes.1 |
---|
60 | (unwind-protect |
---|
61 | (progn |
---|
62 | (set-floating-point-modes :traps nil) |
---|
63 | (getf (get-floating-point-modes) :traps)) |
---|
64 | (restore-default-floating-point-modes)) |
---|
65 | nil) |
---|
66 | |
---|
67 | #+(or abcl cmu sbcl) |
---|
68 | (deftest floating-point-modes.2 |
---|
69 | (unwind-protect |
---|
70 | (progn |
---|
71 | (set-floating-point-modes :traps '(:overflow)) |
---|
72 | (getf (get-floating-point-modes) :traps)) |
---|
73 | (restore-default-floating-point-modes)) |
---|
74 | (:overflow)) |
---|
75 | |
---|
76 | #+(or abcl cmu sbcl) |
---|
77 | (deftest floating-point-modes.3 |
---|
78 | (unwind-protect |
---|
79 | (progn |
---|
80 | (set-floating-point-modes :traps '(:underflow)) |
---|
81 | (getf (get-floating-point-modes) :traps)) |
---|
82 | (restore-default-floating-point-modes)) |
---|
83 | (:underflow)) |
---|
84 | |
---|
85 | #+(or abcl cmu sbcl) |
---|
86 | (deftest floating-point-modes.4 |
---|
87 | (unwind-protect |
---|
88 | (progn |
---|
89 | (set-floating-point-modes :traps '(:overflow :underflow)) |
---|
90 | (set-exclusive-or (getf (get-floating-point-modes) :traps) |
---|
91 | '(:overflow :underflow))) |
---|
92 | (restore-default-floating-point-modes)) |
---|
93 | nil) |
---|
94 | |
---|
95 | (deftest single-float-epsilon.1 |
---|
96 | single-float-epsilon |
---|
97 | #+lispworks 1.1102230246251568f-16 |
---|
98 | #-lispworks 5.960465f-8) |
---|
99 | |
---|
100 | (deftest single-float-negative-epsilon.1 |
---|
101 | single-float-negative-epsilon |
---|
102 | #+lispworks 5.551115123125784f-17 |
---|
103 | #-lispworks 2.9802326f-8) |
---|
104 | |
---|
105 | (deftest most-positive-single-float.1 |
---|
106 | most-positive-single-float |
---|
107 | #-lispworks |
---|
108 | 3.4028235e+38 |
---|
109 | #+lispworks |
---|
110 | 1.7976931348623157E308) |
---|
111 | |
---|
112 | (deftest most-positive-single-float.2 |
---|
113 | (log most-positive-single-float) |
---|
114 | #-lispworks 88.72284 |
---|
115 | #+lispworks 709.782712893384) |
---|
116 | |
---|
117 | (deftest least-positive-single-float.1 |
---|
118 | least-positive-single-float |
---|
119 | #-(or clisp lispworks) 1.4012985e-45 |
---|
120 | #+clisp 1.1754944E-38 |
---|
121 | #+lispworks 4.9406564584124646E-324) |
---|
122 | |
---|
123 | (deftest least-positive-single-float.2 |
---|
124 | (log least-positive-single-float) |
---|
125 | #-(or clisp lispworks) -103.27893 |
---|
126 | #+clisp -87.33655 |
---|
127 | #+lispworks -744.4400719213812) |
---|
128 | |
---|
129 | ;; SQRT |
---|
130 | (deftest sqrt.1 |
---|
131 | (sqrt 0) |
---|
132 | #+clisp 0 |
---|
133 | #-clisp 0.0) |
---|
134 | |
---|
135 | (deftest sqrt.2 |
---|
136 | (sqrt 1) |
---|
137 | #+clisp 1 |
---|
138 | #-clisp 1.0) |
---|
139 | |
---|
140 | (deftest sqrt.3 |
---|
141 | (sqrt 9) |
---|
142 | #+clisp 3 |
---|
143 | #-clisp 3.0) |
---|
144 | |
---|
145 | (deftest sqrt.4 |
---|
146 | (sqrt -9) |
---|
147 | #+clisp #c(0 3) |
---|
148 | #-clisp #c(0.0 3.0)) |
---|
149 | |
---|
150 | (deftest sqrt.5 |
---|
151 | (sqrt #c(-7 24)) |
---|
152 | #-(or clisp lispworks) #c(3.0 4.0) |
---|
153 | #+clisp #c(3 4) |
---|
154 | #+lispworks #c(3.0 3.999999999999999)) |
---|
155 | |
---|
156 | (deftest sqrt.6 |
---|
157 | (sqrt 1d0) |
---|
158 | 1.0d0) |
---|
159 | |
---|
160 | (deftest sqrt.7 |
---|
161 | (sqrt -1) |
---|
162 | #+(or clisp) #c(0 1) |
---|
163 | #+(or abcl allegro cmu lispworks sbcl) #c(0.0 1.0)) |
---|
164 | |
---|
165 | (deftest sqrt.8 |
---|
166 | (sqrt -1d0) |
---|
167 | #c(0 1.0d0)) |
---|
168 | |
---|
169 | (deftest sqrt.9 |
---|
170 | (sqrt #c(0.0 0.0)) |
---|
171 | #c(0.0 0.0)) |
---|
172 | |
---|
173 | (deftest sqrt.10 |
---|
174 | (sqrt #c(4.0 0.0)) |
---|
175 | #c(2.0 0.0)) |
---|
176 | |
---|
177 | (deftest sqrt.11 |
---|
178 | (sqrt #c(-4.0 0.0)) |
---|
179 | #c(0.0 2.0)) |
---|
180 | |
---|
181 | (deftest sqrt.12 |
---|
182 | (sqrt #c(-4.4855622e-7 0.0)) |
---|
183 | #-lispworks |
---|
184 | #c(0.0 6.697434e-4) |
---|
185 | #+lispworks |
---|
186 | #c(0.0 6.697433986236818e-4)) |
---|
187 | |
---|
188 | #+(or abcl cmu lispworks sbcl) |
---|
189 | (deftest sqrt.13 |
---|
190 | (float-sign (sqrt -0.0)) |
---|
191 | -1.0) |
---|
192 | |
---|
193 | #+(or abcl cmu lispworks sbcl) |
---|
194 | (deftest sqrt.14 |
---|
195 | (float-sign (sqrt -0.0d0)) |
---|
196 | -1.0d0) |
---|
197 | |
---|
198 | ;; EXP |
---|
199 | (deftest exp.1 |
---|
200 | (exp #c(0 0)) |
---|
201 | #+(or abcl allegro cmu lispworks sbcl) 1.0 |
---|
202 | #+clisp 1) |
---|
203 | |
---|
204 | (deftest exp.2 |
---|
205 | (exp #c(0 1)) |
---|
206 | #-lispworks #c(0.5403023 0.84147096) |
---|
207 | #+lispworks #c(0.5403023058681398 0.8414709848078965)) |
---|
208 | |
---|
209 | (deftest exp.3 |
---|
210 | (exp #c(1 1)) |
---|
211 | #+(or abcl cmu sbcl) #c(1.4686939 2.2873552) |
---|
212 | #+(or allegro clisp) #c(1.468694 2.2873552) |
---|
213 | #+lispworks #c(1.4686939399158851 2.2873552871788423)) |
---|
214 | |
---|
215 | (deftest exp.4 |
---|
216 | (exp #c(1 1d0)) |
---|
217 | #c(1.4686939399158851d0 2.2873552871788423d0)) |
---|
218 | |
---|
219 | (deftest exp.5 |
---|
220 | (exp #c(1d0 1d0)) |
---|
221 | #c(1.4686939399158851d0 2.2873552871788423d0)) |
---|
222 | |
---|
223 | (deftest exp.6 |
---|
224 | (exp #c(0 1d0)) |
---|
225 | #c(0.5403023058681398d0 0.8414709848078965d0)) |
---|
226 | |
---|
227 | (deftest exp.7 |
---|
228 | (exp 1) |
---|
229 | #-lispworks 2.7182817 |
---|
230 | #+lispworks 2.718281828459045) |
---|
231 | |
---|
232 | (deftest exp.8 |
---|
233 | (exp 1f0) |
---|
234 | #-lispworks 2.7182817 |
---|
235 | #+lispworks 2.718281828459045) |
---|
236 | |
---|
237 | (deftest exp.9 |
---|
238 | (exp 1d0) |
---|
239 | 2.718281828459045d0) |
---|
240 | |
---|
241 | ;; EXPT |
---|
242 | (deftest expt.1 |
---|
243 | (expt -5.0f0 2) |
---|
244 | 25.0) |
---|
245 | |
---|
246 | (deftest expt.2 |
---|
247 | (expt -5.0f0 1.9f0) |
---|
248 | #c(20.241808 -6.576964)) |
---|
249 | |
---|
250 | (deftest expt.3 |
---|
251 | (expt -5.0f0 2.0f0) |
---|
252 | #+(or abcl cmu sbcl) 25f0 |
---|
253 | #+allegro #c(25.0 -6.1230318e-15) |
---|
254 | #+clisp #c(25f0 0f0) |
---|
255 | #+lispworks #c(24.999999999999993 -6.123031769111885e-15)) |
---|
256 | |
---|
257 | (deftest expt.4 |
---|
258 | (expt -5.0f0 2.1f0) |
---|
259 | #c(27.928223 9.074421)) |
---|
260 | |
---|
261 | (deftest expt.5 |
---|
262 | (expt -5.0d0 1.9d0) |
---|
263 | #+(or abcl allegro) #c(20.24180952239008d0 -6.576962601219341d0) |
---|
264 | #+clisp #c(20.241809522390078d0 -6.576962601219342d0) |
---|
265 | #+(or cmu sbcl) #c(20.241809522390078d0 -6.57696260121934d0)) |
---|
266 | |
---|
267 | (deftest expt.6 |
---|
268 | (expt -5.0d0 2.0d0) |
---|
269 | #+(or abcl cmu sbcl) 25d0 |
---|
270 | #+allegro #c(24.999999999999996d0 -6.1230317691118855d-15) |
---|
271 | #+clisp #c(25d0 0d0)) |
---|
272 | |
---|
273 | (deftest expt.7 |
---|
274 | (expt -5.0d0 2.1d0) |
---|
275 | #+allegro #c(27.92822499968966d0 9.074430383223417d0) |
---|
276 | #+clisp #c(27.928224999689668d0 9.074430383223435d0) |
---|
277 | #-(or allegro clisp) #c(27.92822499968967d0 9.07443038322342d0)) |
---|
278 | |
---|
279 | (deftest expt.8 |
---|
280 | (expt -5 2) |
---|
281 | 25) |
---|
282 | |
---|
283 | (deftest expt.9 |
---|
284 | (eql (expt 5f0 3f0) (* 5.0 5.0 5.0)) |
---|
285 | t) |
---|
286 | |
---|
287 | (deftest expt.10 |
---|
288 | (expt 5f0 3f0) |
---|
289 | 125f0) |
---|
290 | |
---|
291 | (deftest expt.11 |
---|
292 | (expt 5d0 3d0) |
---|
293 | 125d0) |
---|
294 | |
---|
295 | (deftest expt.12 |
---|
296 | (expt 5 3) |
---|
297 | 125) |
---|
298 | |
---|
299 | (deftest expt.13 |
---|
300 | (expt #c(10 11) 1) |
---|
301 | #c(10 11)) |
---|
302 | |
---|
303 | (deftest expt.14 |
---|
304 | (expt 0 1/2) |
---|
305 | #+(or abcl allegro clisp lispworks) 0 |
---|
306 | #+(or cmu sbcl) 0.0) |
---|
307 | |
---|
308 | (deftest expt.15 |
---|
309 | (expt 1 1/2) |
---|
310 | #+(or clisp abcl) 1 |
---|
311 | #-(or clisp abcl) 1.0) |
---|
312 | |
---|
313 | (deftest expt.16 |
---|
314 | (expt 9 1/2) |
---|
315 | #+clisp 3 |
---|
316 | #-clisp 3.0) |
---|
317 | |
---|
318 | (deftest expt.17 |
---|
319 | (expt -9 1/2) |
---|
320 | #+clisp #c(0 3) |
---|
321 | #+(or allegro sbcl cmu) #c(1.8369095e-16 3.0) |
---|
322 | #+abcl #c(1.8369701e-16 3.0)) |
---|
323 | |
---|
324 | (deftest expt.18 |
---|
325 | (expt -8 1/3) |
---|
326 | #c(1.0 1.7320508)) |
---|
327 | |
---|
328 | (deftest expt.19 |
---|
329 | (expt #c(-7 24) 1/2) |
---|
330 | #+clisp #c(3 4) |
---|
331 | #-clisp #c(3.0 4.0)) |
---|
332 | |
---|
333 | (deftest expt.20 |
---|
334 | (expt 729 1/6) |
---|
335 | #+clisp 3 |
---|
336 | #-clisp 3.0) |
---|
337 | |
---|
338 | (deftest expt.21 |
---|
339 | (expt -3 -1) |
---|
340 | -1/3) |
---|
341 | |
---|
342 | (deftest expt.22 |
---|
343 | (expt #c(3 4) -1) |
---|
344 | #c(3/25 -4/25)) |
---|
345 | |
---|
346 | (deftest expt.23 |
---|
347 | (expt 14 #c(1.0 1.0)) |
---|
348 | #-(or clisp allegro) #c(-12.269101 6.743085) |
---|
349 | #+(or clisp allegro) #c(-12.269099 6.7430854)) |
---|
350 | |
---|
351 | (deftest expt.24 |
---|
352 | (expt 0.0 4) |
---|
353 | 0.0) |
---|
354 | |
---|
355 | (deftest expt.25 |
---|
356 | (expt #c(0 0.0) 4) |
---|
357 | #c(0.0 0.0)) |
---|
358 | |
---|
359 | (deftest expt.26 |
---|
360 | (expt #c(0 0.0) 4.0) |
---|
361 | #c(0.0 0.0)) |
---|
362 | |
---|
363 | (deftest log.1 |
---|
364 | (typep (log 17d0 10) 'double-float) |
---|
365 | t) |
---|
366 | |
---|
367 | (deftest log.2 |
---|
368 | (typep (log 17 10d0) 'double-float) |
---|
369 | t) |
---|
370 | |
---|
371 | (deftest log.3 |
---|
372 | (log 17 10) |
---|
373 | #+(and abcl java-1.4) 1.2304488 |
---|
374 | #+(and abcl (or java-1.5 java-1.6)) 1.230449 |
---|
375 | #+(or allegro clisp cmu sbcl) 1.230449 |
---|
376 | #+lispworks #.(log 17d0 10d0)) |
---|
377 | |
---|
378 | (deftest log.4 |
---|
379 | (log 17.0 10.0) |
---|
380 | #+(and abcl java-1.4) 1.2304488 |
---|
381 | #+(and abcl (or java-1.5 java-1.6)) 1.230449 |
---|
382 | #+(or cmu sbcl) 1.2304488 |
---|
383 | #+(or allegro clisp) 1.230449 |
---|
384 | #+lispworks #.(log 17d0 10d0)) |
---|
385 | |
---|
386 | (deftest log.5 |
---|
387 | (log 17d0 10) |
---|
388 | #+(and abcl java-1.4) 1.2304489042913307d0 |
---|
389 | #+(and abcl (or java-1.5 java-1.6)) #.(log 17d0 10d0) |
---|
390 | #+(or allegro clisp lispworks) #.(log 17d0 10d0) |
---|
391 | #-(or abcl allegro clisp lispworks) 1.2304489042913307d0) |
---|
392 | |
---|
393 | (deftest log.6 |
---|
394 | (log 17 10d0) |
---|
395 | #+(and abcl java-1.4) 1.2304489149763256d0 |
---|
396 | #+(and abcl (or java-1.5 java-1.6)) #.(log 17d0 10d0) |
---|
397 | #+(or allegro clisp lispworks) #.(log 17d0 10d0) |
---|
398 | #-(or abcl allegro clisp lispworks) 1.2304489149763256d0) |
---|
399 | |
---|
400 | (deftest log.7 |
---|
401 | (log 17d0 10d0) |
---|
402 | 1.2304489213782739d0) |
---|
403 | |
---|
404 | (deftest pi.1 |
---|
405 | pi |
---|
406 | #+clisp 3.1415926535897932385l0 |
---|
407 | #-clisp 3.141592653589793d0) |
---|
408 | |
---|
409 | (deftest tan.1 |
---|
410 | (tan 1) |
---|
411 | #+lispworks 1.5574077246549023 |
---|
412 | #-lispworks 1.5574077) |
---|
413 | |
---|
414 | (deftest tan.2 |
---|
415 | (tan (- (/ pi 2) 0.0001)) |
---|
416 | #+(or abcl allegro cmu sbcl) 10000.0002192818d0 |
---|
417 | #+clisp 10000.000219287924741l0 |
---|
418 | #+lispworks 9999.999966661644) |
---|
419 | |
---|
420 | (deftest tan.3 |
---|
421 | (tan (/ pi 2)) |
---|
422 | #+abcl 1.633123935319537d16 |
---|
423 | #+(or allegro cmu lispworks sbcl) 1.6331778728383844d16 |
---|
424 | #+clisp -3.9867976290042641156l19) |
---|
425 | |
---|
426 | (deftest tan.4 |
---|
427 | (tan (+ (/ pi 2) 0.0001)) |
---|
428 | #+(or abcl allegro cmu sbcl) -10000.000219294045d0 |
---|
429 | #+clisp -10000.000219287919724l0 |
---|
430 | #+lispworks -9999.999966673891d0) |
---|
431 | |
---|
432 | (deftest atanh.1 |
---|
433 | (atanh 2) |
---|
434 | #C(0.54930615 -1.5707964)) |
---|
435 | |
---|
436 | (deftest atanh.2 |
---|
437 | (atanh -2) |
---|
438 | #C(-0.54930615 1.5707964)) |
---|
439 | |
---|
440 | (deftest truncate.1 |
---|
441 | (truncate least-positive-single-float) |
---|
442 | 0 #.least-positive-single-float) |
---|
443 | |
---|
444 | (deftest truncate.2 |
---|
445 | (truncate least-positive-double-float) |
---|
446 | 0 #.least-positive-double-float) |
---|
447 | |
---|
448 | (deftest truncate.3 |
---|
449 | (signals-error (truncate least-positive-single-float 2) 'floating-point-underflow) |
---|
450 | t) |
---|
451 | |
---|
452 | (deftest truncate.4 |
---|
453 | (signals-error (truncate least-positive-double-float 2) 'floating-point-underflow) |
---|
454 | t) |
---|
455 | |
---|
456 | (deftest math.read-from-string.1 |
---|
457 | #+(or cmu sbcl) |
---|
458 | (unwind-protect |
---|
459 | (signals-error (read-from-string "1.0f-1000") 'reader-error) |
---|
460 | (progn |
---|
461 | (ignore-errors (set-floating-point-modes :traps '(:underflow))) |
---|
462 | (restore-default-floating-point-modes))) |
---|
463 | #-(or cmu sbcl) |
---|
464 | (signals-error (read-from-string "1.0f-1000") 'reader-error) |
---|
465 | t) |
---|
466 | |
---|
467 | ;;; Test for http://trac.common-lisp.net/armedbear/ticket/142 |
---|
468 | (define-compiler-test math.logand.1 |
---|
469 | (lambda (switchp) |
---|
470 | (logand |
---|
471 | (if switchp |
---|
472 | nil |
---|
473 | 2) |
---|
474 | 1)) |
---|
475 | :args (nil) |
---|
476 | :results 0) |
---|
477 | |
---|
478 | |
---|
479 | |
---|