Skip to content

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

[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  <roche@adacore.com>

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
parent d2880e69
Showing with 410 additions and 264 deletions
gcc/ada/ChangeLog
2019-09-18 Nicolas Roche <roche@adacore.com>
* 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 <dross@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference): Call routine from
......
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 1<n zero>E-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;
----------------
......
gcc/testsuite/ChangeLog
2019-09-18 Nicolas Roche <roche@adacore.com>
* gnat.dg/float_value2.adb: New testcase.
2019-09-18 Vadim Godunko <godunko@adacore.com>
* gnat.dg/expect4.adb: New testcase.
......
gcc/testsuite/gnat.dg/float_value2.adb 0 → 100644
-- { 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
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