From 96db25431190ad6a249b8fa2ee1abf1d40df352e Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 6 Sep 2009 07:50:56 -0500
Subject: [PATCH] unit tests for math.floats.env

---
 basis/math/floats/env/env-tests.factor | 123 +++++++++++++++++++++++++
 1 file changed, 123 insertions(+)
 create mode 100644 basis/math/floats/env/env-tests.factor

diff --git a/basis/math/floats/env/env-tests.factor b/basis/math/floats/env/env-tests.factor
new file mode 100644
index 0000000000..65662e72d7
--- /dev/null
+++ b/basis/math/floats/env/env-tests.factor
@@ -0,0 +1,123 @@
+USING: kernel math math.floats.env math.functions math.libm
+sets tools.test ;
+IN: math.floats.env.tests
+
+[ t ] [
+    [ 1.0 0.0 / drop ] collect-fp-exceptions
+    { +fp-zero-divide+ } set= 
+] unit-test
+
+[ t ] [
+    [ 1.0 3.0 / drop ] collect-fp-exceptions
+    { +fp-inexact+ } set= 
+] unit-test
+
+[ t ] [
+    [ 2.0 100000.0 ^ drop ] collect-fp-exceptions
+    { +fp-inexact+ +fp-overflow+ } set= 
+] unit-test
+
+[ t ] [
+    [ 2.0 -100000.0 ^ drop ] collect-fp-exceptions
+    { +fp-inexact+ +fp-underflow+ } set= 
+] unit-test
+
+[ t ] [
+    [ -1.0 fsqrt drop ] collect-fp-exceptions
+    { +fp-invalid-operation+ } set= 
+] unit-test
+
+[
+    HEX: 3fd5,5555,5555,5555
+    HEX: 3fc9,9999,9999,999a
+    HEX: bfc9,9999,9999,999a
+    HEX: bfd5,5555,5555,5555
+] [
+    +round-nearest+ [
+         1.0 3.0 /f double>bits
+         1.0 5.0 /f double>bits
+        -1.0 5.0 /f double>bits
+        -1.0 3.0 /f double>bits
+    ] with-rounding-mode
+] unit-test
+
+[
+    HEX: 3fd5,5555,5555,5555
+    HEX: 3fc9,9999,9999,9999
+    HEX: bfc9,9999,9999,999a
+    HEX: bfd5,5555,5555,5556
+] [
+    +round-down+ [
+         1.0 3.0 /f double>bits
+         1.0 5.0 /f double>bits
+        -1.0 5.0 /f double>bits
+        -1.0 3.0 /f double>bits
+    ] with-rounding-mode
+] unit-test
+
+[
+    HEX: 3fd5,5555,5555,5556
+    HEX: 3fc9,9999,9999,999a
+    HEX: bfc9,9999,9999,9999
+    HEX: bfd5,5555,5555,5555
+] [
+    +round-up+ [
+         1.0 3.0 /f double>bits
+         1.0 5.0 /f double>bits
+        -1.0 5.0 /f double>bits
+        -1.0 3.0 /f double>bits
+    ] with-rounding-mode
+] unit-test
+
+[
+    HEX: 3fd5,5555,5555,5555
+    HEX: 3fc9,9999,9999,9999
+    HEX: bfc9,9999,9999,9999
+    HEX: bfd5,5555,5555,5555
+] [
+    +round-zero+ [
+         1.0 3.0 /f double>bits
+         1.0 5.0 /f double>bits
+        -1.0 5.0 /f double>bits
+        -1.0 3.0 /f double>bits
+    ] with-rounding-mode
+] unit-test
+
+! ensure rounding mode is restored to +round-nearest+
+[
+    HEX: 3fd5,5555,5555,5555
+    HEX: 3fc9,9999,9999,999a
+    HEX: bfc9,9999,9999,999a
+    HEX: bfd5,5555,5555,5555
+] [
+     1.0 3.0 /f double>bits
+     1.0 5.0 /f double>bits
+    -1.0 5.0 /f double>bits
+    -1.0 3.0 /f double>bits
+] unit-test
+
+[
+    HEX: 0000,0000,0000,07e8
+] [
+    +denormal-keep+ [
+        10.0 -320.0 ^ double>bits
+    ] with-denormal-mode
+] unit-test
+
+[
+    HEX: 0000,0000,0000,0000
+] [
+    +denormal-flush+ [
+        10.0 -320.0 ^ double>bits
+    ] with-denormal-mode
+] unit-test
+
+! ensure denormal mode is restored to +denormal-keep+
+[
+    HEX: 0000,0000,0000,07e8
+] [
+    +denormal-keep+ [
+        10.0 -320.0 ^ double>bits
+    ] with-denormal-mode
+] unit-test
+