Skip to content

R
riscv-gcc-1
Commit 7ddc639b by Nicolas Roche Committed by Pierre-Marie de Rodat
Options

[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
parent 52860cc1
Showing with 100 additions and 51 deletions
gcc/ada/ChangeLog
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.
......
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.
......@@ -97,55 +94,49 @@ package body System.Val_Real is
procedure Scanf is
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;
-- Here for a non-zero digit
if Uval_Tmp > Precision_Limit then
Precision_Limit_Reached := True;
end if;
end if;
else
-- First deal with any previously saved zeroes
if Precision_Limit_Reached then
-- If beyond precision of the mantissa then just update
-- the scale and discard remaining digits.
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;
......
gcc/testsuite/ChangeLog
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,
......
gcc/testsuite/gnat.dg/float_value1.adb 0 → 100644
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment