From 0c840a796560f3e9b78a46afc8853e8e1eb088e0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 13 Nov 2010 16:02:12 -0800
Subject: [PATCH] math.integers: bignum/f rounding was wrong (reported by Joe
 Groff)

---
 core/math/integers/integers-tests.factor | 10 ++++++++--
 core/math/integers/integers.factor       |  7 ++++++-
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/core/math/integers/integers-tests.factor b/core/math/integers/integers-tests.factor
index 6f57b06658..85cd63463c 100644
--- a/core/math/integers/integers-tests.factor
+++ b/core/math/integers/integers-tests.factor
@@ -216,8 +216,8 @@ unit-test
 
 : random-integer ( -- n )
     32 random-bits
-    1 random zero? [ neg ] when
-    1 random zero? [ >bignum ] when ;
+    { t f } random [ neg ] when
+    { t f } random [ >bignum ] when ;
 
 [ t ] [
     10000 [
@@ -232,5 +232,11 @@ unit-test
 [ HEX: 1.758bec11492f9p-54 ] [ 1 12345678901234567 /f ] unit-test
 [ HEX: -1.758bec11492f9p-54 ] [ 1 -12345678901234567 /f ] unit-test
 
+! Ensure that /f rounds to nearest and not to zero
+[ HEX: 1.0p55 ] [ HEX: 7f,ffff,ffff,ffff >bignum 1 /f ] unit-test
+[ HEX: 1.0p55 ] [ HEX: -7f,ffff,ffff,ffff >bignum -1 /f ] unit-test
+[ HEX: -1.0p55 ] [ HEX: -7f,ffff,ffff,ffff >bignum 1 /f ] unit-test
+[ HEX: -1.0p55 ] [ HEX: 7f,ffff,ffff,ffff >bignum -1 /f ] unit-test
+
 [ 17 ] [ 17 >bignum 5 max ] unit-test
 [ 5 ] [ 17 >bignum 5 min ] unit-test
diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor
index a3be60ed35..22fe01f1ab 100644
--- a/core/math/integers/integers.factor
+++ b/core/math/integers/integers.factor
@@ -140,13 +140,18 @@ M: bignum (log2) bignum-log2 ; inline
     [ 2/ ] dip over log2 52 > [ [ 2/ ] [ 1 + ] bi* ] when
     [ unscaled-float ] dip scale-float ; inline
 
+: round-to-nearest ( fraction-and-guard rem -- fraction-and-guard' )
+    over odd?
+    [ zero? [ dup zero? [ 1 + ] unless ] [ 1 + ] if ] [ drop ] if ;
+    inline
+
 ! Main word
 : /f-abs ( m n -- f )
     over zero? [ nip zero? 0/0. 0.0 ? ] [
         [ drop 1/0. ] [
             pre-scale
             /f-loop
-            [ over odd? [ zero? [ 1 + ] unless ] [ drop ] if ] dip
+            [ round-to-nearest ] dip
             post-scale
         ] if-zero
     ] if ; inline