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

gcc/ada/

	* sprint.adb (Sprint_Node_Actual)
	<N_Decimal_Fixed_Point_Definition>: 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 f85dfc431d8f11c09572564de00fcd995e633ce1..4b817ce93288352b35eb8beb38c5a023f49cc1f0 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * sprint.adb (Sprint_Node_Actual)
+       <N_Decimal_Fixed_Point_Definition>: 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  <ebotcazou@adacore.com>
 
        * exp_attr.adb (Expand_Loop_Entry_Attribute): Beef up comment.

diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index c17cf5700bfed403652ab9d2d6a1b5c4fd9ea0df..8a8139dedbe0a3bf2a68383617e2809a4d24eae5 100644 (file)
--- 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;