The -gnatR output contains information about fixed-point types declared
in the program and it comprises real numbers, which are displayed using
a custom format specific to the compiler, which is not always compatible
with the JSON data interchange format.
The change also fixes an off-by-one bug in Decimal_Exponent_Lo and also
tweaks Decimal_Exponent_Hi for the sake of consistency.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* urealp.ads (UR_Write_To_JSON): Declare.
* urealp.adb (Decimal_Exponent_Hi): Treat numbers in base 10
specially and rewrite handling of numbers in other bases.
(Decimal_Exponent_Lo): Likewise.
(Normalize): Minor tweak.
(UR_Write_To_JSON): New wrapper procedure around UR_Write.
* repinfo.adb (List_Type_Info): When the output is to JSON, call
UR_Write_To_JSON instead of UR_Write.diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -2030,7 +2030,7 @@ package body Repinfo is
if List_Representation_Info_To_JSON then
Write_Line (",");
Write_Str (" ""Small"": ");
- UR_Write (Small_Value (Ent));
+ UR_Write_To_JSON (Small_Value (Ent));
else
Write_Str ("for ");
List_Name (Ent);
@@ -2052,9 +2052,9 @@ package body Repinfo is
if List_Representation_Info_To_JSON then
Write_Line (",");
Write_Str (" ""Range"": [ ");
- UR_Write (Realval (Low_Bound (R)));
+ UR_Write_To_JSON (Realval (Low_Bound (R)));
Write_Str (", ");
- UR_Write (Realval (High_Bound (R)));
+ UR_Write_To_JSON (Realval (High_Bound (R)));
Write_Str (" ]");
else
Write_Str ("for ");
diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb
--- a/gcc/ada/urealp.adb
+++ b/gcc/ada/urealp.adb
@@ -174,16 +174,30 @@ package body Urealp is
return UI_Decimal_Digits_Hi (Val.Num) -
UI_Decimal_Digits_Lo (Val.Den);
- -- For based numbers, just subtract the decimal exponent from the
- -- high estimate of the number of digits in the numerator and add
- -- one to accommodate possible round off errors for non-decimal
- -- bases. For example:
+ -- For based numbers, get the maximum number of digits in the numerator
+ -- minus one and the either exact or floor value of the decimal exponent
+ -- of the denominator, and subtract. For example:
- -- 1_500_000 / 10**4 = 1.50E-2
+ -- 321 / 10**3 = 3.21E-1
+ -- 435 / 5**7 = 5.57E-3
- else -- Val.Rbase /= 0
- return UI_Decimal_Digits_Hi (Val.Num) -
- Equivalent_Decimal_Exponent (Val) + 1;
+ else
+ declare
+ E : Int;
+
+ begin
+ if Val.Rbase = 10 then
+ E := UI_To_Int (Val.Den);
+
+ else
+ E := Equivalent_Decimal_Exponent (Val);
+ if E < 0 then
+ E := E - 1;
+ end if;
+ end if;
+
+ return UI_Decimal_Digits_Hi (Val.Num) - 1 - E;
+ end;
end if;
end Decimal_Exponent_Hi;
@@ -213,16 +227,30 @@ package body Urealp is
return UI_Decimal_Digits_Lo (Val.Num) -
UI_Decimal_Digits_Hi (Val.Den) - 1;
- -- For based numbers, just subtract the decimal exponent from the
- -- low estimate of the number of digits in the numerator and subtract
- -- one to accommodate possible round off errors for non-decimal
- -- bases. For example:
+ -- For based numbers, get the minimum number of digits in the numerator
+ -- minus one and the either exact or ceil value of the decimal exponent
+ -- of the denominator, and subtract. For example:
- -- 1_500_000 / 10**4 = 1.50E-2
+ -- 321 / 10**3 = 3.21E-1
+ -- 435 / 5**7 = 5.57E-3
- else -- Val.Rbase /= 0
- return UI_Decimal_Digits_Lo (Val.Num) -
- Equivalent_Decimal_Exponent (Val) - 1;
+ else
+ declare
+ E : Int;
+
+ begin
+ if Val.Rbase = 10 then
+ E := UI_To_Int (Val.Den);
+
+ else
+ E := Equivalent_Decimal_Exponent (Val);
+ if E > 0 then
+ E := E + 1;
+ end if;
+ end if;
+
+ return UI_Decimal_Digits_Lo (Val.Num) - 1 - E;
+ end;
end if;
end Decimal_Exponent_Lo;
@@ -374,7 +402,7 @@ package body Urealp is
Tmp : Uint;
Num : Uint;
Den : Uint;
- M : constant Uintp.Save_Mark := Uintp.Mark;
+ M : constant Uintp.Save_Mark := Mark;
begin
-- Start by setting J to the greatest of the absolute values of the
@@ -1486,6 +1514,80 @@ package body Urealp is
end if;
end UR_Write;
+ ----------------------
+ -- UR_Write_To_JSON --
+ ----------------------
+
+ -- We defer to the implementation of UR_Write in all cases, either directly
+ -- for values that are naturally written in a JSON compatible format, or by
+ -- first computing a decimal approxixmation for other values.
+
+ procedure UR_Write_To_JSON (Real : Ureal) is
+ Val : constant Ureal_Entry := Ureals.Table (Real);
+ Imrk : constant Uintp.Save_Mark := Mark;
+ Rmrk : constant Urealp.Save_Mark := Mark;
+
+ T : Ureal;
+
+ begin
+ -- Zero is zero
+
+ if Val.Num = 0 then
+ T := Real;
+
+ -- For constants with a denominator of zero, the value is simply the
+ -- numerator value, since we are dividing by base**0, which is 1.
+
+ elsif Val.Den = 0 then
+ T := Real;
+
+ -- Small powers of 2 get written in decimal fixed-point format
+
+ elsif Val.Rbase = 2
+ and then Val.Den <= 3
+ and then Val.Den >= -16
+ then
+ T := Real;
+
+ -- Constants in base 10 can be written in normal Ada literal style
+
+ elsif Val.Rbase = 10 then
+ T := Real;
+
+ -- Rationals where numerator is divisible by denominator can be output
+ -- as literals after we do the division. This includes the common case
+ -- where the denominator is 1.
+
+ elsif Val.Rbase = 0 and then Val.Num mod Val.Den = 0 then
+ T := Real;
+
+ -- For other constants, compute an approxixmation in base 10
+
+ else
+ declare
+ A : constant Ureal := UR_Abs (Real);
+ -- The absolute value
+
+ E : constant Uint :=
+ (if A < Ureal_1
+ then UI_From_Int (3 - Decimal_Exponent_Lo (Real))
+ else Uint_3);
+ -- The exponent for at least 3 digits after the decimal point
+
+ Num : constant Uint :=
+ UR_To_Uint (UR_Mul (A, UR_Exponentiate (Ureal_10, E)));
+ -- The numerator appropriately rounded
+
+ begin
+ T := UR_From_Components (Num, E, 10, Val.Negative);
+ end;
+ end if;
+
+ UR_Write (T);
+ Release (Imrk);
+ Release (Rmrk);
+ end UR_Write_To_JSON;
+
-------------
-- Ureal_0 --
-------------
diff --git a/gcc/ada/urealp.ads b/gcc/ada/urealp.ads
--- a/gcc/ada/urealp.ads
+++ b/gcc/ada/urealp.ads
@@ -288,6 +288,10 @@ package Urealp is
-- In the case where an expression is output, if Brackets is set to True,
-- the expression is surrounded by square brackets.
+ procedure UR_Write_To_JSON (Real : Ureal);
+ -- Writes value of Real to standard output in the JSON data interchange
+ -- format specified by the ECMA-404 standard, for the -gnatRj output.
+
procedure pr (Real : Ureal);
pragma Export (Ada, pr);
-- Writes value of Real to standard output with a terminating line return,
