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
This commit is contained in:
Robert Dewar 2008-04-08 08:52:20 +02:00 committed by Arnaud Charlet
parent 64f7d845ef
commit 99cf6c77d0
2 changed files with 20 additions and 9 deletions

View File

@ -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));

View File

@ -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!