1 USING: kernel math math.floats.env math.floats.env.private
2 math.functions math.libm sequences tools.test locals
3 compiler.units kernel.private fry compiler math.private words
5 IN: math.floats.env.tests
7 : set-default-fp-env ( -- )
8 { } { } +round-nearest+ +denormal-keep+ set-fp-env ;
10 ! In case the tests screw up the FP env because of bugs in math.floats.env
13 : test-fp-exception ( exception inputs quot -- quot' )
14 '[ _ [ @ @ ] collect-fp-exceptions nip member? ] ;
16 : test-fp-exception-compiled ( exception inputs quot -- quot' )
17 '[ _ @ [ _ collect-fp-exceptions ] compile-call nip member? ] ;
19 [ t ] +fp-zero-divide+ [ 1.0 0.0 ] [ /f ] test-fp-exception unit-test
20 [ t ] +fp-inexact+ [ 1.0 3.0 ] [ /f ] test-fp-exception unit-test
21 [ t ] +fp-overflow+ [ 1.0e250 1.0e100 ] [ * ] test-fp-exception unit-test
22 [ t ] +fp-underflow+ [ 1.0e-250 1.0e-100 ] [ * ] test-fp-exception unit-test
23 [ t ] +fp-overflow+ [ 2.0 100,000.0 ] [ fpow ] test-fp-exception unit-test
24 [ t ] +fp-invalid-operation+ [ 0.0 0.0 ] [ /f ] test-fp-exception unit-test
25 [ t ] +fp-invalid-operation+ [ -1.0 ] [ fsqrt ] test-fp-exception unit-test
27 [ t ] +fp-zero-divide+ [ 1.0 0.0 ] [ /f ] test-fp-exception-compiled unit-test
28 [ t ] +fp-inexact+ [ 1.0 3.0 ] [ /f ] test-fp-exception-compiled unit-test
29 [ t ] +fp-overflow+ [ 1.0e250 1.0e100 ] [ * ] test-fp-exception-compiled unit-test
30 [ t ] +fp-underflow+ [ 1.0e-250 1.0e-100 ] [ * ] test-fp-exception-compiled unit-test
31 [ t ] +fp-overflow+ [ 2.0 100,000.0 ] [ fpow ] test-fp-exception-compiled unit-test
32 [ t ] +fp-invalid-operation+ [ 2.0 0/0. 1.0e-9 ] [ ~ ] test-fp-exception-compiled unit-test
34 ! No underflow on Linux with this test, just inexact. Reported as an Ubuntu bug:
35 ! https://bugs.launchpad.net/ubuntu/+source/glibc/+bug/429113
36 os linux? cpu x86.64? and [
37 [ t ] +fp-underflow+ [ 2.0 -100,000.0 ] [ fpow ] test-fp-exception unit-test
38 [ t ] +fp-underflow+ [ 2.0 -100,000.0 ] [ fpow ] test-fp-exception-compiled unit-test
41 [ t ] +fp-invalid-operation+ [ 0.0 0.0 ] [ /f ] test-fp-exception-compiled unit-test
42 [ t ] +fp-invalid-operation+ [ -1.0 ] [ fsqrt ] test-fp-exception-compiled unit-test
45 HEX: 3fd5,5555,5555,5555
46 HEX: 3fc9,9999,9999,999a
47 HEX: bfc9,9999,9999,999a
48 HEX: bfd5,5555,5555,5555
51 1.0 3.0 /f double>bits
52 1.0 5.0 /f double>bits
53 -1.0 5.0 /f double>bits
54 -1.0 3.0 /f double>bits
59 HEX: 3fd5,5555,5555,5555
60 HEX: 3fc9,9999,9999,9999
61 HEX: bfc9,9999,9999,999a
62 HEX: bfd5,5555,5555,5556
65 1.0 3.0 /f double>bits
66 1.0 5.0 /f double>bits
67 -1.0 5.0 /f double>bits
68 -1.0 3.0 /f double>bits
73 HEX: 3fd5,5555,5555,5556
74 HEX: 3fc9,9999,9999,999a
75 HEX: bfc9,9999,9999,9999
76 HEX: bfd5,5555,5555,5555
79 1.0 3.0 /f double>bits
80 1.0 5.0 /f double>bits
81 -1.0 5.0 /f double>bits
82 -1.0 3.0 /f double>bits
87 HEX: 3fd5,5555,5555,5555
88 HEX: 3fc9,9999,9999,9999
89 HEX: bfc9,9999,9999,9999
90 HEX: bfd5,5555,5555,5555
93 1.0 3.0 /f double>bits
94 1.0 5.0 /f double>bits
95 -1.0 5.0 /f double>bits
96 -1.0 3.0 /f double>bits
100 ! ensure rounding mode is restored to +round-nearest+
102 HEX: 3fd5,5555,5555,5555
103 HEX: 3fc9,9999,9999,999a
104 HEX: bfc9,9999,9999,999a
105 HEX: bfd5,5555,5555,5555
107 1.0 3.0 /f double>bits
108 1.0 5.0 /f double>bits
109 -1.0 5.0 /f double>bits
110 -1.0 3.0 /f double>bits
113 ! FP traps cause a kernel panic on OpenBSD 4.5 i386
114 os openbsd eq? cpu x86.32 eq? and [
116 : test-traps ( traps inputs quot -- quot' )
117 append '[ _ _ with-fp-traps ] ;
119 : test-traps-compiled ( traps inputs quot -- quot' )
120 swapd '[ @ [ _ _ with-fp-traps ] compile-call ] ;
122 { +fp-zero-divide+ } [ 1.0 0.0 ] [ /f ] test-traps must-fail
123 { +fp-inexact+ } [ 1.0 3.0 ] [ /f ] test-traps must-fail
124 { +fp-invalid-operation+ } [ -1.0 ] [ fsqrt ] test-traps must-fail
125 { +fp-overflow+ } [ 2.0 ] [ 100,000.0 ^ ] test-traps must-fail
126 { +fp-underflow+ +fp-inexact+ } [ 2.0 ] [ -100,000.0 ^ ] test-traps must-fail
128 { +fp-zero-divide+ } [ 1.0 0.0 ] [ /f ] test-traps-compiled must-fail
129 { +fp-inexact+ } [ 1.0 3.0 ] [ /f ] test-traps-compiled must-fail
130 { +fp-invalid-operation+ } [ -1.0 ] [ fsqrt ] test-traps-compiled must-fail
131 { +fp-overflow+ } [ 2.0 ] [ 100,000.0 ^ ] test-traps-compiled must-fail
132 { +fp-underflow+ +fp-inexact+ } [ 2.0 ] [ -100,000.0 ^ ] test-traps-compiled must-fail
134 ! Ensure ordered comparisons raise traps
135 :: test-comparison-quot ( word -- quot )
137 { float float } declare
138 { +fp-invalid-operation+ } [ word execute ] with-fp-traps
141 : test-comparison ( inputs word -- quot )
142 test-comparison-quot append ;
144 : test-comparison-compiled ( inputs word -- quot )
145 test-comparison-quot '[ @ _ compile-call ] ;
147 \ float< "intrinsic" word-prop [
148 [ 0/0. -15.0 ] \ < test-comparison must-fail
149 [ 0/0. -15.0 ] \ < test-comparison-compiled must-fail
150 [ -15.0 0/0. ] \ < test-comparison must-fail
151 [ -15.0 0/0. ] \ < test-comparison-compiled must-fail
152 [ 0/0. -15.0 ] \ <= test-comparison must-fail
153 [ 0/0. -15.0 ] \ <= test-comparison-compiled must-fail
154 [ -15.0 0/0. ] \ <= test-comparison must-fail
155 [ -15.0 0/0. ] \ <= test-comparison-compiled must-fail
156 [ 0/0. -15.0 ] \ > test-comparison must-fail
157 [ 0/0. -15.0 ] \ > test-comparison-compiled must-fail
158 [ -15.0 0/0. ] \ > test-comparison must-fail
159 [ -15.0 0/0. ] \ > test-comparison-compiled must-fail
160 [ 0/0. -15.0 ] \ >= test-comparison must-fail
161 [ 0/0. -15.0 ] \ >= test-comparison-compiled must-fail
162 [ -15.0 0/0. ] \ >= test-comparison must-fail
163 [ -15.0 0/0. ] \ >= test-comparison-compiled must-fail
165 [ f ] [ 0/0. -15.0 ] \ u< test-comparison unit-test
166 [ f ] [ 0/0. -15.0 ] \ u< test-comparison-compiled unit-test
167 [ f ] [ -15.0 0/0. ] \ u< test-comparison unit-test
168 [ f ] [ -15.0 0/0. ] \ u< test-comparison-compiled unit-test
169 [ f ] [ 0/0. -15.0 ] \ u<= test-comparison unit-test
170 [ f ] [ 0/0. -15.0 ] \ u<= test-comparison-compiled unit-test
171 [ f ] [ -15.0 0/0. ] \ u<= test-comparison unit-test
172 [ f ] [ -15.0 0/0. ] \ u<= test-comparison-compiled unit-test
173 [ f ] [ 0/0. -15.0 ] \ u> test-comparison unit-test
174 [ f ] [ 0/0. -15.0 ] \ u> test-comparison-compiled unit-test
175 [ f ] [ -15.0 0/0. ] \ u> test-comparison unit-test
176 [ f ] [ -15.0 0/0. ] \ u> test-comparison-compiled unit-test
177 [ f ] [ 0/0. -15.0 ] \ u>= test-comparison unit-test
178 [ f ] [ 0/0. -15.0 ] \ u>= test-comparison-compiled unit-test
179 [ f ] [ -15.0 0/0. ] \ u>= test-comparison unit-test
180 [ f ] [ -15.0 0/0. ] \ u>= test-comparison-compiled unit-test
185 ! Ensure traps get cleared
186 [ 1/0. ] [ 1.0 0.0 /f ] unit-test
188 ! Ensure state is back to normal
189 [ +round-nearest+ ] [ rounding-mode ] unit-test
190 [ +denormal-keep+ ] [ denormal-mode ] unit-test
191 [ { } ] [ fp-traps ] unit-test
193 ! In case the tests screw up the FP env because of bugs in math.floats.env