From: Nicolas Roche Date: Wed, 18 Sep 2019 08:32:23 +0000 (+0000) Subject: [Ada] Ensure that Scan_Real result does not depend on trailing zeros X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b67723ddeea0206e68f122a26b1a7b46382b79e7;p=gcc.git [Ada] Ensure that Scan_Real result does not depend on trailing zeros Previous change in that procedure to handle overflow issues during scanning removed the special handling for trailing zeros in the decimal part. Beside the absence of overflow during scanning the special handling of these zeros is still necessary. 2019-09-18 Nicolas Roche gcc/ada/ * libgnat/s-valrea.adb (Scan_Integral_Digits): New procedure. (Scan_Decimal_Digits): New procedure. (As_Digit): New function. (Scan_Real): Use Scan_Integral_Digits and Scan_Decimal_Digits. gcc/testsuite/ * gnat.dg/float_value2.adb: New testcase. From-SVN: r275849 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b5c319b2e08..e77725c2c29 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-09-18 Nicolas Roche + + * libgnat/s-valrea.adb (Scan_Integral_Digits): New procedure. + (Scan_Decimal_Digits): New procedure. + (As_Digit): New function. + (Scan_Real): Use Scan_Integral_Digits and Scan_Decimal_Digits. + 2019-09-18 Claire Dross * exp_attr.adb (Expand_N_Attribute_Reference): Call routine from diff --git a/gcc/ada/libgnat/s-valrea.adb b/gcc/ada/libgnat/s-valrea.adb index 99c736046fd..519e369d94f 100644 --- a/gcc/ada/libgnat/s-valrea.adb +++ b/gcc/ada/libgnat/s-valrea.adb @@ -29,346 +29,469 @@ -- -- ------------------------------------------------------------------------------ -with System.Powten_Table; use System.Powten_Table; with System.Val_Util; use System.Val_Util; with System.Float_Control; package body System.Val_Real is - --------------- - -- Scan_Real -- - --------------- + procedure Scan_Integral_Digits + (Str : String; + Index : in out Integer; + Max : Integer; + Value : out Long_Long_Integer; + Scale : out Integer; + Base_Violation : in out Boolean; + Base : Long_Long_Integer := 10; + Base_Specified : Boolean := False); + -- Scan the integral part of a real (i.e: before decimal separator) + -- + -- The string parsed is Str (Index .. Max), and after the call Index will + -- point to the first non parsed character. + -- + -- For each digit parsed either value := value * base + digit, or scale + -- is incremented by 1. + -- + -- Base_Violation will be set to True a digit found is not part of the Base + + procedure Scan_Decimal_Digits + (Str : String; + Index : in out Integer; + Max : Integer; + Value : in out Long_Long_Integer; + Scale : in out Integer; + Base_Violation : in out Boolean; + Base : Long_Long_Integer := 10; + Base_Specified : Boolean := False); + -- Scan the decimal part of a real (i.e: after decimal separator) + -- + -- The string parsed is Str (Index .. Max), and after the call Index will + -- point to the first non parsed character. + -- + -- For each digit parsed value = value * base + digit and scale is + -- decremented by 1. If precision limit is reached remaining digits are + -- still parsed but ignored. + -- + -- Base_Violation will be set to True a digit found is not part of the Base + + subtype Char_As_Digit is Long_Long_Integer range -2 .. 15; + subtype Valid_Digit is Char_As_Digit range 0 .. Char_As_Digit'Last; + Underscore : constant Char_As_Digit := -2; + E_Digit : constant Char_As_Digit := 14; + + function As_Digit (C : Character) return Char_As_Digit; + -- Given a character return the digit it represent. If the character is + -- not a digit then a negative value is returned, -2 for underscore and + -- -1 for any other character. + + Precision_Limit : constant Long_Long_Integer := + 2 ** (Long_Long_Float'Machine_Mantissa - 1) - 1; + -- This is an upper bound for the number of bits used to represent the + -- mantissa. Beyond that number, any digits parsed are useless. + + -------------- + -- As_Digit -- + -------------- + + function As_Digit (C : Character) return Char_As_Digit + is + begin + case C is + when '0' .. '9' => + return Character'Pos (C) - Character'Pos ('0'); + when 'a' .. 'f' => + return Character'Pos (C) - (Character'Pos ('a') - 10); + when 'A' .. 'F' => + return Character'Pos (C) - (Character'Pos ('A') - 10); + when '_' => + return Underscore; + when others => + return -1; + end case; + end As_Digit; + + ------------------------- + -- Scan_Decimal_Digits -- + ------------------------- + + procedure Scan_Decimal_Digits + (Str : String; + Index : in out Integer; + Max : Integer; + Value : in out Long_Long_Integer; + Scale : in out Integer; + Base_Violation : in out Boolean; + Base : Long_Long_Integer := 10; + Base_Specified : Boolean := False) - function Scan_Real - (Str : String; - Ptr : not null access Integer; - Max : Integer) return Long_Long_Float is - P : Integer; - -- Local copy of string pointer + Precision_Limit_Reached : Boolean := False; + -- Set to True if addition of a digit will cause Value to be superior + -- to Precision_Limit. - Base : Long_Long_Float; - -- Base value + Digit : Char_As_Digit; + -- The current digit. - Uval : Long_Long_Float; - -- Accumulated float result + Trailing_Zeros : Natural := 0; + -- Number of trailing zeros at a given point. + begin - subtype Digs is Character range '0' .. '9'; - -- Used to check for decimal digit + -- If initial Scale is not 0 then it means that Precision_Limit was + -- reached during integral part scanning. + if Scale > 0 then + Precision_Limit_Reached := True; + end if; - Scale : Integer := 0; - -- Power of Base to multiply result by + -- The function precondition is that the first character is a valid + -- digit. + Digit := As_Digit (Str (Index)); + + loop + -- Check if base is correct. If the base is not specified the digit + -- E or e cannot be considered as a base violation as it can be used + -- for exponentiation. + if Digit >= Base then + if Base_Specified then + Base_Violation := True; + elsif Digit = E_Digit then + return; + else + Base_Violation := True; + end if; + end if; - Start : Positive; - -- Position of starting non-blank character + -- If precision limit has been reached just ignore any remaining + -- digits for the computation of Value and Scale. The scanning + -- should continue only to assess the validity of the string + if not Precision_Limit_Reached then + if Digit = 0 then + -- Trailing '0' digits are ignored unless a non-zero digit is + -- found. + Trailing_Zeros := Trailing_Zeros + 1; + else - Minus : Boolean; - -- Set to True if minus sign is present, otherwise to False + -- Handle accumulated zeros. + for J in 1 .. Trailing_Zeros loop + if Value > Precision_Limit / Base then + Precision_Limit_Reached := True; + exit; + else + Value := Value * Base; + Scale := Scale - 1; + end if; + end loop; - Bad_Base : Boolean := False; - -- Set True if Base out of range or if out of range digit - - After_Point : Natural := 0; - -- Set to 1 after the point - - 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. - -- For each digit encountered, Uval is multiplied by 10.0, and the new - -- digit value is incremented. In addition Scale is decremented for each - -- digit encountered if we are after the point (After_Point = 1). The - -- longest possible syntactically valid numeral is scanned out, and on - -- return P points past the last character. On entry, the current - -- character is known to be a digit, so a numeral is definitely present. - - ----------- - -- Scanf -- - ----------- - - 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'); - - if not Precision_Limit_Reached then - -- Compute potential new value - Uval_Tmp := Uval * 10.0 + Long_Long_Float (Digit); - - if Uval_Tmp > Precision_Limit then + -- Reset trailing zero counter + Trailing_Zeros := 0; + + -- Handle current non zero digit + if Value > (Precision_Limit - Digit) / Base then Precision_Limit_Reached := True; + else + Value := Value * Base + Digit; + Scale := Scale - 1; end if; end if; + end if; - 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; + -- Check next character + Index := Index + 1; - -- Check next character - P := P + 1; + if Index > Max then + return; + end if; - if P > Max then - -- Done if end of input field - return; + Digit := As_Digit (Str (Index)); - 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); + if Digit < 0 then + if Digit = Underscore and Index + 1 <= Max then + -- Underscore is only alllowed if followed by a digit + Digit := As_Digit (Str (Index + 1)); + if Digit in Valid_Digit then + Index := Index + 1; else return; end if; + else + -- Neither a valid underscore nor a digit. + return; end if; + end if; + end loop; + + end Scan_Decimal_Digits; + + -------------------------- + -- Scan_Integral_Digits -- + -------------------------- + + procedure Scan_Integral_Digits + (Str : String; + Index : in out Integer; + Max : Integer; + Value : out Long_Long_Integer; + Scale : out Integer; + Base_Violation : in out Boolean; + Base : Long_Long_Integer := 10; + Base_Specified : Boolean := False) + is + Precision_Limit_Reached : Boolean := False; + -- Set to True if addition of a digit will cause Value to be superior + -- to Precision_Limit. - end loop; - end Scanf; - - -- Start of processing for System.Scan_Real - + Digit : Char_As_Digit; + -- The current digit begin - -- We do not tolerate strings with Str'Last = Positive'Last - if Str'Last = Positive'Last then - raise Program_Error with - "string upper bound is Positive'Last, not supported"; - end if; - - -- We call the floating-point processor reset routine so that we can - -- be sure the floating-point processor is properly set for conversion - -- calls. This is notably need on Windows, where calls to the operating - -- system randomly reset the processor into 64-bit mode. - - System.Float_Control.Reset; - - Scan_Sign (Str, Ptr, Max, Minus, Start); - P := Ptr.all; - Ptr.all := Start; - - -- If digit, scan numeral before point - - if Str (P) in Digs then - Uval := 0.0; - Scanf; - - -- Initial point, allowed only if followed by digit (RM 3.5(47)) - - elsif Str (P) = '.' - and then P < Max - and then Str (P + 1) in Digs - then - Uval := 0.0; - - -- Any other initial character is an error - - else - Bad_Value (Str); - end if; - - -- Deal with based case. We reognize either the standard '#' or the - -- allowed alternative replacement ':' (see RM J.2(3)). - - if P < Max and then (Str (P) = '#' or else Str (P) = ':') then - declare - 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. - - if Uval < 2.0 or else Uval > 16.0 then - Bad_Base := True; - Uval := 16.0; + -- Initialize Scale and Value + Value := 0; + Scale := 0; + + -- The function precondition is that the first character is a valid + -- digit. + Digit := As_Digit (Str (Index)); + + loop + -- Check if base is correct. If the base is not specified the digit + -- E or e cannot be considered as a base violation as it can be used + -- for exponentiation. + if Digit >= Base then + if Base_Specified then + Base_Violation := True; + elsif Digit = E_Digit then + return; + else + Base_Violation := True; end if; + end if; - Base := Uval; - Uval := 0.0; - P := P + 1; - - -- Special check to allow initial point (RM 3.5(49)) - - if Str (P) = '.' then - After_Point := 1; - P := P + 1; + if Precision_Limit_Reached then + -- Precision limit has been reached so just update the exponent + Scale := Scale + 1; + else + if Value > (Precision_Limit - Digit) / Base then + -- Updating Value will overflow so ignore this digit and any + -- following ones. Only update the scale + Precision_Limit_Reached := True; + Scale := Scale + 1; + else + Value := Value * Base + Digit; end if; + end if; - -- Loop to scan digits of based number. On entry to the loop we - -- must have a valid digit. If we don't, then we have an illegal - -- floating-point value, and we raise Constraint_Error, note that - -- Ptr at this stage was reset to the proper (Start) value. - - loop - if P > Max then - Bad_Value (Str); - - elsif Str (P) in Digs then - Digit := Character'Pos (Str (P)) - Character'Pos ('0'); - - elsif Str (P) in 'A' .. 'F' then - Digit := - Character'Pos (Str (P)) - (Character'Pos ('A') - 10); + -- Look for the next character + Index := Index + 1; + if Index > Max then + return; + end if; - elsif Str (P) in 'a' .. 'f' then - Digit := - Character'Pos (Str (P)) - (Character'Pos ('a') - 10); + Digit := As_Digit (Str (Index)); + if Digit not in Valid_Digit then + -- Next character is not a digit. In that case stop scanning + -- unless the next chracter is an underscore followed by a digit. + if Digit = Underscore and Index + 1 <= Max then + Digit := As_Digit (Str (Index + 1)); + if Digit in Valid_Digit then + Index := Index + 1; else - Bad_Value (Str); + return; end if; + else + return; + end if; + end if; + end loop; - if not Precision_Limit_Reached then - -- Compute potential new value - Uval_Tmp := Uval * Base + Long_Long_Float (Digit); + end Scan_Integral_Digits; - if Uval_Tmp > Precision_Limit then - Precision_Limit_Reached := True; - end if; - end if; + --------------- + -- Scan_Real -- + --------------- - if Precision_Limit_Reached then - -- If beyond precision of the mantissa then just update - -- the scale and discard remaining digits. + function Scan_Real + (Str : String; + Ptr : not null access Integer; + Max : Integer) + return Long_Long_Float - if After_Point = 0 then - Scale := Scale + 1; - end if; + is + Start : Positive; + -- Position of starting non-blank character - else - -- Now accumulate the new digit + Minus : Boolean; + -- Set to True if minus sign is present, otherwise to False - Fdigit := Long_Long_Float (Digit); + Index : Integer; + -- Local copy of string pointer - if Fdigit >= Base then - Bad_Base := True; - else - Scale := Scale - After_Point; - Uval := Uval_Tmp; - end if; - end if; + Int_Value : Long_Long_Integer := -1; + -- Mantissa as an Integer - P := P + 1; + Int_Scale : Integer := 0; + -- Exponent value - if P > Max then - Bad_Value (Str); + Base_Violation : Boolean := False; + -- If True some digits where not in the base. The float is still scan + -- till the end even if an error will be raised. - elsif Str (P) = '_' then - Scan_Underscore (Str, P, Ptr, Max, True); + Uval : Long_Long_Float := 0.0; + -- Contain the final value at the end of the function - else - -- Skip past period after digit. Note that the processing - -- here will permit either a digit after the period, or the - -- terminating base character, as allowed in (RM 3.5(48)) + After_Point : Boolean := False; + -- True if a decimal should be parsed - if Str (P) = '.' and then After_Point = 0 then - P := P + 1; - After_Point := 1; + Base : Long_Long_Integer := 10; + -- Current base (default: 10) - if P > Max then - Bad_Value (Str); - end if; - end if; + Base_Char : Character := ASCII.NUL; + -- Character used to set the base. If Nul this means that default + -- base is used. - exit when Str (P) = Base_Char; - end if; - end loop; + begin + -- We do not tolerate strings with Str'Last = Positive'Last + + if Str'Last = Positive'Last then + raise Program_Error with + "string upper bound is Positive'Last, not supported"; + end if; - -- Based number successfully scanned out (point was found) + -- We call the floating-point processor reset routine so that we can + -- be sure the floating-point processor is properly set for conversion + -- calls. This is notably need on Windows, where calls to the operating + -- system randomly reset the processor into 64-bit mode. - Ptr.all := P + 1; - end; + System.Float_Control.Reset; - -- Non-based case, check for being at decimal point now. Note that - -- in Ada 95, we do not insist on a decimal point being present + -- Scan the optional sign + Scan_Sign (Str, Ptr, Max, Minus, Start); + Index := Ptr.all; + Ptr.all := Start; + -- First character can be either a decimal digit or a dot. + if Str (Index) in '0' .. '9' then + -- If this is a digit it can indicates either the float decimal + -- part or the base to use + Scan_Integral_Digits + (Str, + Index, + Max => Max, + Value => Int_Value, + Scale => Int_Scale, + Base_Violation => Base_Violation, + Base => 10); + elsif Str (Index) = '.' and then + -- A dot is only allowed if followed by a digit. + Index < Max and then + Str (Index + 1) in '0' .. '9' + then + -- Initial point, allowed only if followed by digit (RM 3.5(47)) + After_Point := True; + Index := Index + 1; + Int_Value := 0; else - Base := 10.0; - After_Point := 1; + Bad_Value (Str); + end if; - if P <= Max and then Str (P) = '.' then - P := P + 1; + -- Check if the first number encountered is a base + if Index < Max and then + (Str (Index) = '#' or else Str (Index) = ':') + then + Base_Char := Str (Index); + Base := Int_Value; + + -- Reset Int_Value to indicate that parsing of integral value should + -- be done + Int_Value := -1; + if Base < 2 or else Base > 16 then + Base_Violation := True; + Base := 16; + end if; - -- Scan digits after point if any are present (RM 3.5(46)) + Index := Index + 1; - if P <= Max and then Str (P) in Digs then - Scanf; - end if; + if Str (Index) = '.' and then + Index < Max and then + As_Digit (Str (Index + 1)) in Valid_Digit + then + After_Point := True; + Index := Index + 1; + Int_Value := 0; end if; - - Ptr.all := P; end if; - -- At this point, we have Uval containing the digits of the value as - -- an integer, and Scale indicates the negative of the number of digits - -- after the point. Base contains the base value (an integral value in - -- the range 2.0 .. 16.0). Test for exponent, must be at least one - -- character after the E for the exponent to be valid. - - Scale := Scale + Scan_Exponent (Str, Ptr, Max, Real => True); + -- Does scanning of integral part needed + if Int_Value < 0 then + if Index > Max or else As_Digit (Str (Index)) not in Valid_Digit then + Bad_Value (Str); + end if; - -- At this point the exponent has been scanned if one is present and - -- Scale is adjusted to include the exponent value. Uval contains the - -- the integral value which is to be multiplied by Base ** Scale. + Scan_Integral_Digits + (Str, + Index, + Max => Max, + Value => Int_Value, + Scale => Int_Scale, + Base_Violation => Base_Violation, + Base => Base, + Base_Specified => Base_Char /= ASCII.NUL); + end if; - -- If base is not 10, use exponentiation for scaling + -- Do we have a dot ? + if not After_Point and then + Index <= Max and then + Str (Index) = '.' + then + -- At this stage if After_Point was not set, this means that an + -- integral part has been found. Thus the dot is valid even if not + -- followed by a digit. + if Index < Max and then As_Digit (Str (Index + 1)) in Valid_Digit then + After_Point := True; + end if; - if Base /= 10.0 then - Uval := Uval * Base ** Scale; + Index := Index + 1; + end if; - -- For base 10, use power of ten table, repeatedly if necessary + if After_Point then + -- Parse decimal part + Scan_Decimal_Digits + (Str, + Index, + Max => Max, + Value => Int_Value, + Scale => Int_Scale, + Base_Violation => Base_Violation, + Base => Base, + Base_Specified => Base_Char /= ASCII.NUL); + end if; - elsif Scale > 0 then - while Scale > Maxpow and then Uval'Valid loop - Uval := Uval * Powten (Maxpow); - Scale := Scale - Maxpow; - end loop; + -- If an explicit base was specified ensure that the delimiter is found + if Base_Char /= ASCII.NUL then + if Index > Max or else Str (Index) /= Base_Char then + Bad_Value (Str); + else + Index := Index + 1; + end if; + end if; - -- Note that we still know that Scale > 0, since the loop - -- above leaves Scale in the range 1 .. Maxpow. + -- Compute the final value + Uval := Long_Long_Float (Int_Value); - if Uval'Valid then - Uval := Uval * Powten (Scale); - end if; + -- Update pointer and scan exponent. + Ptr.all := Index; - elsif Scale < 0 then - while (-Scale) > Maxpow and then Uval'Valid loop - Uval := Uval / Powten (Maxpow); - Scale := Scale + Maxpow; - end loop; + Int_Scale := Int_Scale + Scan_Exponent (Str, + Ptr, + Max, + Real => True); - -- Note that we still know that Scale < 0, since the loop - -- above leaves Scale in the range -Maxpow .. -1. - if Uval'Valid then - Uval := Uval / Powten (-Scale); - end if; - end if; + Uval := Uval * Long_Long_Float (Base) ** Int_Scale; -- Here is where we check for a bad based number - - if Bad_Base then + if Base_Violation then Bad_Value (Str); -- If OK, then deal with initial minus sign, note that this processing -- is done even if Uval is zero, so that -0.0 is correctly interpreted. - else if Minus then return -Uval; @@ -376,6 +499,7 @@ package body System.Val_Real is return Uval; end if; end if; + end Scan_Real; ---------------- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e0ac52957f0..8951eb63c81 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-09-18 Nicolas Roche + + * gnat.dg/float_value2.adb: New testcase. + 2019-09-18 Vadim Godunko * gnat.dg/expect4.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/float_value2.adb b/gcc/testsuite/gnat.dg/float_value2.adb new file mode 100644 index 00000000000..d1f19f810b3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/float_value2.adb @@ -0,0 +1,10 @@ +-- { dg-do run } + +procedure Float_Value2 is + F1 : Long_Long_Float := Long_Long_Float'Value ("1.e40"); + F2 : Long_Long_Float := Long_Long_Float'Value ("1.0e40"); +begin + if F1 /= F2 then + raise Program_Error; + end if; +end Float_Value2; \ No newline at end of file