Commit 0d566e01 by Ed Schonberg Committed by Arnaud Charlet

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
parent fb19dec9
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> 2011-09-05 Johannes Kanig <kanig@adacore.com>
* lib-xref-alfa.adb (Is_Alfa_Reference): Filter constants from effect * lib-xref-alfa.adb (Is_Alfa_Reference): Filter constants from effect
......
...@@ -562,6 +562,16 @@ package body Exp_Ch6 is ...@@ -562,6 +562,16 @@ package body Exp_Ch6 is
-- Maybe it would be better for each implicit formal of a build-in-place -- 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. ??? -- 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 loop
pragma Assert (Present (Extra_Formal)); pragma Assert (Present (Extra_Formal));
exit when exit when
...@@ -7127,6 +7137,13 @@ package body Exp_Ch6 is ...@@ -7127,6 +7137,13 @@ package body Exp_Ch6 is
Result_Subt := Etype (Function_Id); 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 -- When the result subtype is constrained, the return object must be
-- allocated on the caller side, and access to it is passed to the -- allocated on the caller side, and access to it is passed to the
-- function. -- function.
...@@ -7219,8 +7236,17 @@ package body Exp_Ch6 is ...@@ -7219,8 +7236,17 @@ package body Exp_Ch6 is
Add_Finalization_Master_Actual_To_Build_In_Place_Call Add_Finalization_Master_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id, Acc_Type); (Func_Call, Function_Id, Acc_Type);
Add_Task_Actuals_To_Build_In_Place_Call -- Is access type has a master entity, pass a reference to it.
(Func_Call, Function_Id, Master_Actual => Master_Id (Acc_Type));
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 -- The caller does not provide the return object in this case, so we
-- have to pass null for the object access actual. -- have to pass null for the object access actual.
......
...@@ -3890,6 +3890,14 @@ package body Exp_Ch7 is ...@@ -3890,6 +3890,14 @@ package body Exp_Ch7 is
No_Body := True; No_Body := True;
end if; 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 -- For a package declaration that implies no associated body, generate
-- task activation call and RACW supporting bodies now (since we won't -- task activation call and RACW supporting bodies now (since we won't
-- have a specific separate compilation unit for that). -- have a specific separate compilation unit for that).
...@@ -7450,9 +7458,12 @@ package body Exp_Ch7 is ...@@ -7450,9 +7458,12 @@ package body Exp_Ch7 is
Typ : Entity_Id; Typ : Entity_Id;
Ptr_Typ : Entity_Id) return Node_Id Ptr_Typ : Entity_Id) return Node_Id
is is
Desig_Typ : constant Entity_Id := Desig_Typ : constant Entity_Id :=
Available_View (Designated_Type (Ptr_Typ)); Available_View (Designated_Type (Ptr_Typ));
Utyp : Entity_Id; Fin_Mas_Id : constant Entity_Id := Finalization_Master (Ptr_Typ);
Call : Node_Id;
Fin_Mas_Ref : Node_Id;
Utyp : Entity_Id;
begin begin
-- If the context is a class-wide allocator, we use the class-wide type -- If the context is a class-wide allocator, we use the class-wide type
...@@ -7503,19 +7514,47 @@ package body Exp_Ch7 is ...@@ -7503,19 +7514,47 @@ package body Exp_Ch7 is
Utyp := Base_Type (Utyp); Utyp := Base_Type (Utyp);
end if; 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: -- Generate:
-- Set_Finalize_Address (<Ptr_Typ>FM, <Utyp>FD'Unrestricted_Access); -- Set_Finalize_Address (<Ptr_Typ>FM, <Utyp>FD'Unrestricted_Access);
return Call :=
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => Name =>
New_Reference_To (RTE (RE_Set_Finalize_Address), Loc), New_Reference_To (RTE (RE_Set_Finalize_Address), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Reference_To (Finalization_Master (Ptr_Typ), Loc), Fin_Mas_Ref,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix =>
New_Reference_To (TSS (Utyp, TSS_Finalize_Address), Loc), New_Reference_To (TSS (Utyp, TSS_Finalize_Address), Loc),
Attribute_Name => Name_Unrestricted_Access))); 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; end Make_Set_Finalize_Address_Call;
-------------------------- --------------------------
......
...@@ -5393,6 +5393,7 @@ package body Sem_Ch10 is ...@@ -5393,6 +5393,7 @@ package body Sem_Ch10 is
end if; end if;
Set_Non_Limited_View (Lim_Typ, Comp_Typ); Set_Non_Limited_View (Lim_Typ, Comp_Typ);
Set_Private_Dependents (Lim_Typ, New_Elmt_List);
elsif Nkind_In (Decl, N_Private_Type_Declaration, elsif Nkind_In (Decl, N_Private_Type_Declaration,
N_Incomplete_Type_Declaration, N_Incomplete_Type_Declaration,
...@@ -5432,6 +5433,11 @@ package body Sem_Ch10 is ...@@ -5432,6 +5433,11 @@ package body Sem_Ch10 is
Set_Non_Limited_View (Lim_Typ, Comp_Typ); 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 elsif Nkind (Decl) = N_Private_Extension_Declaration then
Comp_Typ := Defining_Identifier (Decl); Comp_Typ := Defining_Identifier (Decl);
......
...@@ -2001,10 +2001,18 @@ package body Sem_Ch9 is ...@@ -2001,10 +2001,18 @@ package body Sem_Ch9 is
-- In the case of an incomplete type, use the full view, unless it's not -- 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). -- 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 if Ekind (T) = E_Incomplete_Type then
T := Full_View (T); if Present (Full_View (T)) then
Set_Completion_Referenced (T); 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; end if;
Set_Ekind (T, E_Task_Type); Set_Ekind (T, E_Task_Type);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment