r260585 - in /trunk/gcc/ada: ChangeLog debug.ad...

[pmderodat@gcc.gnu.org]

Author: pmderodat
Date: Wed May 23 10:22:52 2018
New Revision: 260585

URL: https://gcc.gnu.org/viewcvs?rev=260585&root=gcc&view=rev
Log:
[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.

Modified:
    trunk/gcc/ada/ChangeLog
    trunk/gcc/ada/debug.adb
    trunk/gcc/ada/rtsfind.ads
    trunk/gcc/ada/sem_elab.adb
    trunk/gcc/ada/switch-c.adb