[Ada] Adding assertions on extra formals for BIP function calls

This patch adds assertions to ensure that the frontend passes to the
backend the right number of extra parameters required for build in place
function calls. No functional change.

2019-09-17  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* exp_ch6.ads (Needs_BIP_Task_Actuals): New subprogram.
	* exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call): Code
	cleanup.
	(Check_Number_Of_Actuals): New subprogram.
	(Make_Build_In_Place_Call_In_Allocator): Adding assertion.
	(Make_Build_In_Place_Call_In_Anonymous_Context): Adding
	assertion.
	(Make_Build_In_Place_Call_In_Assignment): Adding assertion.
	(Make_Build_In_Place_Call_In_Object_Declaration): Code cleanup
	plus assertion addition.
	(Needs_BIP_Task_Actuals): New subprogram.
	* sem_ch6.adb (Create_Extra_Formals): Rely on
	Needs_BIP_Task_Actuals() to check if the master of the tasks to
	be created, and the caller's activation chain formals are
	needed.

From-SVN: r275772

4 files changed, 76 insertions, 6 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7220566..c44a16d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2019-09-17  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch6.ads (Needs_BIP_Task_Actuals): New subprogram.
+	* exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call): Code
+	cleanup.
+	(Check_Number_Of_Actuals): New subprogram.
+	(Make_Build_In_Place_Call_In_Allocator): Adding assertion.
+	(Make_Build_In_Place_Call_In_Anonymous_Context): Adding
+	assertion.
+	(Make_Build_In_Place_Call_In_Assignment): Adding assertion.
+	(Make_Build_In_Place_Call_In_Object_Declaration): Code cleanup
+	plus assertion addition.
+	(Needs_BIP_Task_Actuals): New subprogram.
+	* sem_ch6.adb (Create_Extra_Formals): Rely on
+	Needs_BIP_Task_Actuals() to check if the master of the tasks to
+	be created, and the caller's activation chain formals are
+	needed.
+
 2019-09-17  Bob Duff  <duff@adacore.com>
 
 	* libgnat/s-bituti.adb (Get_Val_2, Set_Val_2): Use new routines
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index e3109c2..3277b46 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -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 --
    -----------------------------------
diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index bf453d9..13ccb2a 100644
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -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
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index fb50ec7..ddb12ec 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -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),