1 ;;;; arithmetic tests with no side effects
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
14 (cl:in-package
:cl-user
)
16 ;;; Once upon a time, in the process of porting CMUCL's SPARC backend
17 ;;; to SBCL, multiplications were excitingly broken. While it's
18 ;;; unlikely that anything with such fundamental arithmetic errors as
19 ;;; these are going to get this far, it's probably worth checking.
20 (macrolet ((test (op res1 res2
)
22 (assert (= (,op
4 2) ,res1
))
23 (assert (= (,op
2 4) ,res2
))
24 (assert (= (funcall (compile nil
(lambda (x y
) (,op x y
))) 4 2)
26 (assert (= (funcall (compile nil
(lambda (x y
) (,op x y
))) 2 4)
34 ;;; In a bug reported by Wolfhard Buss on cmucl-imp 2002-06-18 (BUG
35 ;;; 184), sbcl didn't catch all divisions by zero, notably divisions
36 ;;; of bignums and ratios by 0. Fixed in sbcl-0.7.6.13.
37 (assert (raises-error?
(/ 2/3 0) division-by-zero
))
38 (assert (raises-error?
(/ (1+ most-positive-fixnum
) 0) division-by-zero
))
40 ;;; In a bug reported by Raymond Toy on cmucl-imp 2002-07-18, (COERCE
41 ;;; <RATIONAL> '(COMPLEX FLOAT)) was failing to return a complex
42 ;;; float; a patch was given by Wolfhard Buss cmucl-imp 2002-07-19.
43 (assert (= (coerce 1 '(complex float
)) #c
(1.0
0.0)))
44 (assert (= (coerce 1/2 '(complex float
)) #c
(0.5
0.0)))
45 (assert (= (coerce 1.0d0
'(complex float
)) #c
(1.0d0
0.0d0
)))
47 ;;; COERCE also sometimes failed to verify that a particular coercion
48 ;;; was possible (in particular coercing rationals to bounded float
50 (assert (raises-error?
(coerce 1 '(float 2.0 3.0)) type-error
))
51 (assert (raises-error?
(coerce 1 '(single-float -
1.0 0.0)) type-error
))
52 (assert (eql (coerce 1 '(single-float -
1.0 2.0)) 1.0))
54 ;;; ANSI says MIN and MAX should signal TYPE-ERROR if any argument
55 ;;; isn't REAL. SBCL 0.7.7 didn't in the 1-arg case. (reported as a
56 ;;; bug in CMU CL on #lisp IRC by lrasinen 2002-09-01)
57 (assert (null (ignore-errors (min '(1 2 3)))))
58 (assert (= (min -
1) -
1))
59 (assert (null (ignore-errors (min 1 #(1 2 3)))))
60 (assert (= (min 10 11) 10))
61 (assert (null (ignore-errors (min (find-package "CL") -
5.0))))
62 (assert (= (min 5.0 -
3) -
3))
63 (assert (null (ignore-errors (max #c
(4 3)))))
64 (assert (= (max 0) 0))
65 (assert (null (ignore-errors (max "MIX" 3))))
66 (assert (= (max -
1 10.0) 10.0))
67 (assert (null (ignore-errors (max 3 #'max
))))
68 (assert (= (max -
3 0) 0))
70 ;;; (CEILING x 2^k) was optimized incorrectly
71 (loop for divisor in
'(-4 4)
72 for ceiler
= (compile nil
`(lambda (x)
74 (declare (optimize (speed 3)))
75 (ceiling x
,divisor
)))
76 do
(loop for i from -
5 to
5
77 for exact-q
= (/ i divisor
)
78 do
(multiple-value-bind (q r
)
80 (assert (= (+ (* q divisor
) r
) i
))
81 (assert (<= exact-q q
))
82 (assert (< q
(1+ exact-q
))))))
84 ;;; CEILING had a corner case, spotted by Paul Dietz
85 (assert (= (ceiling most-negative-fixnum
(1+ most-positive-fixnum
)) -
1))
87 ;;; give any optimizers of constant multiplication a light testing.
88 ;;; 100 may seem low, but (a) it caught CSR's initial errors, and (b)
89 ;;; before checking in, CSR tested with 10000. So one hundred
90 ;;; checkins later, we'll have doubled the coverage.
92 (let* ((x (random most-positive-fixnum
))
95 (let ((fn (handler-bind ((sb-ext:compiler-note
#'error
))
98 (declare (optimize speed
) (type (integer 0 3) y
))
100 (unless (and (= (funcall fn
0) 0)
102 (= (funcall fn
2) x2
)
103 (= (funcall fn
3) x3
))
104 (error "bad results for ~D" x
)))))
106 ;;; (GCD 0 x) must return (abs x)
107 (dolist (x (list -
10 (* 3 most-negative-fixnum
)))
108 (assert (= (gcd 0 x
) (abs x
))))