| 1 | ;;; arithmetic-flonums.test --- Test suite for R6RS (rnrs arithmetic flonums) |
| 2 | |
| 3 | ;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. |
| 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 | |
| 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" |
| 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" |
| 145 | (and (not (flfinite? +inf.0)) (not (flfinite? -inf.0))))) |
| 146 | |
| 147 | (with-test-prefix "flinfinite?" |
| 148 | (pass-if "flinfinite? is #t on infinities" |
| 149 | (and (flinfinite? +inf.0) (flinfinite? -inf.0))) |
| 150 | |
| 151 | (pass-if "flinfinite? is #f on non-infinite flonums" |
| 152 | (not (flinfinite? 2.0)))) |
| 153 | |
| 154 | (with-test-prefix "flnan?" |
| 155 | (pass-if "flnan? is #t on NaN and -NaN" |
| 156 | (and (flnan? +nan.0) (flnan? -nan.0))) |
| 157 | |
| 158 | (pass-if "flnan? is #f on non-NaN values" |
| 159 | (not (flnan? 1.5)))) |
| 160 | |
| 161 | (with-test-prefix "flmax" |
| 162 | (pass-if "simple" (fl=? (flmax 1.0 3.0 2.0) 3.0))) |
| 163 | |
| 164 | (with-test-prefix "flmin" |
| 165 | (pass-if "simple" (fl=? (flmin -1.0 0.0 2.0) -1.0))) |
| 166 | |
| 167 | (with-test-prefix "fl+" |
| 168 | (pass-if "simple" (fl=? (fl+ 2.141 1.0 0.1) 3.241)) |
| 169 | (pass-if "zero args" (fl=? (fl+) 0.0))) |
| 170 | |
| 171 | (with-test-prefix "fl*" |
| 172 | (pass-if "simple" (fl=? (fl* 1.0 2.0 3.0 1.5) 9.0)) |
| 173 | (pass-if "zero args" (fl=? (fl*) 1.0))) |
| 174 | |
| 175 | (with-test-prefix "fl-" |
| 176 | (pass-if "unary fl- negates argument" (fl=? (fl- 2.0) -2.0)) |
| 177 | |
| 178 | (pass-if "simple" (fl=? (fl- 10.5 6.0 0.5) 4.0))) |
| 179 | |
| 180 | (with-test-prefix "fl/" |
| 181 | (pass-if "unary fl/ returns multiplicative inverse" (fl=? (fl/ 10.0) 0.1)) |
| 182 | |
| 183 | (pass-if "simple" (fl=? (fl/ 10.0 2.0 2.0) 2.5))) |
| 184 | |
| 185 | (with-test-prefix "flabs" |
| 186 | (pass-if "simple" (and (fl=? (flabs -1.0) 1.0) (fl=? (flabs 1.23) 1.23)))) |
| 187 | |
| 188 | (with-test-prefix "fldiv-and-mod" |
| 189 | (pass-if "simple" |
| 190 | (call-with-values (lambda () (fldiv-and-mod 5.0 2.0)) |
| 191 | (lambda (div mod) (fl=? div 2.0) (fl=? mod 1.0))))) |
| 192 | |
| 193 | (with-test-prefix "fldiv" |
| 194 | (pass-if "simple" (fl=? (fldiv 5.0 2.0) 2.0))) |
| 195 | |
| 196 | (with-test-prefix "flmod" |
| 197 | (pass-if "simple" (fl=? (flmod 5.0 2.0) 1.0))) |
| 198 | |
| 199 | (with-test-prefix "fldiv0-and-mod0" |
| 200 | (pass-if "simple" |
| 201 | (call-with-values (lambda () (fldiv0-and-mod0 -123.0 10.0)) |
| 202 | (lambda (div mod) |
| 203 | (and (fl=? div -12.0) (fl=? mod -3.0)))))) |
| 204 | |
| 205 | (with-test-prefix "fldiv0" |
| 206 | (pass-if "simple" (fl=? (fldiv0 -123.0 10.0) -12.0))) |
| 207 | |
| 208 | (with-test-prefix "flmod0" |
| 209 | (pass-if "simple" (fl=? (flmod0 -123.0 10.0) -3.0))) |
| 210 | |
| 211 | (with-test-prefix "flnumerator" |
| 212 | (pass-if "simple" (fl=? (flnumerator 0.5) 1.0)) |
| 213 | |
| 214 | (pass-if "infinities" |
| 215 | (and (fl=? (flnumerator +inf.0) +inf.0) |
| 216 | (fl=? (flnumerator -inf.0) -inf.0))) |
| 217 | |
| 218 | (pass-if "negative zero" (fl=? (flnumerator -0.0) -0.0))) |
| 219 | |
| 220 | (with-test-prefix "fldenominator" |
| 221 | (pass-if "simple" (fl=? (fldenominator 0.5) 2.0)) |
| 222 | |
| 223 | (pass-if "infinities" |
| 224 | (and (fl=? (fldenominator +inf.0) 1.0) |
| 225 | (fl=? (fldenominator -inf.0) 1.0))) |
| 226 | |
| 227 | (pass-if "zero" (fl=? (fldenominator 0.0) 1.0))) |
| 228 | |
| 229 | (with-test-prefix "flfloor" |
| 230 | (pass-if "simple" |
| 231 | (and (fl=? (flfloor -4.3) -5.0) |
| 232 | (fl=? (flfloor 3.5) 3.0)))) |
| 233 | |
| 234 | (with-test-prefix "flceiling" |
| 235 | (pass-if "simple" |
| 236 | (and (fl=? (flceiling -4.3) -4.0) |
| 237 | (fl=? (flceiling 3.5) 4.0)))) |
| 238 | |
| 239 | (with-test-prefix "fltruncate" |
| 240 | (pass-if "simple" |
| 241 | (and (fl=? (fltruncate -4.3) -4.0) |
| 242 | (fl=? (fltruncate 3.5) 3.0)))) |
| 243 | |
| 244 | (with-test-prefix "flround" |
| 245 | (pass-if "simple" |
| 246 | (and (fl=? (flround -4.3) -4.0) |
| 247 | (fl=? (flround 3.5) 4.0)))) |
| 248 | |
| 249 | (with-test-prefix "flexp" |
| 250 | (pass-if "infinities" |
| 251 | (and (fl=? (flexp +inf.0) +inf.0) |
| 252 | (fl=? (flexp -inf.0) 0.0)))) |
| 253 | |
| 254 | (with-test-prefix "fllog" |
| 255 | (pass-if "unary fllog returns natural log" |
| 256 | (let ((l (fllog 2.718281828459045))) |
| 257 | (and (fl<=? 0.9 l) (fl>=? 1.1 l)))) |
| 258 | |
| 259 | (pass-if "infinities" |
| 260 | (and (fl=? (fllog +inf.0) +inf.0) |
| 261 | (flnan? (fllog -inf.0)))) |
| 262 | |
| 263 | (pass-if "zeroes" (fl=? (fllog 0.0) -inf.0)) |
| 264 | |
| 265 | (pass-if "binary fllog returns log in specified base" |
| 266 | (fl=? (fllog 8.0 2.0) 3.0))) |
| 267 | |
| 268 | (with-test-prefix "flsin" |
| 269 | (pass-if "simple" |
| 270 | (and (reasonably-close? (flsin (/ fake-pi 2)) 1.0) |
| 271 | (reasonably-close? (flsin (/ fake-pi 6)) 0.5)))) |
| 272 | |
| 273 | (with-test-prefix "flcos" |
| 274 | (pass-if "simple" |
| 275 | (and (fl=? (flcos 0.0) 1.0) (reasonably-close? (flcos (/ fake-pi 3)) 0.5)))) |
| 276 | |
| 277 | (with-test-prefix "fltan" |
| 278 | (pass-if "simple" |
| 279 | (and (reasonably-close? (fltan (/ fake-pi 4)) 1.0) |
| 280 | (reasonably-close? (fltan (/ (* 3 fake-pi) 4)) -1.0)))) |
| 281 | |
| 282 | (with-test-prefix "flasin" |
| 283 | (pass-if "simple" |
| 284 | (and (reasonably-close? (flasin 1.0) (/ fake-pi 2)) |
| 285 | (reasonably-close? (flasin 0.5) (/ fake-pi 6))))) |
| 286 | |
| 287 | (with-test-prefix "flacos" |
| 288 | (pass-if "simple" |
| 289 | (and (fl=? (flacos 1.0) 0.0) |
| 290 | (reasonably-close? (flacos 0.5) (/ fake-pi 3))))) |
| 291 | |
| 292 | (with-test-prefix "flatan" |
| 293 | (pass-if "unary flatan" |
| 294 | (and (reasonably-close? (flatan 1.0) (/ fake-pi 4)) |
| 295 | (reasonably-close? (flatan -1.0) (/ fake-pi -4)))) |
| 296 | |
| 297 | (pass-if "infinities" |
| 298 | (and (reasonably-close? (flatan -inf.0) -1.5707963267949) |
| 299 | (reasonably-close? (flatan +inf.0) 1.5707963267949))) |
| 300 | |
| 301 | (pass-if "binary flatan" |
| 302 | (and (reasonably-close? (flatan 3.5 3.5) (/ fake-pi 4))))) |
| 303 | |
| 304 | (with-test-prefix "flsqrt" |
| 305 | (pass-if "simple" (fl=? (flsqrt 4.0) 2.0)) |
| 306 | |
| 307 | (pass-if "infinity" (fl=? (flsqrt +inf.0) +inf.0)) |
| 308 | |
| 309 | (pass-if "negative zero" (fl=? (flsqrt -0.0) -0.0))) |
| 310 | |
| 311 | (with-test-prefix "flexpt" (pass-if "simple" (fl=? (flexpt 2.0 3.0) 8.0))) |
| 312 | |
| 313 | (with-test-prefix "fixnum->flonum" |
| 314 | (pass-if "simple" (fl=? (fixnum->flonum 100) 100.0))) |