basis: Add unit-test~ and unit-test-v~ for testing floats.

Use unit-test~ in math.functions in some places to make sure we like it.

diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor
index f0f3930c838768de00c64ad0806086f1ca1ec47f..3cb2febf54edd5f8c94660ffb7e874aafb03be69 100644 (file)
--- a/basis/math/functions/functions-tests.factor
+++ b/basis/math/functions/functions-tests.factor
@@ -82,11 +82,11 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11
 { 4.0 } [ 10000.0 log10 ] unit-test
 { $ log10-factorial-1000 t } [ 1000 factorial [ log10 ] [ bignum? ] bi ] unit-test
 
-{ t } [ 1 e^ e 1.e-10 ~ ] unit-test
-{ f } [ 1 e^ 0/0. 1.e-10 ~ ] unit-test
-{ f } [ 0/0. 1 e^ 1.e-10 ~ ] unit-test
-{ t } [ 1.0 e^ e 1.e-10 ~ ] unit-test
-{ t } [ -1 e^ e * 1.0 1.e-10 ~ ] unit-test
+{ e 1.e-10 } [ 1 e^ ] unit-test~
+{ 0/0. 1.e-10 } [ 1 e^ ] unit-test~
+{ 1.e-10 } [ 0/0. 1 e^ ] unit-test~
+{ e 1.e-10 } [ 1.0 e^ ] unit-test~
+{ 1.0 1.e-10 } [ -1 e^ e * ] unit-test~
 { f } [ 1/0. 1/0. 1.e-10 ~ ] unit-test
 { f } [ 1/0. -1/0. 1.e-10 ~ ] unit-test
 { f } [ 1/0. 0/0. 1.e-10 ~ ] unit-test
@@ -120,12 +120,13 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11
 { f } [ 10 atanh real? ] unit-test
 { f } [ 10.0 atanh real? ] unit-test
 
-{ t } [ 10 asin sin 10 1.e-10 ~ ] unit-test
+{ 10 1.e-10 } [ 10 asin sin ] unit-test~
+{ -100 1.e-10 } [ -100 atan tan ] unit-test~
+{ 10 1.e-10 } [ 10 asinh sinh ] unit-test~
+{ 10 1.e-10 } [ 10 atanh tanh ] unit-test~
+{ 0.5 1.e-10 } [ 0.5 atanh tanh ] unit-test~
+
 { t } [ -1 sqrt neg dup acos cos 1.e-10 ~ ] unit-test
-{ t } [ -100 atan tan -100 1.e-10 ~ ] unit-test
-{ t } [ 10 asinh sinh 10 1.e-10 ~ ] unit-test
-{ t } [ 10 atanh tanh 10 1.e-10 ~ ] unit-test
-{ t } [ 0.5 atanh tanh 0.5 1.e-10 ~ ] unit-test
 
 { t } [ 0 42 divisor? ] unit-test
 { t } [ 42 7 divisor? ] unit-test

diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index ec19c5a54e2b8e63ffd13a96478153b18c2e0a80..ab19faf078115ea87ad868545c89f0fad65ea075 100644 (file)
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math kernel math.constants math.private math.bits
-math.libm combinators fry math.order sequences ;
+USING: combinators fry kernel math math.bits math.constants
+math.libm math.order math.private sequences ;
 IN: math.functions
 
 GENERIC: sqrt ( x -- y ) foldable

diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor
index ee5ef0de0509686b6689fee6427b14a3128eac77..8473b2d70f7d50f317279e2129a3168fe844ef41 100644 (file)
--- a/basis/tools/test/test.factor
+++ b/basis/tools/test/test.factor
@@ -3,11 +3,11 @@
 USING: accessors arrays assocs combinators command-line
 compiler.units continuations debugger effects fry
 generalizations io io.files.temp io.files.unique kernel lexer
-locals macros namespaces parser prettyprint quotations sequences
-sequences.generalizations source-files source-files.errors
-source-files.errors.debugger splitting stack-checker summary
-system tools.errors unicode vocabs vocabs.files vocabs.metadata
-vocabs.parser words ;
+locals macros math.functions math.vectors namespaces parser
+prettyprint quotations sequences sequences.generalizations
+source-files source-files.errors source-files.errors.debugger
+splitting stack-checker summary system tools.errors unicode
+vocabs vocabs.files vocabs.metadata vocabs.parser words ;
 FROM: vocabs.hierarchy => load ;
 IN: tools.test
 
@@ -64,6 +64,18 @@ SYMBOL: current-test-file
 : (long-unit-test) ( output input -- error/f failed? tested? )
     long-unit-tests-enabled? get [ (unit-test) ] [ 2drop f f f ] if ;
 
+: (unit-test-comparator) ( output input comparator -- error/f failed? tested? )
+    swapd '[
+        { } _ with-datastack
+        _ >quotation _ compose with-datastack f
+    ] [ t ] recover t ; inline
+
+: (unit-test~) ( output input -- error/f failed? tested? )
+    [ ~ ] (unit-test-comparator) ;
+
+: (unit-test-v~) ( output input -- error/f failed? tested? )
+    [ v~ ] (unit-test-comparator) ;
+
 : short-effect ( effect -- pair )
     [ in>> length ] [ out>> length ] bi 2array ;
 
@@ -172,6 +184,9 @@ PRIVATE>
     [ cleanup-unique-directory ] with-temp-directory ; inline
 
 TEST: unit-test
+TEST: unit-test~
+TEST: unit-test-v~
+TEST: unit-test-comparator
 TEST: long-unit-test
 TEST: must-infer-as
 TEST: must-infer