math.integers: bignum/f rounding was wrong (reported by Joe Groff)

diff --git a/core/math/integers/integers-tests.factor b/core/math/integers/integers-tests.factor
index 6f57b06658e4b595732f99bd0a445ee963e1fbda..85cd63463c582b238b61f124d4de63837d8d4ca0 100644 (file)
--- 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 a3be60ed35ac9629eed7615e85b761769cb2dba6..22fe01f1ab743dd37060b1994554207736e6dca1 100644 (file)
--- 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