From: Eric Botcazou Date: Fri, 26 Mar 2021 09:53:57 +0000 (+0100) Subject: [Ada] Fix invalid JSON real numbers generated with -gnatRj X-Git-Tag: basepoints/gcc-13~6633 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=08c9ef089fdbe19e648016db7cb4c9fdd665bccc;p=thirdparty%2Fgcc.git [Ada] Fix invalid JSON real numbers generated with -gnatRj 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 index d9dc5b8644af..137c867c05f5 100644 --- 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 index 0f57043ffcd5..1367ad3a9e6a 100644 --- 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 index 2cd91ce6cd9c..5c625f9b949f 100644 --- 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,