2010-08-10 Javier Miranda <miranda@adacore.com>

	* sem_aggr.adb (Resolve_Extension_Aggregate): Warn on the use of C++
	constructors that leave the object partially initialized.
	* exp_atag.ads, exp_atags.adb (Build_Inherit_CPP_Prims): New subprogram
	that copies from parent of Typ the dispatch table slots of inherited
	C++ primitives. It handles primary and secondary dispatch tables.
	* einfo.adb (Related_Type): Moved from Node26 to Node27. Required to
	use this attribute with E_Variable entities.
	(Set_Is_Tag): Relax assertion to allow its use with variables that
	store tags.
	(Set_Related_Type): Relax assertion to allow its use with variables
	that store the tag of a C++ class.
	(Write_26_Field_Name): Remove Related_Type.
	(Write_27_Field_Name): Add Related_Type.
	* einfo.ads (Related_Type): Moved from Node26 to Node27. Available also
	with E_Variable entities.
	* sem_prag.adb (CPP_Constructor): Warn on duplicated occurrence of this
	pragma.
	* sem_util.adb (Search_Tag): Add missing support for CPP types.
	(Enclosing_CPP_Parent): New subprogram.
	(Has_Suffix): New subprogram.
	* sem_util.ads (Enclosing_CPP_Parent): New subprogram that returns the
	closest ancestor of a type that is a C++ type.
	(Has_Suffix): New subprogram. Used in assertions to check the suffix of
	internal entities.
	* sem_attr.adb (Analyze_Access_Attribute): Check wrong use of current
	instance in derivations of C++ types.
	* exp_tss.adb (CPP_Init_Proc): New subprogram.
	(Is_CPP_Init_Proc): New subprogram.
	(Set_TSS): Handle new C++ init routines.
	* exp_tss.ads (TSS_CPP_Init): New TSS name. For initialization of C++
	dispatch tables.
	(CPP_Init_Proc): New subprogram.
	(Is_CPP_Init_Proc): New subprogram.
	* exp_disp.adb (CPP_Num_Prims): New subprogram.
	(Has_CPP_Constructors): New subprogram.
	(Make_Secondary_DT, Make_DT): For derivations of CPP types, do not
	initialize slots located in the C++ part of the dispatch table.
	(Make_Tags): For CPP types declare variables used by the IP routine to
	store the C++ tag values after the first invocation of the C++
	constructor.
	(Build_CPP_Init_DT): New subprogram.
	(Set_CPP_Constructors): New implementation that builds an IP for each
	CPP constructor. These IP are wrappers of the C++ constructors that,
	after the first invocation of the constructor, read the C++ tags from
	the object and save them locally. These copies of the C++ tags are used
	by the IC routines to initialize tables of Ada derivations of CPP types.
	(Write_DT): Indicate what primitives are imported from C++
	* exp_disp.ads (CPP_Num_Prims): New subprogram.
	(Has_CPP_Constructors): New subprogram.
	* exp_aggr.adb (Build_Record_Aggr_Code): For derivations of C++ types
	invoke the IC routine to inherit the slots of the parents.
	* sem_ch13.adb (Analyze_Freeze_Entity): Add new warnings on CPP types.
	* exp_ch3.adb (Is_Variable_Size_Array): New subprogram.
	(Is_Variable_Size_Record): Factorize code calling
	Is_Variable_Size_Array.
	(Build_CPP_Init_Procedure): New subprogram that builds the tree
	corresponding to the procedure that initializes the C++ part of the
	dispatch table of an Ada tagged type that is a derivation of a CPP type.
	(Build_Init_Procedure): Adding documentation plus code reorganization to
	leave more clear the construction of the IP with C++ types.
	(Expand_Freeze_Record_Type): Delay call to Set_CPP_Constructors because
	it cannot be called after Make_Tags has been invoked.
	(Inherit_CPP_Tag): Removed.
	(Init_Secondary_Tags): For derivations of CPP types, warn on tags
	located at variable offset.
	* freeze.ads: Minor reformating.
	* sem_ch8.adb (Write_Scopes): Add pragma export. Required to have it
	available in gdb.
	* gcc-interface/Make-lang.in: Update dependencies.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@163065 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 12 insertions, 13 deletions

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 2186428b122..4a9e3173075 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -219,11 +219,11 @@ package body Einfo is
    --    Last_Assignment                 Node26
    --    Overridden_Operation            Node26
    --    Package_Instantiation           Node26
-   --    Related_Type                    Node26
    --    Relative_Deadline_Variable      Node26
    --    Static_Initialization           Node26
 
    --    Current_Use_Clause              Node27
+   --    Related_Type                    Node27
    --    Wrapped_Entity                  Node27
 
    --    Extra_Formals                   Node28
@@ -1481,7 +1481,6 @@ package body Einfo is
 
    function Has_Thunks (Id : E) return B is
    begin
-      pragma Assert (Ekind (Id) = E_Constant);
       return Flag228 (Id);
    end Has_Thunks;
 
@@ -2442,8 +2441,8 @@ package body Einfo is
 
    function Related_Type (Id : E) return E is
    begin
-      pragma Assert (Ekind_In (Id, E_Component, E_Constant));
-      return Node26 (Id);
+      pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
+      return Node27 (Id);
    end Related_Type;
 
    function Relative_Deadline_Variable (Id : E) return E is
@@ -3884,8 +3883,7 @@ package body Einfo is
 
    procedure Set_Has_Thunks (Id : E; V : B := True) is
    begin
-      pragma Assert (Is_Tag (Id)
-        and then Ekind (Id) = E_Constant);
+      pragma Assert (Is_Tag (Id));
       Set_Flag228 (Id, V);
    end Set_Has_Thunks;
 
@@ -4452,7 +4450,7 @@ package body Einfo is
 
    procedure Set_Is_Tag (Id : E; V : B := True) is
    begin
-      pragma Assert (Ekind_In (Id, E_Component, E_Constant));
+      pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
       Set_Flag78 (Id, V);
    end Set_Is_Tag;
 
@@ -4883,8 +4881,8 @@ package body Einfo is
 
    procedure Set_Related_Type (Id : E; V : E) is
    begin
-      pragma Assert (Ekind_In (Id, E_Component, E_Constant));
-      Set_Node26 (Id, V);
+      pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
+      Set_Node27 (Id, V);
    end Set_Related_Type;
 
    procedure Set_Relative_Deadline_Variable (Id : E; V : E) is
@@ -8011,10 +8009,6 @@ package body Einfo is
    procedure Write_Field26_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
-         when E_Component                                  |
-              E_Constant                                   =>
-            Write_Str ("Related_Type");
-
          when E_Generic_Package                            |
               E_Package                                    =>
             Write_Str ("Package_Instantiation");
@@ -8052,6 +8046,11 @@ package body Einfo is
    procedure Write_Field27_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
+         when E_Component                                  |
+              E_Constant                                   |
+              E_Variable                                   =>
+            Write_Str ("Related_Type");
+
          when E_Procedure                                  =>
             Write_Str ("Wrapped_Entity");