From 7ddc639b7717278075ab1989568d1769ccc040e1 Mon Sep 17 00:00:00 2001 From: Nicolas Roche Date: Mon, 22 Jul 2019 13:56:59 +0000 Subject: [PATCH] [Ada] Ensure meaningless digits in a string are discarded 2019-07-22 Nicolas Roche 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 --- gcc/ada/ChangeLog | 5 ++ gcc/ada/libgnat/s-valrea.adb | 98 ++++++++++++-------------- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gnat.dg/float_value1.adb | 46 ++++++++++++ 4 files changed, 101 insertions(+), 52 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/float_value1.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cf8b1711c3f..276fdba9852 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-07-22 Nicolas Roche + + * libgnat/s-valrea.adb (Scan_Real): Ignore non significative + digits to avoid converging to infinity in some cases. + 2019-07-22 Eric Botcazou * 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 9039f998884..99c736046fd 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 1E-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 6dbdc4360e3..d49f01851d3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-07-22 Nicolas Roche + + * gnat.dg/float_value1.adb: New testcase. + 2019-07-22 Eric Botcazou * 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 00000000000..8e36767bf6b --- /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; -- 2.30.2