1 ;;; floatfns-tests.el --- tests for floating point operations
3 ;; Copyright 2017-2018 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software: you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
22 (ert-deftest divide-extreme-sign
()
23 (should (= (ceiling most-negative-fixnum -
1.0) (- most-negative-fixnum
)))
24 (should (= (floor most-negative-fixnum -
1.0) (- most-negative-fixnum
)))
25 (should (= (round most-negative-fixnum -
1.0) (- most-negative-fixnum
)))
26 (should (= (truncate most-negative-fixnum -
1.0) (- most-negative-fixnum
))))
28 (ert-deftest logb-extreme-fixnum
()
29 (should (= (logb most-negative-fixnum
) (1+ (logb most-positive-fixnum
)))))
31 (ert-deftest fround-fixnum
()
32 (should-error (ffloor 0) :type
'wrong-type-argument
)
33 (should-error (fceiling 0) :type
'wrong-type-argument
)
34 (should-error (ftruncate 0) :type
'wrong-type-argument
)
35 (should-error (fround 0) :type
'wrong-type-argument
))
37 (ert-deftest bignum-to-float
()
38 ;; 122 because we want to go as big as possible to provoke a rounding error,
39 ;; but not too big: 2**122 < 10**37 < 2**123, and the C standard says
40 ;; 10**37 <= DBL_MAX so 2**122 cannot overflow as a double.
41 (let ((a (1- (ash 1 122))))
42 (should (or (eql a
(1- (floor (float a
))))
43 (eql a
(floor (float a
))))))
44 (should (eql (float (+ most-positive-fixnum
1))
45 (+ (float most-positive-fixnum
) 1))))
47 (ert-deftest bignum-abs
()
48 (should (= most-positive-fixnum
49 (- (abs most-negative-fixnum
) 1))))
51 (ert-deftest bignum-expt
()
52 (dolist (n (list most-positive-fixnum
(1+ most-positive-fixnum
)
53 most-negative-fixnum
(1- most-negative-fixnum
)
55 (should (= (expt n
0) 1))
56 (should (= (expt n
1) n
))
57 (should (= (expt n
2) (* n n
)))
58 (should (= (expt n
3) (* n n n
)))))
60 (ert-deftest bignum-logb
()
61 (should (= (+ (logb most-positive-fixnum
) 1)
62 (logb (+ most-positive-fixnum
1)))))
64 (ert-deftest bignum-mod
()
65 (should (= 0 (mod (1+ most-positive-fixnum
) 2.0))))
67 (ert-deftest bignum-round
()
68 (let ((ns (list (* most-positive-fixnum most-negative-fixnum
)
69 (1- most-negative-fixnum
) most-negative-fixnum
70 (1+ most-negative-fixnum
) -
2 1 1 2
71 (1- most-positive-fixnum
) most-positive-fixnum
72 (1+ most-positive-fixnum
)
73 (* most-positive-fixnum most-positive-fixnum
))))
75 (should (= n
(ceiling n
)))
76 (should (= n
(floor n
)))
77 (should (= n
(round n
)))
78 (should (= n
(truncate n
)))
82 (should (= 1 (round n f
) (round -n -f
) (round f n
) (round -f -n
)))
83 (should (= -
1 (round -n f
) (round n -f
) (round f -n
) (round -f n
))))
87 (same-sign (eq (< n
0) (< d
0))))
88 (should (= (ceiling n d
)
89 (+ q
(if (and same-sign
(not (zerop r
))) 1 0))))
90 (should (= (floor n d
)
91 (- q
(if (and (not same-sign
) (not (zerop r
))) 1 0))))
92 (should (= (truncate n d
) q
))
93 (let ((cdelta (abs (- n
(* d
(ceiling n d
)))))
94 (fdelta (abs (- n
(* d
(floor n d
)))))
95 (rdelta (abs (- n
(* d
(round n d
))))))
96 (should (<= rdelta cdelta
))
97 (should (<= rdelta fdelta
))
99 (= 0 cdelta fdelta rdelta
)
100 (or (/= cdelta fdelta
)
101 (zerop (%
(round n d
) 2)))))))))))
103 (ert-deftest special-round
()
104 (let ((ns '(-1e+INF
1e
+INF -
1 1 -
1e
+NaN
1e
+NaN
)))
106 (unless (<= (abs n
) 1)
107 (should-error (ceiling n
))
108 (should-error (floor n
))
109 (should-error (round n
))
110 (should-error (truncate n
)))
112 (unless (<= (abs (/ n d
)) 1)
113 (should-error (ceiling n d
))
114 (should-error (floor n d
))
115 (should-error (round n d
))
116 (should-error (truncate n d
)))))))
118 (ert-deftest big-round
()
119 (should (= (floor 54043195528445955 3)
120 (floor 54043195528445955 3.0))))
122 (provide 'floatfns-tests
)