1.0.23.21: Stack allocated conses for MIPS.
[sbcl.git] / tests / arith.pure.lisp
1 ;;;; arithmetic tests with no side effects
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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
8 ;;;; from CMU CL.
9 ;;;;
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.
13
14 (cl:in-package :cl-user)
15
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)
21              `(progn
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)
25                         ,res1))
26                (assert (= (funcall (compile nil '(lambda (x y) (,op x y))) 2 4)
27                         ,res2)))))
28   (test + 6 6)
29   (test - 2 -2)
30   (test * 8 8)
31   (test / 2 1/2)
32   (test expt 16 16))
33
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))
39
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)))
46
47 ;;; (COERCE #c(<RATIONAL> <RATIONAL>) '(complex float)) resulted in
48 ;;; an error up to 0.8.17.31
49 (assert (= (coerce #c(1 2) '(complex float)) #c(1.0 2.0)))
50
51 ;;; COERCE also sometimes failed to verify that a particular coercion
52 ;;; was possible (in particular coercing rationals to bounded float
53 ;;; types.
54 (assert (raises-error? (coerce 1 '(float 2.0 3.0)) type-error))
55 (assert (raises-error? (coerce 1 '(single-float -1.0 0.0)) type-error))
56 (assert (eql (coerce 1 '(single-float -1.0 2.0)) 1.0))
57
58 ;;; ANSI says MIN and MAX should signal TYPE-ERROR if any argument
59 ;;; isn't REAL. SBCL 0.7.7 didn't in the 1-arg case. (reported as a
60 ;;; bug in CMU CL on #lisp IRC by lrasinen 2002-09-01)
61 (assert (null (ignore-errors (min '(1 2 3)))))
62 (assert (= (min -1) -1))
63 (assert (null (ignore-errors (min 1 #(1 2 3)))))
64 (assert (= (min 10 11) 10))
65 (assert (null (ignore-errors (min (find-package "CL") -5.0))))
66 (assert (= (min 5.0 -3) -3))
67 (assert (null (ignore-errors (max #c(4 3)))))
68 (assert (= (max 0) 0))
69 (assert (null (ignore-errors (max "MIX" 3))))
70 (assert (= (max -1 10.0) 10.0))
71 (assert (null (ignore-errors (max 3 #'max))))
72 (assert (= (max -3 0) 0))
73
74 ;;; (CEILING x 2^k) was optimized incorrectly
75 (loop for divisor in '(-4 4)
76       for ceiler = (compile nil `(lambda (x)
77                                    (declare (fixnum x))
78                                    (declare (optimize (speed 3)))
79                                    (ceiling x ,divisor)))
80       do (loop for i from -5 to 5
81                for exact-q = (/ i divisor)
82                do (multiple-value-bind (q r)
83                       (funcall ceiler i)
84                     (assert (= (+ (* q divisor) r) i))
85                     (assert (<= exact-q q))
86                     (assert (< q (1+ exact-q))))))
87
88 ;;; (TRUNCATE x 2^k) was optimized incorrectly
89 (loop for divisor in '(-4 4)
90       for truncater = (compile nil `(lambda (x)
91                                       (declare (fixnum x))
92                                       (declare (optimize (speed 3)))
93                                       (truncate x ,divisor)))
94       do (loop for i from -9 to 9
95                for exact-q = (/ i divisor)
96                do (multiple-value-bind (q r)
97                       (funcall truncater i)
98                     (assert (= (+ (* q divisor) r) i))
99                     (assert (<= (abs q) (abs exact-q)))
100                     (assert (< (abs exact-q) (1+ (abs q)))))))
101
102 ;;; CEILING had a corner case, spotted by Paul Dietz
103 (assert (= (ceiling most-negative-fixnum (1+ most-positive-fixnum)) -1))
104
105 ;;; give any optimizers of constant multiplication a light testing.
106 ;;; 100 may seem low, but (a) it caught CSR's initial errors, and (b)
107 ;;; before checking in, CSR tested with 10000.  So one hundred
108 ;;; checkins later, we'll have doubled the coverage.
109 (dotimes (i 100)
110   (let* ((x (random most-positive-fixnum))
111          (x2 (* x 2))
112          (x3 (* x 3)))
113     (let ((fn (handler-bind ((sb-ext:compiler-note
114                               (lambda (c)
115                                 (when (<= x3 most-positive-fixnum)
116                                   (error c)))))
117                 (compile nil
118                          `(lambda (y)
119                             (declare (optimize speed) (type (integer 0 3) y))
120                             (* y ,x))))))
121       (unless (and (= (funcall fn 0) 0)
122                    (= (funcall fn 1) x)
123                    (= (funcall fn 2) x2)
124                    (= (funcall fn 3) x3))
125         (error "bad results for ~D" x)))))
126
127 ;;; Bugs reported by Paul Dietz:
128
129 ;;; (GCD 0 x) must return (abs x)
130 (dolist (x (list -10 (* 3 most-negative-fixnum)))
131   (assert (= (gcd 0 x) (abs x))))
132 ;;; LCM returns a non-negative number
133 (assert (= (lcm 4 -10) 20))
134 (assert (= (lcm 0 0) 0))
135
136 ;;; PPC bignum arithmetic bug:
137 (multiple-value-bind (quo rem)
138     (truncate 291351647815394962053040658028983955 10000000000000000000000000)
139   (assert (= quo 29135164781))
140   (assert (= rem 5394962053040658028983955)))
141
142 ;;; x86 LEA bug:
143 (assert (= (funcall
144             (compile nil '(lambda (x) (declare (bit x)) (+ x #xf0000000)))
145             1)
146            #xf0000001))
147
148 ;;; LOGBITP on bignums:
149 (dolist (x '(((1+ most-positive-fixnum) 1 nil)
150              ((1+ most-positive-fixnum) -1 t)
151              ((1+ most-positive-fixnum) (1+ most-positive-fixnum) nil)
152              ((1+ most-positive-fixnum) (1- most-negative-fixnum) t)
153              (1 (ash most-negative-fixnum 1) nil)
154              (#.(- sb-vm:n-word-bits sb-vm:n-lowtag-bits) most-negative-fixnum t)
155              (#.(1+ (- sb-vm:n-word-bits sb-vm:n-lowtag-bits)) (ash most-negative-fixnum 1) t)
156              (#.(+ 2 (- sb-vm:n-word-bits sb-vm:n-lowtag-bits)) (ash most-negative-fixnum 1) t)
157              (#.(+ sb-vm:n-word-bits 32) (ash most-negative-fixnum #.(+ 32 sb-vm:n-lowtag-bits 1)) nil)
158              (#.(+ sb-vm:n-word-bits 33) (ash most-negative-fixnum #.(+ 32 sb-vm:n-lowtag-bits 1)) t)))
159   (destructuring-bind (index int result) x
160     (assert (eq (eval `(logbitp ,index ,int)) result))))
161
162 ;;; off-by-1 type inference error for %DPB and %DEPOSIT-FIELD:
163 (let ((f (compile nil '(lambda (b)
164                         (integer-length (dpb b (byte 4 28) -1005))))))
165   (assert (= (funcall f 1230070) 32)))
166 (let ((f (compile nil '(lambda (b)
167                         (integer-length (deposit-field b (byte 4 28) -1005))))))
168   (assert (= (funcall f 1230070) 32)))
169
170 ;;; type inference leading to an internal compiler error:
171 (let ((f (compile nil '(lambda (x)
172                         (declare (type fixnum x))
173                         (ldb (byte 0 0) x)))))
174   (assert (= (funcall f 1) 0))
175   (assert (= (funcall f most-positive-fixnum) 0))
176   (assert (= (funcall f -1) 0)))
177
178 ;;; Alpha bignum arithmetic bug:
179 (assert (= (* 966082078641 419216044685) 404997107848943140073085))
180
181 ;;; Alpha smallnum arithmetic bug:
182 (assert (= (ash -129876 -1026) -1))
183
184 ;;; Alpha middlenum (yes, really! Affecting numbers between 2^32 and
185 ;;; 2^64 :) arithmetic bug
186 (let ((fn (compile nil '(LAMBDA (A B C D)
187           (DECLARE (TYPE (INTEGER -1621 -513) A)
188                    (TYPE (INTEGER -3 34163) B)
189                    (TYPE (INTEGER -9485132993 81272960) C)
190                    (TYPE (INTEGER -255340814 519943) D)
191                    (IGNORABLE A B C D)
192                    (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
193           (TRUNCATE C (MIN -100 4149605))))))
194   (assert (= (funcall fn -1332 5864 -6963328729 -43789079) 69633287)))
195
196 ;;; Here's another fantastic Alpha backend bug: the code to load
197 ;;; immediate 64-bit constants into a register was wrong.
198 (let ((fn (compile nil '(LAMBDA (A B C D)
199           (DECLARE (TYPE (INTEGER -3563 2733564) A)
200                    (TYPE (INTEGER -548947 7159) B)
201                    (TYPE (INTEGER -19 0) C)
202                    (TYPE (INTEGER -2546009 0) D)
203                    (IGNORABLE A B C D)
204                    (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
205           (CASE A
206             ((89 125 16) (ASH A (MIN 18 -706)))
207             (T (DPB -3 (BYTE 30 30) -1)))))))
208   (assert (= (funcall fn 1227072 -529823 -18 -792831) -2147483649)))
209
210 ;;; ASH of a negative bignum by a bignum count would erroneously
211 ;;; return 0 prior to sbcl-0.8.4.4
212 (assert (= (ash (1- most-negative-fixnum) (1- most-negative-fixnum)) -1))
213
214 ;;; Whoops.  Too much optimization in division operators for 0
215 ;;; divisor.
216 (macrolet ((frob (name)
217              `(let ((fn (compile nil '(lambda (x)
218                                        (declare (optimize speed) (fixnum x))
219                                        (,name x 0)))))
220                (assert (raises-error? (funcall fn 1) division-by-zero)))))
221   (frob mod)
222   (frob truncate)
223   (frob rem)
224   (frob /)
225   (frob floor)
226   (frob ceiling))
227
228 ;; Check that the logic in SB-KERNEL::BASIC-COMPARE for doing fixnum/float
229 ;; comparisons without rationalizing the floats still gives the right anwers
230 ;; in the edge cases (had a fencepost error).
231 (macrolet ((test (range type sign)
232              `(let (ints
233                     floats
234                     (start (- ,(find-symbol (format nil
235                                                     "MOST-~A-EXACTLY-~A-FIXNUM"
236                                                     sign type)
237                                             :sb-kernel)
238                               ,range)))
239                 (dotimes (i (1+ (* ,range 2)))
240                   (let* ((x (+ start i))
241                          (y (coerce x ',type)))
242                     (push x ints)
243                     (push y floats)))
244                 (dolist (i ints)
245                   (dolist (f floats)
246                     (dolist (op '(< <= = >= >))
247                       (unless (eq (funcall op i f)
248                                   (funcall op i (rationalize f)))
249                         (error "(not (eq (~a ~a ~f) (~a ~a ~a)))~%"
250                                op i f
251                                op i (rationalize f)))
252                       (unless (eq (funcall op f i)
253                                   (funcall op (rationalize f) i))
254                         (error "(not (eq (~a ~f ~a) (~a ~a ~a)))~%"
255                                op f i
256                                op (rationalize f) i))))))))
257   (test 32 double-float negative)
258   (test 32 double-float positive)
259   (test 32 single-float negative)
260   (test 32 single-float positive))
261
262 ;; x86-64 sign-extension bug found using pfdietz's random tester.
263 (assert (= 286142502
264            (funcall (lambda ()
265                       (declare (notinline logxor))
266                       (min (logxor 0 0 0 286142502))))))
267
268 ;; Small bugs in LOGCOUNT can still allow SBCL to be built and thus go
269 ;; unnoticed, so check more thoroughly here.
270 (with-test (:name :logcount)
271   (flet ((test (x n)
272            (unless (= (logcount x) n)
273              (error "logcount failure for ~a" x))))
274     ;; Test with some patterns with well known number of ones/zeroes ...
275     (dotimes (i 128)
276       (let ((x (ash 1 i)))
277         (test x 1)
278         (test (- x) i)
279         (test (1- x) i)))
280     ;; ... and with some random integers of varying length.
281     (flet ((test-logcount (x)
282              (declare (type integer x))
283              (do ((result 0 (1+ result))
284                   (x (if (minusp x)
285                          (lognot x)
286                          x)
287                      (logand x (1- x))))
288                  ((zerop x) result))))
289       (dotimes (i 200)
290         (let ((x (random (ash 1 i))))
291           (test x (test-logcount x))
292           (test (- x) (test-logcount (- x))))))))
293
294 ;; 1.0 had a broken ATANH on win32
295 (with-test (:name :atanh)
296   (assert (= (atanh 0.9d0) 1.4722194895832204d0)))
297