basis/math/floats/env/env-tests.factor

   1 USING: kernel math math.floats.env math.floats.env.private
   2 math.functions math.libm sequences tools.test ;
   3 IN: math.floats.env.tests
   4
   5 : set-default-fp-env ( -- )
   6     { } { } +round-nearest+ +denormal-keep+ set-fp-env ;
   7
   8 ! In case the tests screw up the FP env because of bugs in math.floats.env
   9 set-default-fp-env
  10
  11 [ t ] [
  12     [ 1.0 0.0 / drop ] collect-fp-exceptions
  13     +fp-zero-divide+ swap member?
  14 ] unit-test
  15
  16 [ t ] [
  17     [ 1.0 3.0 / drop ] collect-fp-exceptions
  18     +fp-inexact+ swap member?
  19 ] unit-test
  20
  21 [ t ] [
  22     [ 1.0e250 1.0e100 * drop ] collect-fp-exceptions
  23     +fp-overflow+ swap member?
  24 ] unit-test
  25
  26 [ t ] [
  27     [ 1.0e-250 1.0e-100 * drop ] collect-fp-exceptions
  28     +fp-underflow+ swap member?
  29 ] unit-test
  30
  31 [ t ] [
  32     [ 2.0 100,000.0 ^ drop ] collect-fp-exceptions
  33     +fp-overflow+ swap member?
  34 ] unit-test
  35
  36 [ t ] [
  37     [ 2.0 -100,000.0 ^ drop ] collect-fp-exceptions
  38     +fp-underflow+ swap member?
  39 ] unit-test
  40
  41 [ t ] [
  42     [ 0.0 0.0 /f drop ] collect-fp-exceptions
  43     +fp-invalid-operation+ swap member?
  44 ] unit-test
  45
  46 [ t ] [
  47     [ -1.0 fsqrt drop ] collect-fp-exceptions
  48     +fp-invalid-operation+ swap member?
  49 ] unit-test
  50
  51 [
  52     HEX: 3fd5,5555,5555,5555
  53     HEX: 3fc9,9999,9999,999a
  54     HEX: bfc9,9999,9999,999a
  55     HEX: bfd5,5555,5555,5555
  56 ] [
  57     +round-nearest+ [
  58          1.0 3.0 /f double>bits
  59          1.0 5.0 /f double>bits
  60         -1.0 5.0 /f double>bits
  61         -1.0 3.0 /f double>bits
  62     ] with-rounding-mode
  63 ] unit-test
  64
  65 [
  66     HEX: 3fd5,5555,5555,5555
  67     HEX: 3fc9,9999,9999,9999
  68     HEX: bfc9,9999,9999,999a
  69     HEX: bfd5,5555,5555,5556
  70 ] [
  71     +round-down+ [
  72          1.0 3.0 /f double>bits
  73          1.0 5.0 /f double>bits
  74         -1.0 5.0 /f double>bits
  75         -1.0 3.0 /f double>bits
  76     ] with-rounding-mode
  77 ] unit-test
  78
  79 [
  80     HEX: 3fd5,5555,5555,5556
  81     HEX: 3fc9,9999,9999,999a
  82     HEX: bfc9,9999,9999,9999
  83     HEX: bfd5,5555,5555,5555
  84 ] [
  85     +round-up+ [
  86          1.0 3.0 /f double>bits
  87          1.0 5.0 /f double>bits
  88         -1.0 5.0 /f double>bits
  89         -1.0 3.0 /f double>bits
  90     ] with-rounding-mode
  91 ] unit-test
  92
  93 [
  94     HEX: 3fd5,5555,5555,5555
  95     HEX: 3fc9,9999,9999,9999
  96     HEX: bfc9,9999,9999,9999
  97     HEX: bfd5,5555,5555,5555
  98 ] [
  99     +round-zero+ [
 100          1.0 3.0 /f double>bits
 101          1.0 5.0 /f double>bits
 102         -1.0 5.0 /f double>bits
 103         -1.0 3.0 /f double>bits
 104     ] with-rounding-mode
 105 ] unit-test
 106
 107 ! ensure rounding mode is restored to +round-nearest+
 108 [
 109     HEX: 3fd5,5555,5555,5555
 110     HEX: 3fc9,9999,9999,999a
 111     HEX: bfc9,9999,9999,999a
 112     HEX: bfd5,5555,5555,5555
 113 ] [
 114      1.0 3.0 /f double>bits
 115      1.0 5.0 /f double>bits
 116     -1.0 5.0 /f double>bits
 117     -1.0 3.0 /f double>bits
 118 ] unit-test
 119
 120 [ { +fp-zero-divide+ }       [ 1.0 0.0 /f ] with-fp-traps ] must-fail
 121 [ { +fp-inexact+ }           [ 1.0 3.0 /f ] with-fp-traps ] must-fail
 122 [ { +fp-invalid-operation+ } [ -1.0 fsqrt ] with-fp-traps ] must-fail
 123 [ { +fp-overflow+ }          [ 2.0  100,000.0 ^ ] with-fp-traps ] must-fail
 124 [ { +fp-underflow+ }         [ 2.0 -100,000.0 ^ ] with-fp-traps ] must-fail
 125
 126 ! Ensure traps get cleared
 127 [ 1/0. ] [ 1.0 0.0 /f ] unit-test
 128
 129 ! Ensure state is back to normal
 130 [ +round-nearest+ ] [ rounding-mode ] unit-test
 131 [ +denormal-keep+ ] [ denormal-mode ] unit-test
 132 [ { } ] [ fp-traps ] unit-test
 133
 134 ! In case the tests screw up the FP env because of bugs in math.floats.env
 135 set-default-fp-env
 136