+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
-- 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
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.
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.
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).
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
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;
--------------------------
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,
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);
-- 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);
projects / thirdparty / gcc.git / commitdiff
