1 ;;; arithmetic-flonums.test --- Test suite for R6RS (rnrs arithmetic flonums)
3 ;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
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.
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.
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
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))
26 (define fake-pi 3.14159265)
27 (define (reasonably-close? x y) (< (abs (- x y)) 0.0000001))
29 (with-test-prefix "flonum?"
30 (pass-if "flonum? is #t on flonum"
33 (pass-if "flonum? is #f on complex"
34 (not (flonum? 1.5+0.0i)))
36 (pass-if "flonum? is #f on exact integer"
39 (with-test-prefix "real->flonum"
41 (flonum? (real->flonum 3))))
43 (with-test-prefix "fl=?"
44 (pass-if "fl=? is #t for eqv inputs"
47 (pass-if "fl=? is #f for non-eqv inputs"
48 (not (fl=? 1.5 0.0 3.0)))
50 (pass-if "+inf.0 is fl= to itself"
53 (pass-if "0.0 and -0.0 are fl="
56 (with-test-prefix "fl<?"
57 (pass-if "fl<? is #t for monotonically < inputs"
60 (pass-if "fl<? is #f for non-monotonically < inputs"
61 (not (fl<? 2.0 2.0 1.4))))
63 (with-test-prefix "fl<=?"
64 (pass-if "fl<=? is #t for monotonically < or = inputs"
67 (pass-if "fl<=? is #f non-monotonically < or = inputs"
68 (not (fl<=? 2.0 1.0 0.9))))
70 (with-test-prefix "fl>?"
71 (pass-if "fl>? is #t for monotonically > inputs"
74 (pass-if "fl>? is #f for non-monotonically > inputs"
75 (not (fl>? 1.0 1.0 1.2))))
77 (with-test-prefix "fl>=?"
78 (pass-if "fl>=? is #t for monotonically > or = inputs"
81 (pass-if "fl>=? is #f for non-monotonically > or = inputs"
82 (not (fl>=? 1.0 1.2 1.2))))
84 (with-test-prefix "flinteger?"
85 (pass-if "flinteger? is #t on integer flomnums"
88 (pass-if "flinteger? is #f on non-integer flonums"
89 (not (flinteger? 1.5))))
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)))
95 (pass-if "flzero? is #f for non-zero flonums"
98 (with-test-prefix "flpositive?"
99 (pass-if "flpositive? is #t on positive flonum"
102 (pass-if "flpositive? is #f on negative flonum"
103 (not (flpositive? -1.0)))
105 (pass-if "0.0 and -0.0 are not flpositive"
106 (and (not (flpositive? 0.0)) (not (flpositive? -0.0)))))
108 (with-test-prefix "flnegative?"
109 (pass-if "flnegative? is #t on negative flonum"
112 (pass-if "flnegative? is #f on positive flonum"
113 (not (flnegative? 1.0)))
115 (pass-if "0.0 and -0.0 are not flnegative"
116 (and (not (flnegative? 0.0)) (not (flnegative? -0.0)))))
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)))
123 (pass-if "flodd? is #t on odd flonums"
126 (pass-if "flodd? is #f on even flonums"
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)))
134 (pass-if "fleven? is #t on even flonums"
137 (pass-if "fleven? is #f on odd flonums"
138 (not (fleven? 3.0))))
140 (with-test-prefix "flfinite?"
141 (pass-if "flfinite? is #t on non-infinite flonums"
144 (pass-if "flfinite? is #f on infinities"
145 (and (not (flfinite? +inf.0)) (not (flfinite? -inf.0))))
147 (pass-if "flfinite? is #f on NaNs"
148 (not (flfinite? +nan.0))))
150 (with-test-prefix "flinfinite?"
151 (pass-if "flinfinite? is #t on infinities"
152 (and (flinfinite? +inf.0) (flinfinite? -inf.0)))
154 (pass-if "flinfinite? is #f on non-infinite flonums"
155 (not (flinfinite? 2.0))))
157 (with-test-prefix "flnan?"
158 (pass-if "flnan? is #t on NaN and -NaN"
159 (and (flnan? +nan.0) (flnan? -nan.0)))
161 (pass-if "flnan? is #f on non-NaN values"
164 (with-test-prefix "flmax"
165 (pass-if "simple" (fl=? (flmax 1.0 3.0 2.0) 3.0)))
167 (with-test-prefix "flmin"
168 (pass-if "simple" (fl=? (flmin -1.0 0.0 2.0) -1.0)))
170 (with-test-prefix "fl+"
171 (pass-if "simple" (fl=? (fl+ 2.141 1.0 0.1) 3.241))
172 (pass-if "zero args" (fl=? (fl+) 0.0)))
174 (with-test-prefix "fl*"
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)))
178 (with-test-prefix "fl-"
179 (pass-if "unary fl- negates argument" (fl=? (fl- 2.0) -2.0))
181 (pass-if "simple" (fl=? (fl- 10.5 6.0 0.5) 4.0)))
183 (with-test-prefix "fl/"
184 (pass-if "unary fl/ returns multiplicative inverse" (fl=? (fl/ 10.0) 0.1))
186 (pass-if "simple" (fl=? (fl/ 10.0 2.0 2.0) 2.5)))
188 (with-test-prefix "flabs"
189 (pass-if "simple" (and (fl=? (flabs -1.0) 1.0) (fl=? (flabs 1.23) 1.23))))
191 (with-test-prefix "fldiv-and-mod"
193 (call-with-values (lambda () (fldiv-and-mod 5.0 2.0))
194 (lambda (div mod) (fl=? div 2.0) (fl=? mod 1.0)))))
196 (with-test-prefix "fldiv"
197 (pass-if "simple" (fl=? (fldiv 5.0 2.0) 2.0)))
199 (with-test-prefix "flmod"
200 (pass-if "simple" (fl=? (flmod 5.0 2.0) 1.0)))
202 (with-test-prefix "fldiv0-and-mod0"
204 (call-with-values (lambda () (fldiv0-and-mod0 -123.0 10.0))
206 (and (fl=? div -12.0) (fl=? mod -3.0))))))
208 (with-test-prefix "fldiv0"
209 (pass-if "simple" (fl=? (fldiv0 -123.0 10.0) -12.0)))
211 (with-test-prefix "flmod0"
212 (pass-if "simple" (fl=? (flmod0 -123.0 10.0) -3.0)))
214 (with-test-prefix "flnumerator"
215 (pass-if "simple" (fl=? (flnumerator 0.5) 1.0))
217 (pass-if "infinities"
218 (and (fl=? (flnumerator +inf.0) +inf.0)
219 (fl=? (flnumerator -inf.0) -inf.0)))
221 (pass-if "negative zero" (eqv? (flnumerator -0.0) -0.0)))
223 (with-test-prefix "fldenominator"
224 (pass-if "simple" (fl=? (fldenominator 0.5) 2.0))
226 (pass-if "infinities"
227 (and (fl=? (fldenominator +inf.0) 1.0)
228 (fl=? (fldenominator -inf.0) 1.0)))
230 (pass-if "zero" (fl=? (fldenominator 0.0) 1.0)))
232 (with-test-prefix "flfloor"
234 (and (fl=? (flfloor -4.3) -5.0)
235 (fl=? (flfloor 3.5) 3.0))))
237 (with-test-prefix "flceiling"
239 (and (fl=? (flceiling -4.3) -4.0)
240 (fl=? (flceiling 3.5) 4.0))))
242 (with-test-prefix "fltruncate"
244 (and (fl=? (fltruncate -4.3) -4.0)
245 (fl=? (fltruncate 3.5) 3.0))))
247 (with-test-prefix "flround"
249 (and (fl=? (flround -4.3) -4.0)
250 (fl=? (flround 3.5) 4.0))))
252 (with-test-prefix "flexp"
253 (pass-if "infinities"
254 (and (fl=? (flexp +inf.0) +inf.0)
255 (fl=? (flexp -inf.0) 0.0))))
257 (with-test-prefix "fllog"
258 (pass-if "unary fllog returns natural log"
259 (reasonably-close? (fllog 2.718281828459045) 1.0))
261 (pass-if "infinities"
262 (and (fl=? (fllog +inf.0) +inf.0)
263 (flnan? (fllog -inf.0))))
265 (pass-if "negative argument"
266 (flnan? (fllog -1.0)))
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))
272 (pass-if "binary fllog returns log in specified base"
273 (fl=? (fllog 8.0 2.0) 3.0)))
275 (with-test-prefix "flsin"
277 (and (reasonably-close? (flsin (/ fake-pi 2)) 1.0)
278 (reasonably-close? (flsin (/ fake-pi 6)) 0.5))))
280 (with-test-prefix "flcos"
282 (and (fl=? (flcos 0.0) 1.0) (reasonably-close? (flcos (/ fake-pi 3)) 0.5))))
284 (with-test-prefix "fltan"
286 (and (reasonably-close? (fltan (/ fake-pi 4)) 1.0)
287 (reasonably-close? (fltan (/ (* 3 fake-pi) 4)) -1.0))))
289 (with-test-prefix "flasin"
291 (and (reasonably-close? (flasin 1.0) (/ fake-pi 2))
292 (reasonably-close? (flasin 0.5) (/ fake-pi 6))))
293 (pass-if "out of range"
294 (flnan? (flasin 2.0))))
296 (with-test-prefix "flacos"
298 (and (fl=? (flacos 1.0) 0.0)
299 (reasonably-close? (flacos 0.5) (/ fake-pi 3))))
300 (pass-if "out of range"
301 (flnan? (flacos 2.0))))
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))))
308 (pass-if "infinities"
309 (and (reasonably-close? (flatan -inf.0) -1.5707963267949)
310 (reasonably-close? (flatan +inf.0) 1.5707963267949)))
312 (pass-if "binary flatan"
313 (and (reasonably-close? (flatan 3.5 3.5) (/ fake-pi 4)))))
315 (with-test-prefix "flsqrt"
316 (pass-if "simple" (fl=? (flsqrt 4.0) 2.0))
317 (pass-if "negative" (flnan? (flsqrt -1.0)))
318 (pass-if "infinity" (fl=? (flsqrt +inf.0) +inf.0))
319 (pass-if "negative zero" (fl=? (flsqrt -0.0) -0.0)))
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))))
327 (with-test-prefix "fixnum->flonum"
328 (pass-if "simple" (fl=? (fixnum->flonum 100) 100.0)))