From: Eric Botcazou Date: Mon, 22 Jul 2019 13:58:04 +0000 (+0000) Subject: [Ada] Small enhancement to the -gnatD/-gnatG output for fixed-point types X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2f8313ce5a14700907822a4f8c0dc18649276136;p=gcc.git [Ada] Small enhancement to the -gnatD/-gnatG output for fixed-point types This is a small enhancement to the -gnatD/-gnatG output: the base type of fixed-point types, which is usually an itype, used to be printed as ??? in this case. It is now printed in a similar fashion as the first subtype. For the following package: package P is type D is delta 128.0 / (2 ** 15) range 0.0 .. 256.0; end P; the -gnatD/-gnatG must now be: Source recreated from tree for P (spec) --------------------------------------- p_E : short_integer := 0; package p is type p__d is delta [1.0/256.0] range 0.0 .. 256.0; [type p__TdB is delta [1.0/256.0] range -[2147483648.0*2**(-8)] .. [2147483647.0*2**(-8)]] freeze p__TdB [] end p; 2019-07-22 Eric Botcazou gcc/ada/ * sprint.adb (Sprint_Node_Actual) : Swap a couple of spaces. (Write_Itype): Minor consistency fixes throughout. Add support for printing ordinary and decimal fixed-point types and subtypes. From-SVN: r273689 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f85dfc431d8..4b817ce9328 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-07-22 Eric Botcazou + + * sprint.adb (Sprint_Node_Actual) + : Swap a couple of spaces. + (Write_Itype): Minor consistency fixes throughout. Add support + for printing ordinary and decimal fixed-point types and + subtypes. + 2019-07-22 Eric Botcazou * exp_attr.adb (Expand_Loop_Entry_Attribute): Beef up comment. diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index c17cf5700bf..8a8139dedbe 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -1483,9 +1483,9 @@ package body Sprint is end; when N_Decimal_Fixed_Point_Definition => - Write_Str_With_Col_Check_Sloc (" delta "); + Write_Str_With_Col_Check_Sloc ("delta "); Sprint_Node (Delta_Expression (Node)); - Write_Str_With_Col_Check ("digits "); + Write_Str_With_Col_Check (" digits "); Sprint_Node (Digits_Expression (Node)); Sprint_Opt_Node (Real_Range_Specification (Node)); @@ -4187,9 +4187,7 @@ package body Sprint is declare B : constant Node_Id := Etype (Typ); - X : Node_Id; P : constant Node_Id := Parent (Typ); - S : constant Saved_Output_Buffer := Save_Output_Buffer; -- Save current output buffer @@ -4197,6 +4195,8 @@ package body Sprint is -- Save sloc of related node, so it is not modified when -- printing with -gnatD. + X : Node_Id; + begin -- Write indentation at start of line @@ -4324,8 +4324,8 @@ package body Sprint is declare L : constant Node_Id := Type_Low_Bound (Typ); H : constant Node_Id := Type_High_Bound (Typ); - LE : Node_Id; - HE : Node_Id; + BL : Node_Id; + BH : Node_Id; begin -- B can either be a scalar type, in which case the @@ -4335,29 +4335,29 @@ package body Sprint is -- constraint. if Is_Scalar_Type (B) then - LE := Type_Low_Bound (B); - HE := Type_High_Bound (B); + BL := Type_Low_Bound (B); + BH := Type_High_Bound (B); else - LE := Empty; - HE := Empty; + BL := Empty; + BH := Empty; end if; - if No (LE) + if No (BL) or else (True and then Nkind (L) = N_Integer_Literal and then Nkind (H) = N_Integer_Literal - and then Nkind (LE) = N_Integer_Literal - and then Nkind (HE) = N_Integer_Literal - and then UI_Eq (Intval (L), Intval (LE)) - and then UI_Eq (Intval (H), Intval (HE))) + and then Nkind (BL) = N_Integer_Literal + and then Nkind (BH) = N_Integer_Literal + and then UI_Eq (Intval (L), Intval (BL)) + and then UI_Eq (Intval (H), Intval (BH))) then null; else Write_Str (" range "); - Sprint_Node (Type_Low_Bound (Typ)); + Sprint_Node (L); Write_Str (" .. "); - Sprint_Node (Type_High_Bound (Typ)); + Sprint_Node (H); end if; end; @@ -4368,7 +4368,7 @@ package body Sprint is Write_Str ("mod "); Write_Uint_With_Col_Check (Modulus (Typ), Auto); - -- Floating point types and subtypes + -- Floating-point types and subtypes when E_Floating_Point_Subtype | E_Floating_Point_Type @@ -4379,9 +4379,9 @@ package body Sprint is Write_Str ("new "); end if; - Write_Id (Etype (Typ)); + Write_Id (B); - if Digits_Value (Typ) /= Digits_Value (Etype (Typ)) then + if Digits_Value (Typ) /= Digits_Value (B) then Write_Str (" digits "); Write_Uint_With_Col_Check (Digits_Value (Typ), Decimal); @@ -4392,27 +4392,54 @@ package body Sprint is declare L : constant Node_Id := Type_Low_Bound (Typ); H : constant Node_Id := Type_High_Bound (Typ); - LE : constant Node_Id := Type_Low_Bound (B); - HE : constant Node_Id := Type_High_Bound (B); + BL : constant Node_Id := Type_Low_Bound (B); + BH : constant Node_Id := Type_High_Bound (B); begin - if Nkind (L) = N_Real_Literal + if True + and then Nkind (L) = N_Real_Literal and then Nkind (H) = N_Real_Literal - and then Nkind (LE) = N_Real_Literal - and then Nkind (HE) = N_Real_Literal - and then UR_Eq (Realval (L), Realval (LE)) - and then UR_Eq (Realval (H), Realval (HE)) + and then Nkind (BL) = N_Real_Literal + and then Nkind (BH) = N_Real_Literal + and then UR_Eq (Realval (L), Realval (BL)) + and then UR_Eq (Realval (H), Realval (BH)) then null; else Write_Str (" range "); - Sprint_Node (Type_Low_Bound (Typ)); + Sprint_Node (L); Write_Str (" .. "); - Sprint_Node (Type_High_Bound (Typ)); + Sprint_Node (H); end if; end; + -- Ordinary fixed-point types and subtypes + + when E_Ordinary_Fixed_Point_Subtype + | E_Ordinary_Fixed_Point_Type + => + Write_Header (Ekind (Typ) = E_Ordinary_Fixed_Point_Type); + + Write_Str ("delta "); + Write_Ureal_With_Col_Check_Sloc (Delta_Value (Typ)); + Write_Str (" range "); + Sprint_Node (Type_Low_Bound (Typ)); + Write_Str (" .. "); + Sprint_Node (Type_High_Bound (Typ)); + + -- Decimal fixed-point types and subtypes + + when E_Decimal_Fixed_Point_Subtype + | E_Decimal_Fixed_Point_Type + => + Write_Header (Ekind (Typ) = E_Decimal_Fixed_Point_Type); + + Write_Str ("delta "); + Write_Ureal_With_Col_Check_Sloc (Delta_Value (Typ)); + Write_Str (" digits "); + Write_Uint_With_Col_Check (Digits_Value (Typ), Decimal); + -- Record subtypes when E_Record_Subtype @@ -4493,16 +4520,16 @@ package body Sprint is when E_String_Literal_Subtype => declare - LB : constant Uint := + L : constant Uint := Expr_Value (String_Literal_Low_Bound (Typ)); Len : constant Uint := String_Literal_Length (Typ); begin Write_Header (False); Write_Str ("String ("); - Write_Int (UI_To_Int (LB)); + Write_Int (UI_To_Int (L)); Write_Str (" .. "); - Write_Int (UI_To_Int (LB + Len) - 1); + Write_Int (UI_To_Int (L + Len) - 1); Write_Str (");"); end;