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.
-----------
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;
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.
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);
Bad_Base := True;
else
Scale := Scale - After_Point;
- Uval := Uval * Base + Fdigit;
+ Uval := Uval_Tmp;
end if;
end if;
--- /dev/null
+-- { 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;
projects / gcc.git / commitdiff