[Ada] Ensure meaningless digits in a string are discarded

2019-07-22  Nicolas Roche  <roche@adacore.com>

gcc/ada/

	* libgnat/s-valrea.adb (Scan_Real): Ignore non significative
	digits to avoid converging to infinity in some cases.

gcc/testsuite/

	* gnat.dg/float_value1.adb: New testcase.

From-SVN: r273675

4 files changed, 101 insertions, 52 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cf8b171..276fdba 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-22  Nicolas Roche  <roche@adacore.com>
+
+	* libgnat/s-valrea.adb (Scan_Real): Ignore non significative
+	digits to avoid converging to infinity in some cases.
+
 2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* libgnat/g-encstr.adb (Encode_Wide_String): Fix oversight.
diff --git a/gcc/ada/libgnat/s-valrea.adb b/gcc/ada/libgnat/s-valrea.adb
index 9039f99..99c7360 100644
--- a/gcc/ada/libgnat/s-valrea.adb
+++ b/gcc/ada/libgnat/s-valrea.adb
@@ -71,16 +71,13 @@ package body System.Val_Real is
       After_Point : Natural := 0;
       --  Set to 1 after the point
 
-      Num_Saved_Zeroes : Natural := 0;
-      --  This counts zeroes after the decimal point. A non-zero value means
-      --  that this number of previously scanned digits are zero. If the end
-      --  of the number is reached, these zeroes are simply discarded, which
-      --  ensures that trailing zeroes after the point never affect the value
-      --  (which might otherwise happen as a result of rounding). With this
-      --  processing in place, we can ensure that, for example, we get the
-      --  same exact result from 1.0E+49 and 1.0000000E+49. This is not
-      --  necessarily required in a case like this where the result is not
-      --  a machine number, but it is certainly a desirable behavior.
+      Precision_Limit : constant Long_Long_Float :=
+         2.0 ** (Long_Long_Float'Machine_Mantissa - 1);
+      --  This is an upper bound for the number of bits used to represent the
+      --  mantissa. Beyond that number, any digits parsed by Scanf are useless.
+      --  Thus, only the scale should be updated. This ensures that infinity is
+      --  not reached by the temporary Uval, which could lead to erroneous
+      --  rounding (for example: 0.4444444... or 1<n zero>E-n).
 
       procedure Scanf;
       --  Scans integer literal value starting at current character position.
@@ -96,56 +93,50 @@ package body System.Val_Real is
       -----------
 
       procedure Scanf is
-         Digit : Natural;
-
+         Digit                   : Natural;
+         Uval_Tmp                : Long_Long_Float;
+         Precision_Limit_Reached : Boolean := False;
       begin
          loop
             Digit := Character'Pos (Str (P)) - Character'Pos ('0');
-            P := P + 1;
-
-            --  Save up trailing zeroes after the decimal point
-
-            if Digit = 0 and then After_Point = 1 then
-               Num_Saved_Zeroes := Num_Saved_Zeroes + 1;
-
-            --  Here for a non-zero digit
-
-            else
-               --  First deal with any previously saved zeroes
-
-               if Num_Saved_Zeroes /= 0 then
-                  while Num_Saved_Zeroes > Maxpow loop
-                     Uval := Uval * Powten (Maxpow);
-                     Num_Saved_Zeroes := Num_Saved_Zeroes - Maxpow;
-                     Scale := Scale - Maxpow;
-                  end loop;
 
-                  Uval := Uval * Powten (Num_Saved_Zeroes);
-                  Scale := Scale - Num_Saved_Zeroes;
+            if not Precision_Limit_Reached then
+               --  Compute potential new value
+               Uval_Tmp := Uval * 10.0 + Long_Long_Float (Digit);
 
-                  Num_Saved_Zeroes := 0;
+               if Uval_Tmp > Precision_Limit then
+                  Precision_Limit_Reached := True;
                end if;
+            end if;
 
-               --  Accumulate new digit
-
-               Uval := Uval * 10.0 + Long_Long_Float (Digit);
+            if Precision_Limit_Reached then
+               --  If beyond the precision of the mantissa then just ignore the
+               --  digit, to avoid rounding issues.
+               if After_Point = 0 then
+                  Scale := Scale + 1;
+               end if;
+            else
+               Uval := Uval_Tmp;
                Scale := Scale - After_Point;
             end if;
 
-            --  Done if end of input field
+            --  Check next character
+            P := P + 1;
 
             if P > Max then
+               --  Done if end of input field
                return;
 
-            --  Check next character
-
             elsif Str (P) not in Digs then
+               --  If next character is not a digit, check if this is an
+               --  underscore. If this is not the case, then return.
                if Str (P) = '_' then
                   Scan_Underscore (Str, P, Ptr, Max, False);
                else
                   return;
                end if;
             end if;
+
          end loop;
       end Scanf;
 
@@ -198,7 +189,8 @@ package body System.Val_Real is
             Base_Char : constant Character := Str (P);
             Digit     : Natural;
             Fdigit    : Long_Long_Float;
-
+            Uval_Tmp  : Long_Long_Float;
+            Precision_Limit_Reached : Boolean := False;
          begin
             --  Set bad base if out of range, and use safe base of 16.0,
             --  to guard against division by zero in the loop below.
@@ -243,22 +235,24 @@ package body System.Val_Real is
                   Bad_Value (Str);
                end if;
 
-               --  Save up trailing zeroes after the decimal point
+               if not Precision_Limit_Reached then
+                  --  Compute potential new value
+                  Uval_Tmp := Uval * Base + Long_Long_Float (Digit);
 
-               if Digit = 0 and then After_Point = 1 then
-                  Num_Saved_Zeroes := Num_Saved_Zeroes + 1;
+                  if Uval_Tmp > Precision_Limit then
+                     Precision_Limit_Reached := True;
+                  end if;
+               end if;
 
-               --  Here for a non-zero digit
+               if Precision_Limit_Reached then
+                  --  If beyond precision of the mantissa then just update
+                  --  the scale and discard remaining digits.
 
-               else
-                  --  First deal with any previously saved zeroes
-
-                  if Num_Saved_Zeroes /= 0 then
-                     Uval := Uval * Base ** Num_Saved_Zeroes;
-                     Scale := Scale - Num_Saved_Zeroes;
-                     Num_Saved_Zeroes := 0;
+                  if After_Point = 0 then
+                     Scale := Scale + 1;
                   end if;
 
+               else
                   --  Now accumulate the new digit
 
                   Fdigit := Long_Long_Float (Digit);
@@ -267,7 +261,7 @@ package body System.Val_Real is
                      Bad_Base := True;
                   else
                      Scale := Scale - After_Point;
-                     Uval := Uval * Base + Fdigit;
+                     Uval := Uval_Tmp;
                   end if;
                end if;
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6dbdc43..d49f018 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-22  Nicolas Roche  <roche@adacore.com>
+
+	* gnat.dg/float_value1.adb: New testcase.
+
 2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gnat.dg/encode_string1.adb, gnat.dg/encode_string1_pkg.adb,
diff --git a/gcc/testsuite/gnat.dg/float_value1.adb b/gcc/testsuite/gnat.dg/float_value1.adb
new file mode 100644
index 0000000..8e36767
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/float_value1.adb
@@ -0,0 +1,46 @@
+--  { dg-do run }
+
+with Ada.Strings.Fixed; use Ada.Strings.Fixed;
+
+procedure Float_Value1 is
+   Str1 : String := "0." & 50000 * "4";
+   Str2 : String := "1." & 5000 * "4";
+   Str3 : String := "16#0." & 500000 * "4" & "#";
+   Str4 : String := "1" & (5000 * "0") & "E-5000";
+   Str5 : String := "1" & "." & 50000 * "0" & "1";
+   Str6 : String := 50000 * "0" & "." & 50000 * "2" & "1";
+   Str7 : String := "1" & (5000 * "0") & "1" & "E-5000";
+   Str8 : String := "16#1" & "." & 50000 * "0" & "1#";
+
+   procedure Test (Msg, Str, Expected : String) is
+      Number     : Long_Long_Float;
+   begin
+      Number := Long_Long_Float'Value (Str);
+      if Number'Img /= Expected then
+         raise Program_Error;
+      end if;
+   end Test;
+
+begin
+   Test ("0.4444...[50000 times]   ", Str1, " 4.44444444444444444E-01");
+   Test ("1.4...[5000 times]       ", Str2, " 1.44444444444444444E+00");
+   Test ("16#0.[50000 '4']#        ", Str3, " 2.66666666666666667E-01");
+   Test ("1[5000 zeros]E-5000      ", Str4, " 1.00000000000000000E+00");
+   Test ("1.[50000zeros]1          ", Str5, " 1.00000000000000000E+00");
+   Test ("[50000zeros].[50000 '2']1", Str6, " 2.22222222222222222E-01");
+   Test ("1[50000zeros]1.E-5000    ", Str7, " 1.00000000000000000E+01");
+   Test ("16#1.[50000zeros]1#      ", Str8, " 1.00000000000000000E+00");
+
+   --  Check that number of trailing zero after point does not change
+   --  the value
+
+   for J in 1 .. 10000 loop
+      declare
+         Str : String := "0.1" & J * "0";
+      begin
+         if Long_Long_Float'Value (Str) /= 0.1 then
+            raise Program_Error;
+         end if;
+      end;
+   end loop;
+end Float_Value1;