[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, 3 insertions, 0 deletions

diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index 94a2703..183d0ef 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -974,6 +974,8 @@ package body Switch.C is
                --    -gnatd_i (ignore activations and calls to instances for
                --              elaboration)
                --    -gnatd_p (ignore assertion pragmas for elaboration)
+               --    -gnatd_s (stop elaboration checks on synchronous
+               --              suspension)
                --    -gnatdL  (ignore external calls from instances for
                --              elaboration)
 
@@ -982,6 +984,7 @@ package body Switch.C is
                   Debug_Flag_Underscore_E := True;
                   Debug_Flag_Underscore_I := True;
                   Debug_Flag_Underscore_P := True;
+                  Debug_Flag_Underscore_S := True;
                   Debug_Flag_LL           := True;
                end if;