Commit | Line | Data |
---|---|---|
b01818d7 JG |
1 | ;;; arithmetic-flonums.test --- Test suite for R6RS (rnrs arithmetic flonums) |
2 | ||
1f4f2a12 | 3 | ;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc. |
b01818d7 JG |
4 | ;; |
5 | ;; This library is free software; you can redistribute it and/or | |
6 | ;; modify it under the terms of the GNU Lesser General Public | |
7 | ;; License as published by the Free Software Foundation; either | |
8 | ;; version 3 of the License, or (at your option) any later version. | |
9 | ;; | |
10 | ;; This library is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;; Lesser General Public License for more details. | |
14 | ;; | |
15 | ;; You should have received a copy of the GNU Lesser General Public | |
16 | ;; License along with this library; if not, write to the Free Software | |
17 | ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | \f | |
19 | ||
20 | (define-module (test-suite test-r6rs-arithmetic-flonums) | |
21 | :use-module ((rnrs arithmetic flonums) :version (6)) | |
22 | :use-module ((rnrs conditions) :version (6)) | |
23 | :use-module ((rnrs exceptions) :version (6)) | |
24 | :use-module (test-suite lib)) | |
25 | ||
26 | (define fake-pi 3.14159265) | |
27 | (define (reasonably-close? x y) (< (abs (- x y)) 0.0000001)) | |
28 | ||
29 | (with-test-prefix "flonum?" | |
30 | (pass-if "flonum? is #t on flonum" | |
31 | (flonum? 1.5)) | |
32 | ||
ff556838 MW |
33 | (pass-if "flonum? is #f on complex" |
34 | (not (flonum? 1.5+0.0i))) | |
35 | ||
36 | (pass-if "flonum? is #f on exact integer" | |
b01818d7 JG |
37 | (not (flonum? 3)))) |
38 | ||
39 | (with-test-prefix "real->flonum" | |
40 | (pass-if "simple" | |
41 | (flonum? (real->flonum 3)))) | |
42 | ||
43 | (with-test-prefix "fl=?" | |
44 | (pass-if "fl=? is #t for eqv inputs" | |
45 | (fl=? 3.0 3.0 3.0)) | |
46 | ||
47 | (pass-if "fl=? is #f for non-eqv inputs" | |
48 | (not (fl=? 1.5 0.0 3.0))) | |
49 | ||
50 | (pass-if "+inf.0 is fl= to itself" | |
51 | (fl=? +inf.0 +inf.0)) | |
52 | ||
53 | (pass-if "0.0 and -0.0 are fl=" | |
54 | (fl=? 0.0 -0.0))) | |
55 | ||
56 | (with-test-prefix "fl<?" | |
57 | (pass-if "fl<? is #t for monotonically < inputs" | |
58 | (fl<? 1.0 2.0 3.0)) | |
59 | ||
60 | (pass-if "fl<? is #f for non-monotonically < inputs" | |
61 | (not (fl<? 2.0 2.0 1.4)))) | |
62 | ||
63 | (with-test-prefix "fl<=?" | |
64 | (pass-if "fl<=? is #t for monotonically < or = inputs" | |
65 | (fl<=? 1.0 1.2 1.2)) | |
66 | ||
67 | (pass-if "fl<=? is #f non-monotonically < or = inputs" | |
68 | (not (fl<=? 2.0 1.0 0.9)))) | |
69 | ||
70 | (with-test-prefix "fl>?" | |
71 | (pass-if "fl>? is #t for monotonically > inputs" | |
72 | (fl>? 3.0 2.0 1.0)) | |
73 | ||
74 | (pass-if "fl>? is #f for non-monotonically > inputs" | |
75 | (not (fl>? 1.0 1.0 1.2)))) | |
76 | ||
77 | (with-test-prefix "fl>=?" | |
78 | (pass-if "fl>=? is #t for monotonically > or = inputs" | |
79 | (fl>=? 3.0 2.0 2.0)) | |
80 | ||
81 | (pass-if "fl>=? is #f for non-monotonically > or = inputs" | |
82 | (not (fl>=? 1.0 1.2 1.2)))) | |
83 | ||
84 | (with-test-prefix "flinteger?" | |
85 | (pass-if "flinteger? is #t on integer flomnums" | |
86 | (flinteger? 1.0)) | |
87 | ||
88 | (pass-if "flinteger? is #f on non-integer flonums" | |
89 | (not (flinteger? 1.5)))) | |
90 | ||
91 | (with-test-prefix "flzero?" | |
92 | (pass-if "flzero? is #t for 0.0 and -0.0" | |
93 | (and (flzero? 0.0) (flzero? -0.0))) | |
94 | ||
95 | (pass-if "flzero? is #f for non-zero flonums" | |
96 | (not (flzero? 1.0)))) | |
97 | ||
98 | (with-test-prefix "flpositive?" | |
99 | (pass-if "flpositive? is #t on positive flonum" | |
100 | (flpositive? 1.0)) | |
101 | ||
102 | (pass-if "flpositive? is #f on negative flonum" | |
103 | (not (flpositive? -1.0))) | |
104 | ||
105 | (pass-if "0.0 and -0.0 are not flpositive" | |
106 | (and (not (flpositive? 0.0)) (not (flpositive? -0.0))))) | |
107 | ||
108 | (with-test-prefix "flnegative?" | |
109 | (pass-if "flnegative? is #t on negative flonum" | |
110 | (flnegative? -1.0)) | |
111 | ||
112 | (pass-if "flnegative? is #f on positive flonum" | |
113 | (not (flnegative? 1.0))) | |
114 | ||
115 | (pass-if "0.0 and -0.0 are not flnegative" | |
116 | (and (not (flnegative? 0.0)) (not (flnegative? -0.0))))) | |
117 | ||
118 | (with-test-prefix "flodd?" | |
119 | (pass-if "&assertion raised on non-integer flonum" | |
120 | (guard (condition ((assertion-violation? condition) #t) (else #f)) | |
121 | (begin (flodd? 1.5) #f))) | |
122 | ||
123 | (pass-if "flodd? is #t on odd flonums" | |
124 | (flodd? 3.0)) | |
125 | ||
126 | (pass-if "flodd? is #f on even flonums" | |
127 | (not (flodd? 2.0)))) | |
128 | ||
129 | (with-test-prefix "fleven?" | |
130 | (pass-if "&assertion raised on non-integer flonum" | |
131 | (guard (condition ((assertion-violation? condition) #t) (else #f)) | |
132 | (begin (fleven? 1.5) #f))) | |
133 | ||
134 | (pass-if "fleven? is #t on even flonums" | |
135 | (fleven? 2.0)) | |
136 | ||
137 | (pass-if "fleven? is #f on odd flonums" | |
138 | (not (fleven? 3.0)))) | |
139 | ||
140 | (with-test-prefix "flfinite?" | |
141 | (pass-if "flfinite? is #t on non-infinite flonums" | |
142 | (flfinite? 2.0)) | |
143 | ||
144 | (pass-if "flfinite? is #f on infinities" | |
85b32d43 MW |
145 | (and (not (flfinite? +inf.0)) (not (flfinite? -inf.0)))) |
146 | ||
147 | (pass-if "flfinite? is #f on NaNs" | |
148 | (not (flfinite? +nan.0)))) | |
b01818d7 JG |
149 | |
150 | (with-test-prefix "flinfinite?" | |
151 | (pass-if "flinfinite? is #t on infinities" | |
152 | (and (flinfinite? +inf.0) (flinfinite? -inf.0))) | |
153 | ||
154 | (pass-if "flinfinite? is #f on non-infinite flonums" | |
155 | (not (flinfinite? 2.0)))) | |
156 | ||
157 | (with-test-prefix "flnan?" | |
158 | (pass-if "flnan? is #t on NaN and -NaN" | |
159 | (and (flnan? +nan.0) (flnan? -nan.0))) | |
160 | ||
161 | (pass-if "flnan? is #f on non-NaN values" | |
162 | (not (flnan? 1.5)))) | |
163 | ||
164 | (with-test-prefix "flmax" | |
165 | (pass-if "simple" (fl=? (flmax 1.0 3.0 2.0) 3.0))) | |
166 | ||
167 | (with-test-prefix "flmin" | |
168 | (pass-if "simple" (fl=? (flmin -1.0 0.0 2.0) -1.0))) | |
169 | ||
170 | (with-test-prefix "fl+" | |
62460767 MW |
171 | (pass-if "simple" (fl=? (fl+ 2.141 1.0 0.1) 3.241)) |
172 | (pass-if "zero args" (fl=? (fl+) 0.0))) | |
b01818d7 JG |
173 | |
174 | (with-test-prefix "fl*" | |
62460767 MW |
175 | (pass-if "simple" (fl=? (fl* 1.0 2.0 3.0 1.5) 9.0)) |
176 | (pass-if "zero args" (fl=? (fl*) 1.0))) | |
b01818d7 JG |
177 | |
178 | (with-test-prefix "fl-" | |
179 | (pass-if "unary fl- negates argument" (fl=? (fl- 2.0) -2.0)) | |
180 | ||
181 | (pass-if "simple" (fl=? (fl- 10.5 6.0 0.5) 4.0))) | |
182 | ||
183 | (with-test-prefix "fl/" | |
184 | (pass-if "unary fl/ returns multiplicative inverse" (fl=? (fl/ 10.0) 0.1)) | |
185 | ||
186 | (pass-if "simple" (fl=? (fl/ 10.0 2.0 2.0) 2.5))) | |
187 | ||
188 | (with-test-prefix "flabs" | |
189 | (pass-if "simple" (and (fl=? (flabs -1.0) 1.0) (fl=? (flabs 1.23) 1.23)))) | |
190 | ||
191 | (with-test-prefix "fldiv-and-mod" | |
192 | (pass-if "simple" | |
193 | (call-with-values (lambda () (fldiv-and-mod 5.0 2.0)) | |
194 | (lambda (div mod) (fl=? div 2.0) (fl=? mod 1.0))))) | |
195 | ||
196 | (with-test-prefix "fldiv" | |
197 | (pass-if "simple" (fl=? (fldiv 5.0 2.0) 2.0))) | |
198 | ||
199 | (with-test-prefix "flmod" | |
200 | (pass-if "simple" (fl=? (flmod 5.0 2.0) 1.0))) | |
201 | ||
202 | (with-test-prefix "fldiv0-and-mod0" | |
203 | (pass-if "simple" | |
204 | (call-with-values (lambda () (fldiv0-and-mod0 -123.0 10.0)) | |
205 | (lambda (div mod) | |
ff62c168 | 206 | (and (fl=? div -12.0) (fl=? mod -3.0)))))) |
b01818d7 JG |
207 | |
208 | (with-test-prefix "fldiv0" | |
ff62c168 | 209 | (pass-if "simple" (fl=? (fldiv0 -123.0 10.0) -12.0))) |
b01818d7 JG |
210 | |
211 | (with-test-prefix "flmod0" | |
ff62c168 | 212 | (pass-if "simple" (fl=? (flmod0 -123.0 10.0) -3.0))) |
b01818d7 JG |
213 | |
214 | (with-test-prefix "flnumerator" | |
215 | (pass-if "simple" (fl=? (flnumerator 0.5) 1.0)) | |
216 | ||
217 | (pass-if "infinities" | |
218 | (and (fl=? (flnumerator +inf.0) +inf.0) | |
219 | (fl=? (flnumerator -inf.0) -inf.0))) | |
220 | ||
fa102e73 | 221 | (pass-if "negative zero" (eqv? (flnumerator -0.0) -0.0))) |
b01818d7 JG |
222 | |
223 | (with-test-prefix "fldenominator" | |
224 | (pass-if "simple" (fl=? (fldenominator 0.5) 2.0)) | |
225 | ||
226 | (pass-if "infinities" | |
227 | (and (fl=? (fldenominator +inf.0) 1.0) | |
228 | (fl=? (fldenominator -inf.0) 1.0))) | |
229 | ||
230 | (pass-if "zero" (fl=? (fldenominator 0.0) 1.0))) | |
231 | ||
232 | (with-test-prefix "flfloor" | |
233 | (pass-if "simple" | |
234 | (and (fl=? (flfloor -4.3) -5.0) | |
235 | (fl=? (flfloor 3.5) 3.0)))) | |
236 | ||
237 | (with-test-prefix "flceiling" | |
238 | (pass-if "simple" | |
239 | (and (fl=? (flceiling -4.3) -4.0) | |
240 | (fl=? (flceiling 3.5) 4.0)))) | |
241 | ||
242 | (with-test-prefix "fltruncate" | |
243 | (pass-if "simple" | |
244 | (and (fl=? (fltruncate -4.3) -4.0) | |
245 | (fl=? (fltruncate 3.5) 3.0)))) | |
246 | ||
247 | (with-test-prefix "flround" | |
248 | (pass-if "simple" | |
249 | (and (fl=? (flround -4.3) -4.0) | |
250 | (fl=? (flround 3.5) 4.0)))) | |
251 | ||
252 | (with-test-prefix "flexp" | |
253 | (pass-if "infinities" | |
254 | (and (fl=? (flexp +inf.0) +inf.0) | |
255 | (fl=? (flexp -inf.0) 0.0)))) | |
256 | ||
257 | (with-test-prefix "fllog" | |
258 | (pass-if "unary fllog returns natural log" | |
ad922d06 | 259 | (reasonably-close? (fllog 2.718281828459045) 1.0)) |
b01818d7 JG |
260 | |
261 | (pass-if "infinities" | |
262 | (and (fl=? (fllog +inf.0) +inf.0) | |
263 | (flnan? (fllog -inf.0)))) | |
264 | ||
ad922d06 MW |
265 | (pass-if "negative argument" |
266 | (flnan? (fllog -1.0))) | |
267 | ||
268 | (pass-if "zero" (fl=? (fllog 0.0) -inf.0)) | |
269 | (pass-if "negative zero" (fl=? (fllog -0.0) -inf.0)) | |
270 | (pass-if "negative zero with base" (fl=? (fllog -0.0 0.5) +inf.0)) | |
b01818d7 JG |
271 | |
272 | (pass-if "binary fllog returns log in specified base" | |
273 | (fl=? (fllog 8.0 2.0) 3.0))) | |
274 | ||
275 | (with-test-prefix "flsin" | |
276 | (pass-if "simple" | |
277 | (and (reasonably-close? (flsin (/ fake-pi 2)) 1.0) | |
278 | (reasonably-close? (flsin (/ fake-pi 6)) 0.5)))) | |
279 | ||
280 | (with-test-prefix "flcos" | |
281 | (pass-if "simple" | |
282 | (and (fl=? (flcos 0.0) 1.0) (reasonably-close? (flcos (/ fake-pi 3)) 0.5)))) | |
283 | ||
284 | (with-test-prefix "fltan" | |
285 | (pass-if "simple" | |
286 | (and (reasonably-close? (fltan (/ fake-pi 4)) 1.0) | |
287 | (reasonably-close? (fltan (/ (* 3 fake-pi) 4)) -1.0)))) | |
288 | ||
289 | (with-test-prefix "flasin" | |
290 | (pass-if "simple" | |
291 | (and (reasonably-close? (flasin 1.0) (/ fake-pi 2)) | |
ad922d06 MW |
292 | (reasonably-close? (flasin 0.5) (/ fake-pi 6)))) |
293 | (pass-if "out of range" | |
294 | (flnan? (flasin 2.0)))) | |
b01818d7 JG |
295 | |
296 | (with-test-prefix "flacos" | |
297 | (pass-if "simple" | |
298 | (and (fl=? (flacos 1.0) 0.0) | |
ad922d06 MW |
299 | (reasonably-close? (flacos 0.5) (/ fake-pi 3)))) |
300 | (pass-if "out of range" | |
301 | (flnan? (flacos 2.0)))) | |
b01818d7 JG |
302 | |
303 | (with-test-prefix "flatan" | |
304 | (pass-if "unary flatan" | |
305 | (and (reasonably-close? (flatan 1.0) (/ fake-pi 4)) | |
306 | (reasonably-close? (flatan -1.0) (/ fake-pi -4)))) | |
307 | ||
308 | (pass-if "infinities" | |
309 | (and (reasonably-close? (flatan -inf.0) -1.5707963267949) | |
310 | (reasonably-close? (flatan +inf.0) 1.5707963267949))) | |
311 | ||
312 | (pass-if "binary flatan" | |
313 | (and (reasonably-close? (flatan 3.5 3.5) (/ fake-pi 4))))) | |
314 | ||
315 | (with-test-prefix "flsqrt" | |
316 | (pass-if "simple" (fl=? (flsqrt 4.0) 2.0)) | |
ad922d06 | 317 | (pass-if "negative" (flnan? (flsqrt -1.0))) |
b01818d7 | 318 | (pass-if "infinity" (fl=? (flsqrt +inf.0) +inf.0)) |
b01818d7 JG |
319 | (pass-if "negative zero" (fl=? (flsqrt -0.0) -0.0))) |
320 | ||
ad922d06 MW |
321 | (with-test-prefix "flexpt" |
322 | (pass-if "simple" (fl=? (flexpt 2.0 3.0) 8.0)) | |
323 | (pass-if "negative squared" (fl=? (flexpt -2.0 2.0) 4.0)) | |
324 | (pass-if "negative cubed" (fl=? (flexpt -2.0 3.0) -8.0)) | |
325 | (pass-if "negative to non-integer power" (flnan? (flexpt -2.0 2.5)))) | |
b01818d7 JG |
326 | |
327 | (with-test-prefix "fixnum->flonum" | |
328 | (pass-if "simple" (fl=? (fixnum->flonum 100) 100.0))) |