sprint.adb (Write_Itype): Handle Itypes whose Parent field points to the…

sprint.adb (Write_Itype): Handle Itypes whose Parent field points to the declaration for some different...

2008-04-08  Robert Dewar  <dewar@adacore.com>

	* sprint.adb (Write_Itype): Handle Itypes whose Parent field points to
	the declaration for some different entity.
	(Sprint_Node_Actual, case N_Derived_Type_Definition): When an interface
	list is precent (following the parent subtype indication), display
	appropriate "and" keyword.

	* itypes.adb: Remove unnecessary calls to Init_Size_Align and Init_Esize
	Remove unnecessary calls to Init_Size_Align and Init_Esize.
	Add notes on use of Parent field of an Itype

From-SVN: r134037

gcc/ada/itypes.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -29,6 +29,7 @@ with Sem;      use Sem;
 with Sinfo;    use Sinfo;
 with Stand;    use Stand;
 with Targparm; use Targparm;
+with Uintp;    use Uintp;
 
 package body Itypes is
 
@@ -47,17 +48,24 @@ package body Itypes is
       Typ : Entity_Id;
 
    begin
+      --  Should comment setting of Public_Status here ???
+
       if Related_Id = Empty then
          Typ := New_Internal_Entity (Ekind, Scope_Id, Sloc (Related_Nod), 'T');
          Set_Public_Status (Typ);
 
       else
-         Typ := New_External_Entity
-           (Ekind, Scope_Id, Sloc (Related_Nod), Related_Id, Suffix,
-               Suffix_Index, 'T');
+         Typ :=
+           New_External_Entity
+             (Ekind, Scope_Id, Sloc (Related_Nod), Related_Id, Suffix,
+              Suffix_Index, 'T');
       end if;
 
-      Init_Size_Align (Typ);
+      --  Make sure Esize (Typ) was properly initialized, it should be since
+      --  New_Internal_Entity/New_External_Entity call Init_Size_Align.
+
+      pragma Assert (Esize (Typ) = Uint_0);
+
       Set_Etype (Typ, Any_Type);
       Set_Is_Itype (Typ);
       Set_Associated_Node_For_Itype (Typ, Related_Nod);
@@ -95,7 +103,6 @@ package body Itypes is
 
       Set_Directly_Designated_Type (I_Typ, Directly_Designated_Type (T));
       Set_Etype                    (I_Typ, T);
-      Init_Size_Align              (I_Typ);
       Set_Depends_On_Private       (I_Typ, Depends_On_Private (T));
       Set_Is_Public                (I_Typ, Is_Public          (T));
       Set_From_With_Type           (I_Typ, From_With_Type     (T));

gcc/ada/sprint.adb

@@ -35,6 +35,7 @@ with Nlists;   use Nlists;
 with Opt;      use Opt;
 with Output;   use Output;
 with Rtsfind;  use Rtsfind;
+with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
 with Sinput.D; use Sinput.D;
@@ -1331,6 +1332,7 @@ package body Sprint is
             Sprint_Node (Subtype_Indication (Node));
 
             if Present (Interface_List (Node)) then
+               Write_Str_With_Col_Check (" and ");
                Sprint_And_List (Interface_List (Node));
                Write_Str_With_Col_Check (" with ");
             end if;
@@ -3664,10 +3666,12 @@ package body Sprint is
                Write_Char (' ');
             end loop;
 
-            --  If we have a constructed declaration, print it
-
-            if Present (P) and then Nkind (P) in N_Declaration then
+            --  If we have a constructed declaration for the itype, print it
 
+            if Present (P)
+              and then Nkind (P) in N_Declaration
+              and then Defining_Entity (P) = Typ
+            then
                --  We must set Itype_Printed true before the recursive call to
                --  print the node, otherwise we get an infinite recursion!