Final_List_Actual : Node_Id;
Final_List_Formal : Node_Id;
Is_Ctrl_Result : constant Boolean :=
- Controlled_Type
+ Needs_Finalization
(Underlying_Type (Etype (Function_Id)));
begin
-- No such extra parameter is needed if there are no controlled parts.
- -- The test for Controlled_Type accounts for class-wide results (which
- -- potentially have controlled parts, even if the root type doesn't),
- -- and the test for a tagged result type is needed because calls to
- -- such a function can in general occur in dispatching contexts, which
- -- must be treated the same as a call to class-wide functions. Both of
- -- these situations require that a finalization list be passed.
-
- if not Is_Ctrl_Result
- and then not Is_Tagged_Type (Underlying_Type (Etype (Function_Id)))
- then
+ -- The test for Needs_Finalization accounts for class-wide results
+ -- (which potentially have controlled parts, even if the root type
+ -- doesn't), and the test for a tagged result type is needed because
+ -- calls to such a function can in general occur in dispatching
+ -- contexts, which must be treated the same as a call to class-wide
+ -- functions. Both of these situations require that a finalization list
+ -- be passed.
+
+ if not Needs_BIP_Final_List (Function_Id) then
return;
end if;
-- If the return type is limited the context is an initialization
-- and different processing applies.
- if Controlled_Type (Etype (Subp))
+ if Needs_Finalization (Etype (Subp))
and then not Is_Inherently_Limited_Type (Etype (Subp))
and then not Is_Limited_Interface (Etype (Subp))
then
elsif Is_Inherently_Limited_Type (Typ) then
Set_Returns_By_Ref (Spec_Id);
- elsif Present (Utyp) and then CW_Or_Controlled_Type (Utyp) then
+ elsif Present (Utyp) and then CW_Or_Has_Controlled_Part (Utyp) then
Set_Returns_By_Ref (Spec_Id);
end if;
end;
Prot_Id : Entity_Id;
begin
- -- If the subprogram is a function with an anonymous access
- -- to protected subprogram, it must be expanded to create
- -- its equivalent type.
-
- -- if Ekind (Typ) = E_Anonymous_Access_Protected_Subprogram_Type then
- -- Expand_Access_Protected_Subprogram_Type (N, Typ);
- -- end if;
-
-- Deal with case of protected subprogram. Do not generate protected
-- operation if operation is flagged as eliminated.
-- which denotes the enclosing protected object. If the enclosing
-- operation is an entry, we are immediately within the protected body,
-- and we can retrieve the object from the service entries procedure. A
- -- barrier function has has the same signature as an entry. A barrier
+ -- barrier function has the same signature as an entry. A barrier
-- function is compiled within the protected object, but unlike
-- protected operations its never needs locks, so that its protected
-- body subprogram points to itself.
begin
if Is_Inherently_Limited_Type (Typ) then
Set_Returns_By_Ref (Subp);
- elsif Present (Utyp) and then CW_Or_Controlled_Type (Utyp) then
+ elsif Present (Utyp) and then CW_Or_Has_Controlled_Part (Utyp) then
Set_Returns_By_Ref (Subp);
end if;
end;
end if;
end Make_Build_In_Place_Call_In_Object_Declaration;
+ --------------------------
+ -- Needs_BIP_Final_List --
+ --------------------------
+
+ function Needs_BIP_Final_List (E : Entity_Id) return Boolean is
+ pragma Assert (Is_Build_In_Place_Function (E));
+ Result_Subt : constant Entity_Id := Underlying_Type (Etype (E));
+
+ begin
+ -- We need the BIP_Final_List if the result type needs finalization. We
+ -- also need it for tagged types, even if not class-wide, because some
+ -- type extension might need finalization, and all overriding functions
+ -- must have the same calling conventions. However, if there is a
+ -- pragma Restrictions (No_Finalization), we never need this parameter.
+
+ return (Needs_Finalization (Result_Subt)
+ or else Is_Tagged_Type (Underlying_Type (Result_Subt)))
+ and then not Restriction_Active (No_Finalization);
+ end Needs_BIP_Final_List;
+
end Exp_Ch6;
OSDN Git Service
