public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Ada] Adding assertions on extra formals for BIP function calls
@ 2019-09-17  8:06 Pierre-Marie de Rodat
  0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2019-09-17  8:06 UTC (permalink / raw)
  To: gcc-patches; +Cc: Javier Miranda

[-- Attachment #1: Type: text/plain, Size: 969 bytes --]

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.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 6571 bytes --]

--- gcc/ada/exp_ch6.adb
+++ 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 --
    -----------------------------------

--- gcc/ada/exp_ch6.ads
+++ 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

--- gcc/ada/sem_ch6.adb
+++ 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),


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2019-09-17  8:06 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-09-17  8:06 [Ada] Adding assertions on extra formals for BIP function calls Pierre-Marie de Rodat

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).