diff mbox series

[Ada] Adding switch to disable implicit Elaborate_All in task case

Message ID 20170907100923.GA69520@adacore.com
State New
Headers show
Series [Ada] Adding switch to disable implicit Elaborate_All in task case | expand

Commit Message

Arnaud Charlet Sept. 7, 2017, 10:09 a.m. UTC 
This patch adds switch -gnatd.y to disable the generation of
implicit Elaborate_All on a package X when a task body calls
a procedure in the same package, and that procedure calls a
procedure in another package X.

As documented in the GNAT User Guide, when sources cannot be
modified, the recommended solution is the use of restriction
No_Entry_Calls_In_Elaboration_Code. This switch provides a
way to disable the generation of the implicit Elaborate_All
when that restriction is not applicable to the sources.

The following test now compiles without errors:

with Utils;
package body Decls is
  procedure Put_Val (Arg : Decls.My_Int) is
  begin
     Utils.Put_Val(Arg);
  end Put_Val;

  task body Lib_Task is
  begin
     accept Start;
     Put_Val (2); -- Utils.Put_Val(Arg);
  end Lib_Task;

  function Ident (M : My_Int) return My_Int is
  begin
     return M;
  end Ident;
end Decls;

package Decls is
  task Lib_Task is
     entry Start;
  end Lib_Task;

  type My_Int is new Integer;

  function Ident (M : My_Int) return My_Int;
end Decls;

with Decls;
procedure Main is
begin
   Decls.Lib_Task.Start;
end;

with Text_IO;
package body Utils is
  procedure Put_Val (Arg : Decls.My_Int) is
  begin
     Text_IO.Put_Line (Decls.My_Int'Image (Decls.Ident (Arg)));
  end Put_Val;
end Utils;

with Decls;
package Utils is
  procedure Put_Val (Arg : Decls.My_Int);
end Utils;

Command: gnatmake main.adb -gnatd.y

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

2017-09-07  Javier Miranda  <miranda@adacore.com>

	* sem_elab.adb (Check_Task_Activation): Adding switch -gnatd.y to
	allow disabling the generation of implicit pragma Elaborate_All
	on task bodies.
diff mbox series

Patch

Index: debug.adb
===================================================================
--- debug.adb	(revision 251834)
+++ debug.adb	(working copy)
@@ -115,7 +115,7 @@ 
    --  d.v
    --  d.w  Do not check for infinite loops
    --  d.x  No exception handlers
-   --  d.y
+   --  d.y  Disable implicit pragma Elaborate_All on task bodies
    --  d.z  Restore previous support for frontend handling of Inline_Always
 
    --  d.A  Read/write Aspect_Specifications hash table to tree
@@ -603,6 +603,12 @@ 
    --       fully compiled and analyzed, they just get eliminated from the
    --       code generation step.
 
+   --  d.y  Disable implicit pragma Elaborate_All on task bodies. When a task
+   --       body calls a procedure in the same package, and that procedure
+   --       calls a procedure in another package, the static elaboration
+   --       machinery adds an implicit Elaborate_All on the other package. This
+   --       switch disables the addition of the implicit pragma in such cases.
+   --
    --  d.z  Restore previous front-end support for Inline_Always. In default
    --       mode, for targets that use the GCC back end, Inline_Always is
    --       handled by the back end. Use of this switch restores the previous
Index: sem_elab.adb
===================================================================
--- sem_elab.adb	(revision 251834)
+++ sem_elab.adb	(working copy)
@@ -2961,19 +2961,21 @@ 
          Next_Elmt (Elmt);
       end loop;
 
-      --  For tasks declared in the current unit, trace other calls within
-      --  the task procedure bodies, which are available.
+      --  For tasks declared in the current unit, trace other calls within the
+      --  task procedure bodies, which are available.
 
-      In_Task_Activation := True;
+      if not Debug_Flag_Dot_Y then
+         In_Task_Activation := True;
 
-      Elmt := First_Elmt (Intra_Procs);
-      while Present (Elmt) loop
-         Ent := Node (Elmt);
-         Check_Internal_Call_Continue (N, Ent, Enclosing, Ent);
-         Next_Elmt (Elmt);
-      end loop;
+         Elmt := First_Elmt (Intra_Procs);
+         while Present (Elmt) loop
+            Ent := Node (Elmt);
+            Check_Internal_Call_Continue (N, Ent, Enclosing, Ent);
+            Next_Elmt (Elmt);
+         end loop;
 
-      In_Task_Activation := False;
+         In_Task_Activation := False;
+      end if;
    end Check_Task_Activation;
 
    -------------------------------
Index: sem_elab.ads
===================================================================
--- sem_elab.ads	(revision 251834)
+++ sem_elab.ads	(working copy)
@@ -71,7 +71,7 @@ 
    --  output a warning.
 
    --  For calls to a subprogram in a with'ed unit or a 'Access or variable
-   --  refernece (SPARK mode case), we require that a pragma Elaborate_All
+   --  reference (SPARK mode case), we require that a pragma Elaborate_All
    --  or pragma Elaborate be present, or that the referenced unit have a
    --  pragma Preelaborate, pragma Pure, or pragma Elaborate_Body. If none
    --  of these conditions is met, then a warning is generated that a pragma