@@ -146,6 +146,12 @@ package body Exp_Ch6 is
-- access discriminants do not require secondary stack use. Note we must
-- always use the secondary stack for dispatching-on-result calls.
+ function Check_Number_Of_Actuals
+ (Subp_Call : Node_Id;
+ Subp_Id : Entity_Id) return Boolean;
+ -- Given a subprogram call to the given subprogram return True if the
+ -- number of actual parameters (including extra actuals) is correct.
+
procedure Check_Overriding_Operation (Subp : Entity_Id);
-- Subp is a dispatching operation. Check whether it may override an
-- inherited private operation, in which case its DT entry is that of
@@ -543,8 +549,6 @@ package body Exp_Ch6 is
Chain : Node_Id := Empty)
is
Loc : constant Source_Ptr := Sloc (Function_Call);
- Result_Subt : constant Entity_Id :=
- Available_View (Etype (Function_Id));
Actual : Node_Id;
Chain_Actual : Node_Id;
Chain_Formal : Node_Id;
@@ -553,7 +557,7 @@ package body Exp_Ch6 is
begin
-- No such extra parameters are needed if there are no tasks
- if not Has_Task (Result_Subt) then
+ if not Needs_BIP_Task_Actuals (Function_Id) then
return;
end if;
@@ -869,6 +873,33 @@ package body Exp_Ch6 is
or else not Requires_Transient_Scope (Underlying_Type (Result_Subt));
end Caller_Known_Size;
+ -----------------------------
+ -- Check_Number_Of_Actuals --
+ -----------------------------
+
+ function Check_Number_Of_Actuals
+ (Subp_Call : Node_Id;
+ Subp_Id : Entity_Id) return Boolean
+ is
+ Formal : Entity_Id;
+ Actual : Node_Id;
+
+ begin
+ pragma Assert (Nkind_In (Subp_Call, N_Entry_Call_Statement,
+ N_Function_Call,
+ N_Procedure_Call_Statement));
+
+ Formal := First_Formal_With_Extras (Subp_Id);
+ Actual := First_Actual (Subp_Call);
+
+ while Present (Formal) and then Present (Actual) loop
+ Next_Formal_With_Extras (Formal);
+ Next_Actual (Actual);
+ end loop;
+
+ return No (Formal) and then No (Actual);
+ end Check_Number_Of_Actuals;
+
--------------------------------
-- Check_Overriding_Operation --
--------------------------------
@@ -8335,6 +8366,7 @@ package body Exp_Ch6 is
Rewrite (Allocator, New_Occurrence_Of (Return_Obj_Access, Loc));
Analyze_And_Resolve (Allocator, Acc_Type);
+ pragma Assert (Check_Number_Of_Actuals (Func_Call, Function_Id));
end Make_Build_In_Place_Call_In_Allocator;
---------------------------------------------------
@@ -8456,6 +8488,8 @@ package body Exp_Ch6 is
Add_Access_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id, New_Occurrence_Of (Return_Obj_Id, Loc));
+ pragma Assert (Check_Number_Of_Actuals (Func_Call, Function_Id));
+
-- When the result subtype is unconstrained, the function must allocate
-- the return object in the secondary stack, so appropriate implicit
-- parameters are added to the call to indicate that. A transient
@@ -8479,6 +8513,8 @@ package body Exp_Ch6 is
Add_Access_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id, Empty);
+
+ pragma Assert (Check_Number_Of_Actuals (Func_Call, Function_Id));
end if;
end Make_Build_In_Place_Call_In_Anonymous_Context;
@@ -8584,6 +8620,7 @@ package body Exp_Ch6 is
Insert_After_And_Analyze (Ptr_Typ_Decl, Obj_Decl);
Rewrite (Assign, Make_Null_Statement (Loc));
+ pragma Assert (Check_Number_Of_Actuals (Func_Call, Func_Id));
end Make_Build_In_Place_Call_In_Assignment;
----------------------------------------------------
@@ -8908,7 +8945,7 @@ package body Exp_Ch6 is
Master_Exp => Fmaster_Actual);
if Nkind (Parent (Obj_Decl)) = N_Extended_Return_Statement
- and then Has_Task (Result_Subt)
+ and then Needs_BIP_Task_Actuals (Function_Id)
then
-- Here we're passing along the master that was passed in to this
-- function.
@@ -9025,6 +9062,8 @@ package body Exp_Ch6 is
Replace_Renaming_Declaration_Id
(Obj_Decl, Original_Node (Obj_Decl));
end if;
+
+ pragma Assert (Check_Number_Of_Actuals (Func_Call, Function_Id));
end Make_Build_In_Place_Call_In_Object_Declaration;
-------------------------------------------------
@@ -9296,6 +9335,17 @@ package body Exp_Ch6 is
Analyze_And_Resolve (Allocator, Acc_Type);
end Make_CPP_Constructor_Call_In_Allocator;
+ ----------------------------
+ -- Needs_BIP_Task_Actuals --
+ ----------------------------
+
+ function Needs_BIP_Task_Actuals (Func_Id : Entity_Id) return Boolean is
+ pragma Assert (Is_Build_In_Place_Function (Func_Id));
+ Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
+ begin
+ return Has_Task (Func_Typ);
+ end Needs_BIP_Task_Actuals;
+
-----------------------------------
-- Needs_BIP_Finalization_Master --
-----------------------------------
@@ -244,6 +244,9 @@ package Exp_Ch6 is
-- functions with tagged result types, since they can be invoked via
-- dispatching calls, and descendant types may require finalization.
+ function Needs_BIP_Task_Actuals (Func_Id : Entity_Id) return Boolean;
+ -- Return True if the function returns an object of a type that has tasks.
+
function Needs_Result_Accessibility_Level
(Func_Id : Entity_Id) return Boolean;
-- Ada 2012 (AI05-0234): Return True if the function needs an implicit
@@ -8080,7 +8080,6 @@ package body Sem_Ch6 is
if Is_Build_In_Place_Function (E) then
declare
Result_Subt : constant Entity_Id := Etype (E);
- Full_Subt : constant Entity_Id := Available_View (Result_Subt);
Formal_Typ : Entity_Id;
Subp_Decl : Node_Id;
Discard : Entity_Id;
@@ -8130,7 +8129,7 @@ package body Sem_Ch6 is
-- master of the tasks to be created, and the caller's activation
-- chain.
- if Has_Task (Full_Subt) then
+ if Needs_BIP_Task_Actuals (E) then
Discard :=
Add_Extra_Formal
(E, RTE (RE_Master_Id),