From fe0701deb10b60a800315b8c31ba91ebe9c1c3db Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 22 Sep 2009 03:19:47 -0500
Subject: [PATCH] math.functions: fix ~ with negative (relative) tolerance

---
 basis/math/functions/functions-tests.factor | 4 ++++
 basis/math/functions/functions.factor       | 4 ++--
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor
index fa880f77af..4502e993a3 100644
--- 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 f124c202b8..a31b6ee7cc 100644
--- 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 ;