[Ada] Suspension and elaboration warnings/checks

This patch modifies the static elaboration model to stop the inspection of
a task body when it contains a synchronous suspension call and restriction
No_Entry_Calls_In_Elaboration_Code or switch -gnatd_s is in effect.

------------
-- Source --
------------

--  suspension.ads

package Suspension is
   procedure ABE;

   task type Barrier_Task_1;
   task type Barrier_Task_2;
   task type Object_Task_1;
   task type Object_Task_2;
end Suspension;

--  suspension.adb

with Ada.Synchronous_Barriers;     use Ada.Synchronous_Barriers;
with Ada.Synchronous_Task_Control; use Ada.Synchronous_Task_Control;

package body Suspension is
   Bar : Synchronous_Barrier (Barrier_Limit'Last);
   Obj : Suspension_Object;

   task body Barrier_Task_1 is
      OK : Boolean;
   begin
      Wait_For_Release (Bar, OK);
      ABE;
   end Barrier_Task_1;

   task body Barrier_Task_2 is
      procedure Block is
         OK : Boolean;
      begin
         Wait_For_Release (Bar, OK);
      end Block;
   begin
      Block;
      ABE;
   end Barrier_Task_2;

   task body Object_Task_1 is
   begin
      Suspend_Until_True (Obj);
      ABE;
   end Object_Task_1;

   task body Object_Task_2 is
      procedure Block is
      begin
         Suspend_Until_True (Obj);
      end Block;
   begin
      Block;
      ABE;
   end Object_Task_2;

   function Elaborator return Boolean is
      BT_1 : Barrier_Task_1;
      BT_2 : Barrier_Task_2;
      OT_1 : Object_Task_1;
      OT_2 : Object_Task_2;
   begin
      return True;
   end Elaborator;

   Elab : constant Boolean := Elaborator;

   procedure ABE is begin null; end ABE;
end Suspension;

--  main.adb

with Suspension;

procedure Main is begin null; end Main;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q -gnatd_s main.adb
suspension.adb:23:07: warning: cannot call "ABE" before body seen
suspension.adb:23:07: warning: Program_Error may be raised at run time
suspension.adb:23:07: warning:   body of unit "Suspension" elaborated
suspension.adb:23:07: warning:   function "Elaborator" called at line 51
suspension.adb:23:07: warning:   local tasks of "Elaborator" activated
suspension.adb:23:07: warning:   procedure "ABE" called at line 23
suspension.adb:39:07: warning: cannot call "ABE" before body seen
suspension.adb:39:07: warning: Program_Error may be raised at run time
suspension.adb:39:07: warning:   body of unit "Suspension" elaborated
suspension.adb:39:07: warning:   function "Elaborator" called at line 51
suspension.adb:39:07: warning:   local tasks of "Elaborator" activated
suspension.adb:39:07: warning:   procedure "ABE" called at line 39

2018-05-23  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* debug.adb: Switch -gnatd_s is now used to stop elaboration checks on
	synchronized suspension.
	* rtsfind.ads: Add entries for units Ada.Synchronous_Barriers and
	Ada.Synchronous_Task_Control and routines Suspend_Until_True and
	Wait_For_Release.
	* sem_elab.adb: Document switch -gnatd_s.
	(In_Task_Body): New routine.
	(Is_Potential_Scenario): Code cleanup. Stop the traversal of a task
	body when the current construct denotes a synchronous suspension call,
	and restriction No_Entry_Calls_In_Elaboration_Code or switch -gnatd_s
	is in effect.
	(Is_Synchronous_Suspension_Call): New routine.
	* switch-c.adb (Scan_Front_End_Switches): Switch -gnatJ now sets switch
	-gnatd_s.

From-SVN: r260585

1 files changed, 5 insertions, 1 deletions

diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index c9b4aad..0324433 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -163,7 +163,7 @@ package body Debug is
    --  d_p  Ignore assertion pragmas for elaboration
    --  d_q
    --  d_r
-   --  d_s
+   --  d_s  Stop elaboration checks on synchronous suspension
    --  d_t
    --  d_u
    --  d_v
@@ -839,6 +839,10 @@ package body Debug is
    --       semantics of invariants and postconditions in both the static and
    --       dynamic elaboration models.
 
+   --  d_s  The compiler stops the examination of a task body once it reaches
+   --       a call to routine Ada.Synchronous_Task_Control.Suspend_Until_True
+   --       or Ada.Synchronous_Barriers.Wait_For_Release.
+
    --  d_L  Output trace information on elaboration checking. This debug switch
    --       causes output to be generated showing each call or instantiation as
    --       it is checked, and the progress of the recursive trace through