test-suite/tests/r6rs-arithmetic-flonums.test

   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 non-flonum"
  34     (not (flonum? 3))))
  35
  36 (with-test-prefix "real->flonum"
  37   (pass-if "simple"
  38     (flonum? (real->flonum 3))))
  39
  40 (with-test-prefix "fl=?"
  41   (pass-if "fl=? is #t for eqv inputs"
  42     (fl=? 3.0 3.0 3.0))
  43
  44   (pass-if "fl=? is #f for non-eqv inputs"
  45     (not (fl=? 1.5 0.0 3.0)))
  46
  47   (pass-if "+inf.0 is fl= to itself"
  48     (fl=? +inf.0 +inf.0))
  49
  50   (pass-if "0.0 and -0.0 are fl="
  51     (fl=? 0.0 -0.0)))
  52
  53 (with-test-prefix "fl<?"
  54   (pass-if "fl<? is #t for monotonically < inputs"
  55     (fl<? 1.0 2.0 3.0))
  56
  57   (pass-if "fl<? is #f for non-monotonically < inputs"
  58     (not (fl<? 2.0 2.0 1.4))))
  59
  60 (with-test-prefix "fl<=?"
  61   (pass-if "fl<=? is #t for monotonically < or = inputs"
  62     (fl<=? 1.0 1.2 1.2))
  63
  64   (pass-if "fl<=? is #f non-monotonically < or = inputs"
  65     (not (fl<=? 2.0 1.0 0.9))))
  66
  67 (with-test-prefix "fl>?"
  68   (pass-if "fl>? is #t for monotonically > inputs"
  69     (fl>? 3.0 2.0 1.0))
  70
  71   (pass-if "fl>? is #f for non-monotonically > inputs"
  72     (not (fl>? 1.0 1.0 1.2))))
  73
  74 (with-test-prefix "fl>=?"
  75   (pass-if "fl>=? is #t for monotonically > or = inputs"
  76     (fl>=? 3.0 2.0 2.0))
  77
  78   (pass-if "fl>=? is #f for non-monotonically > or = inputs"
  79     (not (fl>=? 1.0 1.2 1.2))))
  80
  81 (with-test-prefix "flinteger?"
  82   (pass-if "flinteger? is #t on integer flomnums"
  83     (flinteger? 1.0))
  84
  85   (pass-if "flinteger? is #f on non-integer flonums"
  86     (not (flinteger? 1.5))))
  87
  88 (with-test-prefix "flzero?"
  89   (pass-if "flzero? is #t for 0.0 and -0.0"
  90     (and (flzero? 0.0) (flzero? -0.0)))
  91
  92   (pass-if "flzero? is #f for non-zero flonums"
  93     (not (flzero? 1.0))))
  94
  95 (with-test-prefix "flpositive?"
  96   (pass-if "flpositive? is #t on positive flonum"
  97     (flpositive? 1.0))
  98
  99   (pass-if "flpositive? is #f on negative flonum"
 100     (not (flpositive? -1.0)))
 101
 102   (pass-if "0.0 and -0.0 are not flpositive"
 103     (and (not (flpositive? 0.0)) (not (flpositive? -0.0)))))
 104
 105 (with-test-prefix "flnegative?"
 106   (pass-if "flnegative? is #t on negative flonum"
 107     (flnegative? -1.0))
 108
 109   (pass-if "flnegative? is #f on positive flonum"
 110     (not (flnegative? 1.0)))
 111
 112   (pass-if "0.0 and -0.0 are not flnegative"
 113     (and (not (flnegative? 0.0)) (not (flnegative? -0.0)))))
 114
 115 (with-test-prefix "flodd?"
 116   (pass-if "&assertion raised on non-integer flonum"
 117     (guard (condition ((assertion-violation? condition) #t) (else #f))
 118            (begin (flodd? 1.5) #f)))
 119
 120   (pass-if "flodd? is #t on odd flonums"
 121     (flodd? 3.0))
 122
 123   (pass-if "flodd? is #f on even flonums"
 124     (not (flodd? 2.0))))
 125
 126 (with-test-prefix "fleven?"
 127   (pass-if "&assertion raised on non-integer flonum"
 128     (guard (condition ((assertion-violation? condition) #t) (else #f))
 129            (begin (fleven? 1.5) #f)))
 130
 131   (pass-if "fleven? is #t on even flonums"
 132     (fleven? 2.0))
 133
 134   (pass-if "fleven? is #f on odd flonums"
 135     (not (fleven? 3.0))))
 136
 137 (with-test-prefix "flfinite?"
 138   (pass-if "flfinite? is #t on non-infinite flonums"
 139     (flfinite? 2.0))
 140
 141   (pass-if "flfinite? is #f on infinities"
 142     (and (not (flfinite? +inf.0)) (not (flfinite? -inf.0)))))
 143
 144 (with-test-prefix "flinfinite?"
 145   (pass-if "flinfinite? is #t on infinities"
 146     (and (flinfinite? +inf.0) (flinfinite? -inf.0)))
 147
 148   (pass-if "flinfinite? is #f on non-infinite flonums"
 149     (not (flinfinite? 2.0))))
 150
 151 (with-test-prefix "flnan?"
 152   (pass-if "flnan? is #t on NaN and -NaN"
 153     (and (flnan? +nan.0) (flnan? -nan.0)))
 154
 155   (pass-if "flnan? is #f on non-NaN values"
 156     (not (flnan? 1.5))))
 157
 158 (with-test-prefix "flmax"
 159   (pass-if "simple" (fl=? (flmax 1.0 3.0 2.0) 3.0)))
 160
 161 (with-test-prefix "flmin"
 162   (pass-if "simple" (fl=? (flmin -1.0 0.0 2.0) -1.0)))
 163
 164 (with-test-prefix "fl+"
 165   (pass-if "simple" (fl=? (fl+ 2.141 1.0 0.1) 3.241)))
 166
 167 (with-test-prefix "fl*"
 168   (pass-if "simple" (fl=? (fl* 1.0 2.0 3.0 1.5) 9.0)))
 169
 170 (with-test-prefix "fl-"
 171   (pass-if "unary fl- negates argument" (fl=? (fl- 2.0) -2.0))
 172
 173   (pass-if "simple" (fl=? (fl- 10.5 6.0 0.5) 4.0)))
 174
 175 (with-test-prefix "fl/"
 176   (pass-if "unary fl/ returns multiplicative inverse" (fl=? (fl/ 10.0) 0.1))
 177
 178   (pass-if "simple" (fl=? (fl/ 10.0 2.0 2.0) 2.5)))
 179
 180 (with-test-prefix "flabs"
 181   (pass-if "simple" (and (fl=? (flabs -1.0) 1.0) (fl=? (flabs 1.23) 1.23))))
 182
 183 (with-test-prefix "fldiv-and-mod"
 184   (pass-if "simple"
 185     (call-with-values (lambda () (fldiv-and-mod 5.0 2.0))
 186       (lambda (div mod) (fl=? div 2.0) (fl=? mod 1.0)))))
 187
 188 (with-test-prefix "fldiv"
 189   (pass-if "simple" (fl=? (fldiv 5.0 2.0) 2.0)))
 190
 191 (with-test-prefix "flmod"
 192   (pass-if "simple" (fl=? (flmod 5.0 2.0) 1.0)))
 193
 194 (with-test-prefix "fldiv0-and-mod0"
 195   (pass-if "simple"
 196     (call-with-values (lambda () (fldiv0-and-mod0 -123.0 10.0))
 197       (lambda (div mod)
 198         (and (fl=? div -12.0) (fl=? mod -3.0))))))
 199
 200 (with-test-prefix "fldiv0"
 201   (pass-if "simple" (fl=? (fldiv0 -123.0 10.0) -12.0)))
 202
 203 (with-test-prefix "flmod0"
 204   (pass-if "simple" (fl=? (flmod0 -123.0 10.0) -3.0)))
 205
 206 (with-test-prefix "flnumerator"
 207   (pass-if "simple" (fl=? (flnumerator 0.5) 1.0))
 208
 209   (pass-if "infinities"
 210     (and (fl=? (flnumerator +inf.0) +inf.0)
 211          (fl=? (flnumerator -inf.0) -inf.0)))
 212
 213   (pass-if "negative zero" (fl=? (flnumerator -0.0) -0.0)))
 214
 215 (with-test-prefix "fldenominator"
 216   (pass-if "simple" (fl=? (fldenominator 0.5) 2.0))
 217
 218   (pass-if "infinities"
 219     (and (fl=? (fldenominator +inf.0) 1.0)
 220          (fl=? (fldenominator -inf.0) 1.0)))
 221
 222   (pass-if "zero" (fl=? (fldenominator 0.0) 1.0)))
 223
 224 (with-test-prefix "flfloor"
 225   (pass-if "simple"
 226     (and (fl=? (flfloor -4.3) -5.0)
 227          (fl=? (flfloor 3.5) 3.0))))
 228
 229 (with-test-prefix "flceiling"
 230   (pass-if "simple"
 231     (and (fl=? (flceiling -4.3) -4.0)
 232          (fl=? (flceiling 3.5) 4.0))))
 233
 234 (with-test-prefix "fltruncate"
 235   (pass-if "simple"
 236     (and (fl=? (fltruncate -4.3) -4.0)
 237          (fl=? (fltruncate 3.5) 3.0))))
 238
 239 (with-test-prefix "flround"
 240   (pass-if "simple"
 241     (and (fl=? (flround -4.3) -4.0)
 242          (fl=? (flround 3.5) 4.0))))
 243
 244 (with-test-prefix "flexp"
 245   (pass-if "infinities"
 246     (and (fl=? (flexp +inf.0) +inf.0)
 247          (fl=? (flexp -inf.0) 0.0))))
 248
 249 (with-test-prefix "fllog"
 250   (pass-if "unary fllog returns natural log"
 251     (let ((l (fllog 2.718281828459045)))
 252       (and (fl<=? 0.9 l) (fl>=? 1.1 l))))
 253
 254   (pass-if "infinities"
 255     (and (fl=? (fllog +inf.0) +inf.0)
 256          (flnan? (fllog -inf.0))))
 257
 258   (pass-if "zeroes" (fl=? (fllog 0.0) -inf.0))
 259
 260   (pass-if "binary fllog returns log in specified base"
 261     (fl=? (fllog 8.0 2.0) 3.0)))
 262
 263 (with-test-prefix "flsin"
 264   (pass-if "simple"
 265     (and (reasonably-close? (flsin (/ fake-pi 2)) 1.0)
 266          (reasonably-close? (flsin (/ fake-pi 6)) 0.5))))
 267
 268 (with-test-prefix "flcos"
 269   (pass-if "simple"
 270     (and (fl=? (flcos 0.0) 1.0) (reasonably-close? (flcos (/ fake-pi 3)) 0.5))))
 271
 272 (with-test-prefix "fltan"
 273   (pass-if "simple"
 274     (and (reasonably-close? (fltan (/ fake-pi 4)) 1.0)
 275          (reasonably-close? (fltan (/ (* 3 fake-pi) 4)) -1.0))))
 276
 277 (with-test-prefix "flasin"
 278   (pass-if "simple"
 279     (and (reasonably-close? (flasin 1.0) (/ fake-pi 2))
 280          (reasonably-close? (flasin 0.5) (/ fake-pi 6)))))
 281
 282 (with-test-prefix "flacos"
 283   (pass-if "simple"
 284     (and (fl=? (flacos 1.0) 0.0)
 285          (reasonably-close? (flacos 0.5) (/ fake-pi 3)))))
 286
 287 (with-test-prefix "flatan"
 288   (pass-if "unary flatan"
 289     (and (reasonably-close? (flatan 1.0) (/ fake-pi 4))
 290          (reasonably-close? (flatan -1.0) (/ fake-pi -4))))
 291
 292   (pass-if "infinities"
 293     (and (reasonably-close? (flatan -inf.0) -1.5707963267949)
 294          (reasonably-close? (flatan +inf.0) 1.5707963267949)))
 295
 296   (pass-if "binary flatan"
 297     (and (reasonably-close? (flatan 3.5 3.5) (/ fake-pi 4)))))
 298
 299 (with-test-prefix "flsqrt"
 300   (pass-if "simple" (fl=? (flsqrt 4.0) 2.0))
 301
 302   (pass-if "infinity" (fl=? (flsqrt +inf.0) +inf.0))
 303
 304   (pass-if "negative zero" (fl=? (flsqrt -0.0) -0.0)))
 305
 306 (with-test-prefix "flexpt" (pass-if "simple" (fl=? (flexpt 2.0 3.0) 8.0)))
 307
 308 (with-test-prefix "fixnum->flonum"
 309   (pass-if "simple" (fl=? (fixnum->flonum 100) 100.0)))