math.functions: fix ~ with negative (relative) tolerance

diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor
index fa880f77af5593c16471b3c597272dbaa6ec2d4f..4502e993a3575faa8d61e3e6eac6a5cddf4945c3 100644 (file)
--- a/basis/math/functions/functions-tests.factor
+++ b/basis/math/functions/functions-tests.factor
@@ -6,6 +6,10 @@ IN: math.functions.tests
 [ t ] [ 4.0000001 4.0000001 .000001 ~ ] unit-test
 [ f ] [ -4.0000001 4.0000001 .00001 ~ ] unit-test
 [ t ] [ -.0000000000001 0 .0000000001 ~ ] unit-test
+[ t ] [ 100 101 -.9 ~ ] unit-test
+[ f ] [ 100 120 -.09 ~ ] unit-test
+[ t ] [ 0 0 -.9 ~ ] unit-test
+[ f ] [ 0 10 -.9 ~ ] unit-test
 
 ! Lets get the argument order correct, eh?
 [ 0.0 ] [ 0.0 1.0 fatan2 ] unit-test

diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index f124c202b833025d78ca9c5b4e7d8ff45241c6fd..a31b6ee7cc9457911c1ddb89c9825dec70a762a7 100644 (file)
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -137,13 +137,13 @@ M: real absq sq ; inline
     [ - abs ] dip < ;
 
 : ~rel ( x y epsilon -- ? )
-    [ [ - abs ] 2keep [ abs ] bi@ + ] dip * < ;
+    [ [ - abs ] 2keep [ abs ] bi@ + ] dip * <= ;
 
 : ~ ( x y epsilon -- ? )
     {
         { [ 2over [ fp-nan? ] either? ] [ 3drop f ] }
         { [ dup zero? ] [ drop number= ] }
-        { [ dup 0 < ] [ ~rel ] }
+        { [ dup 0 < ] [ neg ~rel ] }
         [ ~abs ]
     } cond ;