sem_aggr.adb (Valid_Ancestor_Type): Add support for C++ constructors.

2009-05-06  Javier Miranda  <miranda@adacore.com>

	* sem_aggr.adb (Valid_Ancestor_Type): Add support for C++ constructors.
	(Resolve_Extension_Aggregate): Do not reject C++ constructors in
	extension aggregates.
	(Resolve_Record_Aggregate): Add support for C++ constructors in
	extension aggregates.

	* exp_aggr.adb (Build_Record_Aggr_Code): Add support for C++
	constructors in extension aggregates.

From-SVN: r147160

gcc/ada/ChangeLog

+2009-05-06  Javier Miranda  <miranda@adacore.com>
+
+	* sem_aggr.adb (Valid_Ancestor_Type): Add support for C++ constructors.
+	(Resolve_Extension_Aggregate): Do not reject C++ constructors in
+	extension aggregates.
+	(Resolve_Record_Aggregate): Add support for C++ constructors in
+	extension aggregates.
+
+	* exp_aggr.adb (Build_Record_Aggr_Code): Add support for C++
+	constructors in extension aggregates.
+
 2009-05-06  Robert Dewar  <dewar@adacore.com>
 
 	* freeze.adb (Freeze_Record_Type): Improve error msg for bad size

gcc/ada/exp_aggr.adb

@@ -2519,22 +2519,14 @@ package body Exp_Aggr is
                Ref := Convert_To (Init_Typ, New_Copy_Tree (Target));
                Set_Assignment_OK (Ref);
 
-               if Has_Default_Init_Comps (N)
-                 or else Has_Task (Base_Type (Init_Typ))
-               then
-                  Append_List_To (L,
-                    Build_Initialization_Call (Loc,
-                      Id_Ref       => Ref,
-                      Typ          => Init_Typ,
-                      In_Init_Proc => Within_Init_Proc,
-                      With_Default_Init => True));
-               else
-                  Append_List_To (L,
-                    Build_Initialization_Call (Loc,
-                      Id_Ref       => Ref,
-                      Typ          => Init_Typ,
-                      In_Init_Proc => Within_Init_Proc));
-               end if;
+               Append_List_To (L,
+                 Build_Initialization_Call (Loc,
+                   Id_Ref            => Ref,
+                   Typ               => Init_Typ,
+                   In_Init_Proc      => Within_Init_Proc,
+                   With_Default_Init => Has_Default_Init_Comps (N)
+                                          or else
+                                        Has_Task (Base_Type (Init_Typ))));
 
                if Is_Constrained (Entity (A))
                  and then Has_Discriminants (Entity (A))
@@ -2542,6 +2534,21 @@ package body Exp_Aggr is
                   Check_Ancestor_Discriminants (Entity (A));
                end if;
 
+            --  Handle calls to C++ constructors
+
+            elsif Is_CPP_Constructor_Call (A) then
+               Init_Typ := Etype (Etype (A));
+               Ref := Convert_To (Init_Typ, New_Copy_Tree (Target));
+               Set_Assignment_OK (Ref);
+
+               Append_List_To (L,
+                 Build_Initialization_Call (Loc,
+                   Id_Ref            => Ref,
+                   Typ               => Init_Typ,
+                   In_Init_Proc      => Within_Init_Proc,
+                   With_Default_Init => Has_Default_Init_Comps (N),
+                   Constructor_Ref   => A));
+
             --  Ada 2005 (AI-287): If the ancestor part is an aggregate of
             --  limited type, a recursive call expands the ancestor. Note that
             --  in the limited case, the ancestor part must be either a

gcc/ada/sem_aggr.adb

@@ -2175,6 +2175,11 @@ package body Sem_Aggr is
             if Etype (Imm_Type) = Base_Type (A_Type) then
                return True;
 
+            elsif Is_CPP_Constructor_Call (A)
+              and then Etype (Imm_Type) = Base_Type (Etype (A_Type))
+            then
+               return True;
+
             --  The base type of the parent type may appear as  a private
             --  extension if it is declared as such in a parent unit of
             --  the current one. For consistency of the subsequent analysis
@@ -2290,6 +2295,7 @@ package body Sem_Aggr is
 
             if Is_Class_Wide_Type (Etype (A))
               and then Nkind (Original_Node (A)) = N_Function_Call
+              and then not Is_CPP_Constructor_Call (Original_Node (A))
             then
                --  If the ancestor part is a dispatching call, it appears
                --  statically to be a legal ancestor, but it yields any
@@ -3070,7 +3076,13 @@ package body Sem_Aggr is
             --  of all ancestors, starting with the root.
 
             if Nkind (N) = N_Extension_Aggregate then
-               Root_Typ := Base_Type (Etype (Ancestor_Part (N)));
+               if Is_CPP_Constructor_Call (Ancestor_Part (N)) then
+                  pragma Assert
+                    (Is_Class_Wide_Type (Etype (Ancestor_Part (N))));
+                  Root_Typ := Base_Type (Etype (Etype (Ancestor_Part (N))));
+               else
+                  Root_Typ := Base_Type (Etype (Ancestor_Part (N)));
+               end if;
             else
                Root_Typ := Root_Type (Typ);