erts: Fix float_to_list(F, [{decimals,D}]).

Example symptom:
1> float_to_list(0.145, [{decimals,1}]).
"0.2"

There were two problems in sys_double_to_chars_fast

1. Most serious was adding 0.55555555 / (10^D) instead of 0.5 / (10^D)
   which imposed a 5.5% risk of a faulty rounding up.

2. Using fixpoint for frac_part which lost significant bits if F < 0.5

2 files changed, 84 insertions, 15 deletions

diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c
index 79f87eb3a9..ddb414580a 100644
--- a/erts/emulator/sys/common/erl_sys_common_misc.c
+++ b/erts/emulator/sys/common/erl_sys_common_misc.c
@@ -160,7 +160,7 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals,
 {
     /* Note that some C compilers don't support "static const" propagation
      * so we use a defines */
-    #define SYS_DOUBLE_RND_CONST 0.55555555555555555
+    #define SYS_DOUBLE_RND_CONST 0.5
     #define FRAC_SIZE            52
     #define EXP_SIZE             11
     #define EXP_MASK             ((1ll << EXP_SIZE) - 1)
@@ -256,11 +256,14 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals,
         return p - buffer;
     } else if (exp >= FRAC_SIZE) {
         int_part  = mantissa << (exp - FRAC_SIZE);
+        exp = 0;
     } else if (exp >= 0) {
         int_part  = mantissa >> (FRAC_SIZE - exp);
         frac_part = (mantissa << (exp + 1)) & FRAC_MASK2;
+        exp = 0;
     } else /* if (exp < 0) */ {
-        frac_part = (mantissa & FRAC_MASK2) >> -(exp + 1);
+        frac_part = mantissa;
+        exp = -(exp+1);
     }
 
     if (!int_part) {
@@ -298,11 +301,22 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals,
         max = decimals;
 
         for (i = 0; i < max; i++) {
-            /* frac_part *= 10; */
-            frac_part = (frac_part << 3) + (frac_part << 1);
-
-            *p++ = (char)((frac_part >> (FRAC_SIZE + 1)) + '0');
-            frac_part &= FRAC_MASK2;
+            if (frac_part > (ERTS_UINT64_MAX/16)) {
+                frac_part /= 16;
+                exp -= 4;
+            }
+            if (FRAC_SIZE + 1 + exp >= 64) {
+                *p++ = '0';
+                frac_part *= 5;
+                exp--;
+            }
+            else
+            {
+                frac_part *= 10;
+
+                *p++ = (char)((frac_part >> (FRAC_SIZE + 1 + exp)) + '0');
+                frac_part &= (1ll << (FRAC_SIZE + 1 + exp)) - 1;
+            }
         }
 
         /* Delete trailing zeroes */
diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl
index 1c76eb8019..b5ff940e00 100644
--- a/erts/emulator/test/num_bif_SUITE.erl
+++ b/erts/emulator/test/num_bif_SUITE.erl
@@ -118,6 +118,7 @@ t_float(Config) when is_list(Config) ->
 %% Tests float_to_list/1, float_to_list/2, float_to_binary/1, float_to_binary/2
 
 t_float_to_string(Config) when is_list(Config) ->
+    rand_seed(),
     test_fts("0.00000000000000000000e+00", 0.0),
     test_fts("2.50000000000000000000e+01", 25.0),
     test_fts("2.50000000000000000000e+00", 2.5),
@@ -167,8 +168,8 @@ t_float_to_string(Config) when is_list(Config) ->
     test_fts("1.12300",1.123, [{decimals, 5}]),
     test_fts("1.123",1.123, [{decimals, 5}, compact]),
     test_fts("1.1234",1.1234,[{decimals, 6}, compact]),
-    test_fts("1.01",1.005, [{decimals, 2}]),
-    test_fts("-1.01",-1.005,[{decimals, 2}]),
+    test_fts("1.00",1.005, [{decimals, 2}]),  %% 1.005 is really 1.0049999999...
+    test_fts("-1.00",-1.005,[{decimals, 2}]),
     test_fts("0.999",0.999, [{decimals, 3}]),
     test_fts("-0.999",-0.999,[{decimals, 3}]),
     test_fts("1.0",0.999, [{decimals, 2}, compact]),
@@ -184,6 +185,9 @@ t_float_to_string(Config) when is_list(Config) ->
     test_fts("123000000000000000000.0",1.23e20, [{decimals,   10}, compact]),
     test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]),
     test_fts("1.23000000000000000000e+20",1.23e20, []),
+
+    fts_rand_float_decimals(1000),
+
     ok.
 
 test_fts(Expect, Float) ->
@@ -197,6 +201,49 @@ test_fts(Expect, Float, Args) ->
     BinExpect = float_to_binary(Float,Args).
 
 
+rand_float_reasonable() ->
+    F = rand_float(),
+    case abs(F) > 1.0e238 of
+        true -> rand_float_reasonable();
+        false -> F
+    end.
+
+fts_rand_float_decimals(0) -> ok;
+fts_rand_float_decimals(N) ->
+    [begin
+         F0 = rand_float_reasonable(),
+         L0 = float_to_list(F0, [{decimals, D}]),
+         L1 = case D of
+                  0 -> L0 ++ ".0";
+                  _ -> L0
+              end,
+         F1 = list_to_float(L1),
+         Diff = abs(F0-F1),
+         MaxDiff = max_diff_decimals(F0, D),
+         ok = case Diff =< MaxDiff of
+                  true -> ok;
+                  false ->
+                      io:format("F0 = ~w ~w\n",  [F0, <<F0/float>>]),
+                      io:format("L1 = ~s\n",  [L1]),
+                      io:format("F1 = ~w ~w\n",  [F1, <<F1/float>>]),
+                      io:format("Diff = ~w, MaxDiff = ~w\n", [Diff, MaxDiff]),
+                      error
+              end
+     end
+     || D <- lists:seq(0,15)],
+
+    fts_rand_float_decimals(N-1).
+
+max_diff_decimals(F, D) ->
+    IntBits = floor(math:log2(abs(F))) + 1,
+    FracBits = (52 - IntBits),
+    Log10_2 = 0.3010299956639812,  % math:log10(2)
+    MaxDec = floor(FracBits * Log10_2),
+
+    Resolution = math:pow(2, IntBits - 53),
+
+    (math:pow(10, -min(D,MaxDec)) / 2) + Resolution.
+
 %% Tests list_to_float/1.
 
 t_string_to_float_safe(Config) when is_list(Config) ->
@@ -331,18 +378,26 @@ t_trunc_and_friends(_Config) ->
     -18446744073709551616 = trunc_and_friends(-float(1 bsl 64)),
 
     %% Random.
+    rand_seed(),
     t_trunc_and_friends_rand(100),
     ok.
 
+rand_seed() ->
+    rand:seed(exrop),
+    io:format("\n*** rand:export_seed() = ~w\n\n", [rand:export_seed()]),
+    ok.
+
+rand_float() ->
+    F0 = rand:uniform() * math:pow(10, 50*rand:normal()),
+    case rand:uniform() of
+        U when U < 0.5 -> -F0;
+        _ -> F0
+    end.
+
 t_trunc_and_friends_rand(0) ->
     ok;
 t_trunc_and_friends_rand(N) ->
-    F0 = rand:uniform() * math:pow(10, 50*rand:normal()),
-    F = case rand:uniform() of
-	    U when U < 0.5 -> -F0;
-	    _ -> F0
-	end,
-    _ = trunc_and_friends(F),
+    _ = trunc_and_friends(rand_float()),
     t_trunc_and_friends_rand(N-1).
 
 trunc_and_friends(F) ->