exp_ch6.adb (Build_In_Place_Formal): If extra formals are not present, create them now.

2011-09-05  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch6.adb (Build_In_Place_Formal): If extra formals are not
	present, create them now.  Needed in case the return type was
	a limited view in the function declaration.
	(Make_Build_In_Place_Call_In_Allocator): If return type contains
	tasks, build the activation chain for it.  Pass a reference to
	the Master_Id in call to Add_Task_Actuals_To_Build_In_Place call.
	* exp_ch7.adb (Make_Set_Finalize_Address_Call): Clean up interface
	with build_in_place calls.
	* sem_ch9.adb (Analyze_Task_Type_Declaration): If partial view was
	incomplete, inatialize its Corresponding_Record_Type component.
	* sem_ch10.adb (Build_Chain): Initialize Private_Dependents field
	of limited views.

From-SVN: r178534

5 files changed, 104 insertions, 10 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 082b45e..f7e2e85 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2011-09-05  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch6.adb (Build_In_Place_Formal): If extra formals are not
+	present, create them now.  Needed in case the return type was
+	a limited view in the function declaration.
+	(Make_Build_In_Place_Call_In_Allocator): If return type contains
+	tasks, build the activation chain for it.  Pass a reference to
+	the Master_Id in call to Add_Task_Actuals_To_Build_In_Place call.
+	* exp_ch7.adb (Make_Set_Finalize_Address_Call): Clean up interface
+	with build_in_place calls.
+	* sem_ch9.adb (Analyze_Task_Type_Declaration): If partial view was
+	incomplete, inatialize its Corresponding_Record_Type component.
+	* sem_ch10.adb (Build_Chain): Initialize Private_Dependents field
+	of limited views.
+
 2011-09-05  Johannes Kanig  <kanig@adacore.com>
 
 	* lib-xref-alfa.adb (Is_Alfa_Reference): Filter constants from effect
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 3ff42b6..a9a2c42 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -562,6 +562,16 @@ package body Exp_Ch6 is
       --  Maybe it would be better for each implicit formal of a build-in-place
       --  function to have a flag or a Uint attribute to identify it. ???
 
+      --  The return type in the function declaration may have been a limited
+      --  view, and the extra formals for the function were not generated at
+      --  that point.  At the point of call the full view must be available and
+      --  the extra formals can be created.
+
+      if No (Extra_Formal) then
+         Create_Extra_Formals (Func);
+         Extra_Formal := Extra_Formals (Func);
+      end if;
+
       loop
          pragma Assert (Present (Extra_Formal));
          exit when
@@ -7127,6 +7137,13 @@ package body Exp_Ch6 is
 
       Result_Subt := Etype (Function_Id);
 
+      --  Check whether return type includes tasks. This may not have been done
+      --  previously, if the type was a limited view.
+
+      if Has_Task (Result_Subt) then
+         Build_Activation_Chain_Entity (Allocator);
+      end if;
+
       --  When the result subtype is constrained, the return object must be
       --  allocated on the caller side, and access to it is passed to the
       --  function.
@@ -7219,8 +7236,17 @@ package body Exp_Ch6 is
          Add_Finalization_Master_Actual_To_Build_In_Place_Call
            (Func_Call, Function_Id, Acc_Type);
 
-         Add_Task_Actuals_To_Build_In_Place_Call
-           (Func_Call, Function_Id, Master_Actual => Master_Id (Acc_Type));
+         --  Is access type has a master entity, pass a reference to it.
+
+         if Present (Master_Id (Acc_Type)) then
+            Add_Task_Actuals_To_Build_In_Place_Call
+              (Func_Call, Function_Id,
+               Master_Actual =>
+                 New_Occurrence_Of (Master_Id (Acc_Type), Loc));
+         else
+            Add_Task_Actuals_To_Build_In_Place_Call
+              (Func_Call, Function_Id, Empty);
+         end if;
 
          --  The caller does not provide the return object in this case, so we
          --  have to pass null for the object access actual.
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 1598023..59d2cb1 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -3890,6 +3890,14 @@ package body Exp_Ch7 is
          No_Body := True;
       end if;
 
+      --  For a nested instance, delay processing until freeze point.
+
+      if Has_Delayed_Freeze (Id)
+       and then Nkind (Parent (N)) /= N_Compilation_Unit
+      then
+         return;
+      end if;
+
       --  For a package declaration that implies no associated body, generate
       --  task activation call and RACW supporting bodies now (since we won't
       --  have a specific separate compilation unit for that).
@@ -7450,9 +7458,12 @@ package body Exp_Ch7 is
       Typ     : Entity_Id;
       Ptr_Typ : Entity_Id) return Node_Id
    is
-      Desig_Typ : constant Entity_Id :=
-                    Available_View (Designated_Type (Ptr_Typ));
-      Utyp      : Entity_Id;
+      Desig_Typ   : constant Entity_Id :=
+                      Available_View (Designated_Type (Ptr_Typ));
+      Fin_Mas_Id  : constant Entity_Id := Finalization_Master (Ptr_Typ);
+      Call        : Node_Id;
+      Fin_Mas_Ref : Node_Id;
+      Utyp        : Entity_Id;
 
    begin
       --  If the context is a class-wide allocator, we use the class-wide type
@@ -7503,19 +7514,47 @@ package body Exp_Ch7 is
          Utyp := Base_Type (Utyp);
       end if;
 
+      Fin_Mas_Ref := New_Occurrence_Of (Fin_Mas_Id, Loc);
+
+      --  If the call is from a build-in-place function, the Master parameter
+      --  is actually a pointer. Dereference it for the call.
+
+      if Is_Access_Type (Etype (Fin_Mas_Id)) then
+         Fin_Mas_Ref := Make_Explicit_Dereference (Loc, Fin_Mas_Ref);
+      end if;
+
       --  Generate:
       --    Set_Finalize_Address (<Ptr_Typ>FM, <Utyp>FD'Unrestricted_Access);
 
-      return
+      Call :=
         Make_Procedure_Call_Statement (Loc,
           Name                   =>
             New_Reference_To (RTE (RE_Set_Finalize_Address), Loc),
           Parameter_Associations => New_List (
-            New_Reference_To (Finalization_Master (Ptr_Typ), Loc),
+            Fin_Mas_Ref,
             Make_Attribute_Reference (Loc,
               Prefix         =>
                 New_Reference_To (TSS (Utyp, TSS_Finalize_Address), Loc),
               Attribute_Name => Name_Unrestricted_Access)));
+
+      --  In the case of build-in-place functions, protect the call to ensure
+      --  we have a master at runtime. Generate:
+
+      --    if <Ptr_Typ>FM /= null then
+      --       <Call>;
+      --    end if;
+
+      if Is_Access_Type (Etype (Fin_Mas_Id)) then
+         Call :=
+           Make_If_Statement (Loc,
+             Condition       =>
+               Make_Op_Ne (Loc,
+                 Left_Opnd  => New_Reference_To (Fin_Mas_Id, Loc),
+                 Right_Opnd => Make_Null (Loc)),
+             Then_Statements => New_List (Call));
+      end if;
+
+      return Call;
    end Make_Set_Finalize_Address_Call;
 
    --------------------------
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 87334e4..33d8dda 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -5393,6 +5393,7 @@ package body Sem_Ch10 is
                end if;
 
                Set_Non_Limited_View (Lim_Typ, Comp_Typ);
+               Set_Private_Dependents (Lim_Typ, New_Elmt_List);
 
             elsif Nkind_In (Decl, N_Private_Type_Declaration,
                                   N_Incomplete_Type_Declaration,
@@ -5432,6 +5433,11 @@ package body Sem_Ch10 is
 
                Set_Non_Limited_View (Lim_Typ, Comp_Typ);
 
+               --  Initialize Private_Depedents, so the field has the proper
+               --  type, even though the list will remain empty.
+
+               Set_Private_Dependents (Lim_Typ, New_Elmt_List);
+
             elsif Nkind (Decl) = N_Private_Extension_Declaration then
                Comp_Typ := Defining_Identifier (Decl);
 
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index cdac2f7..5fbb0ec 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -2001,10 +2001,18 @@ package body Sem_Ch9 is
 
       --  In the case of an incomplete type, use the full view, unless it's not
       --  present (as can occur for an incomplete view from a limited with).
+      --  Initialize the Corresponding_Record_Type (which overlays the Private
+      --  Dependents field of the incomplete view).
 
-      if Ekind (T) = E_Incomplete_Type and then Present (Full_View (T)) then
-         T := Full_View (T);
-         Set_Completion_Referenced (T);
+      if Ekind (T) = E_Incomplete_Type then
+         if Present (Full_View (T)) then
+            T := Full_View (T);
+            Set_Completion_Referenced (T);
+
+         else
+            Set_Ekind (T, E_Task_Type);
+            Set_Corresponding_Record_Type (T, Empty);
+         end if;
       end if;
 
       Set_Ekind              (T, E_Task_Type);