[Ada] Suspension and elaboration warnings/checks
authorHristian Kirtchev <kirtchev@adacore.com>
Wed, 23 May 2018 10:22:52 +0000 (10:22 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Wed, 23 May 2018 10:22:52 +0000 (10:22 +0000)
commit0c9849e18b134711873df3bccd93d6b6faa93c6f
treec4db8bc4ea28bcc4d537f6ecf823d7d698c20e1d
parent51ab2a39e9baae7fe1552daca02337050b11cfb6
[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
gcc/ada/ChangeLog
gcc/ada/debug.adb
gcc/ada/rtsfind.ads
gcc/ada/sem_elab.adb
gcc/ada/switch-c.adb