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 ;;; (TRUNCATE x 2^k) was optimized incorrectly
85 (loop for divisor in
'(-4 4)
86 for truncater
= (compile nil
`(lambda (x)
88 (declare (optimize (speed 3)))
89 (truncate x
,divisor
)))
90 do
(loop for i from -
9 to
9
91 for exact-q
= (/ i divisor
)
92 do
(multiple-value-bind (q r
)
94 (assert (= (+ (* q divisor
) r
) i
))
95 (assert (<= (abs q
) (abs exact-q
)))
96 (assert (< (abs exact-q
) (1+ (abs q
)))))))
98 ;;; CEILING had a corner case, spotted by Paul Dietz
99 (assert (= (ceiling most-negative-fixnum
(1+ most-positive-fixnum
)) -
1))
101 ;;; give any optimizers of constant multiplication a light testing.
102 ;;; 100 may seem low, but (a) it caught CSR's initial errors, and (b)
103 ;;; before checking in, CSR tested with 10000. So one hundred
104 ;;; checkins later, we'll have doubled the coverage.
106 (let* ((x (random most-positive-fixnum
))
109 (let ((fn (handler-bind ((sb-ext:compiler-note
111 (when (<= x3 most-positive-fixnum
)
115 (declare (optimize speed
) (type (integer 0 3) y
))
117 (unless (and (= (funcall fn
0) 0)
119 (= (funcall fn
2) x2
)
120 (= (funcall fn
3) x3
))
121 (error "bad results for ~D" x
)))))
123 ;;; Bugs reported by Paul Dietz:
125 ;;; (GCD 0 x) must return (abs x)
126 (dolist (x (list -
10 (* 3 most-negative-fixnum
)))
127 (assert (= (gcd 0 x
) (abs x
))))
128 ;;; LCM returns a non-negative number
129 (assert (= (lcm 4 -
10) 20))
130 (assert (= (lcm 0 0) 0))
132 ;;; PPC bignum arithmetic bug:
133 (multiple-value-bind (quo rem
)
134 (truncate 291351647815394962053040658028983955 10000000000000000000000000)
135 (assert (= quo
29135164781))
136 (assert (= rem
5394962053040658028983955)))
140 (compile nil
'(lambda (x) (declare (bit x
)) (+ x
#xf0000000
)))
144 ;;; LOGBITP on bignums:
145 (dolist (x '(((1+ most-positive-fixnum
) 1 nil
)
146 ((1+ most-positive-fixnum
) -
1 t
)
147 ((1+ most-positive-fixnum
) (1+ most-positive-fixnum
) nil
)
148 ((1+ most-positive-fixnum
) (1- most-negative-fixnum
) t
)
149 (1 (ash most-negative-fixnum
1) nil
)
150 (29 most-negative-fixnum t
)
151 (30 (ash most-negative-fixnum
1) t
)
152 (31 (ash most-negative-fixnum
1) t
)
153 (64 (ash most-negative-fixnum
36) nil
)
154 (65 (ash most-negative-fixnum
36) t
)))
155 (destructuring-bind (index int result
) x
156 (assert (eq (eval `(logbitp ,index
,int
)) result
))))
158 ;;; off-by-1 type inference error for %DPB and %DEPOSIT-FIELD:
159 (let ((f (compile nil
'(lambda (b)
160 (integer-length (dpb b
(byte 4 28) -
1005))))))
161 (assert (= (funcall f
1230070) 32)))
162 (let ((f (compile nil
'(lambda (b)
163 (integer-length (deposit-field b
(byte 4 28) -
1005))))))
164 (assert (= (funcall f
1230070) 32)))
166 ;;; type inference leading to an internal compiler error:
167 (let ((f (compile nil
'(lambda (x)
168 (declare (type fixnum x
))
169 (ldb (byte 0 0) x
)))))
170 (assert (= (funcall f
1) 0))
171 (assert (= (funcall f most-positive-fixnum
) 0))
172 (assert (= (funcall f -
1) 0)))
174 ;;; Alpha bignum arithmetic bug:
175 (assert (= (* 966082078641 419216044685) 404997107848943140073085))
177 ;;; Alpha smallnum arithmetic bug:
178 (assert (= (ash -
129876 -
1026) -
1))
180 ;;; Alpha middlenum (yes, really! Affecting numbers between 2^32 and
181 ;;; 2^64 :) arithmetic bug
182 (let ((fn (compile nil
'(LAMBDA (A B C D
)
183 (DECLARE (TYPE (INTEGER -
1621 -
513) A
)
184 (TYPE (INTEGER -
3 34163) B
)
185 (TYPE (INTEGER -
9485132993 81272960) C
)
186 (TYPE (INTEGER -
255340814 519943) D
)
188 (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
189 (TRUNCATE C
(MIN -
100 4149605))))))
190 (assert (= (funcall fn -
1332 5864 -
6963328729 -
43789079) 69633287)))
192 ;;; Here's another fantastic Alpha backend bug: the code to load
193 ;;; immediate 64-bit constants into a register was wrong.
194 (let ((fn (compile nil
'(LAMBDA (A B C D
)
195 (DECLARE (TYPE (INTEGER -
3563 2733564) A
)
196 (TYPE (INTEGER -
548947 7159) B
)
197 (TYPE (INTEGER -
19 0) C
)
198 (TYPE (INTEGER -
2546009 0) D
)
200 (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
202 ((89 125 16) (ASH A
(MIN 18 -
706)))
203 (T (DPB -
3 (BYTE 30 30) -
1)))))))
204 (assert (= (funcall fn
1227072 -
529823 -
18 -
792831) -
2147483649)))
206 ;;; ASH of a negative bignum by a bignum count would erroneously
207 ;;; return 0 prior to sbcl-0.8.4.4
208 (assert (= (ash (1- most-negative-fixnum
) (1- most-negative-fixnum
)) -
1))