[Ada] Placement of pragma Elaboration_Checks

This patch modifies the semantics of pragma Elaboration_Checks. The pragma
was intended to be a configuration pragma, however its placement was never
verified until now.

The pragma may appear in the following contexts:

   * Configuration pragmas file

   * Prior to the context clauses of a compilation unit's initial declaration

Any other placement of the pragma will result in a warning and the effects of
the offending pragma will be ignored.

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

--  elab_checks_1.adc

pragma Elaboration_Checks (Dynamic);

--  elab_checks_2.adc

pragma Elaboration_Checks (Dynamic);
pragma Elaboration_Checks (Static);                                  --  Error

--  pack_1.ads

pragma Elaboration_Checks (Static);                                  --  OK

package Pack_1 is
end Pack_1;

--  pack_2.ads

pragma Elaboration_Checks (Static);                                  --  OK
pragma Elaboration_Checks (Static);                                  --  Error

package Pack_2 is
end Pack_2;

--  pack_3.ads

package Pack_3 is
   procedure Proc;
end Pack_3;

--  pack_3.adb

pragma Elaboration_Checks (Static);                                  --  Error

package body Pack_3 is
   procedure Proc is begin null; end Proc;
end Pack_3;

--  pack_4.ads

package Pack_4 is
   procedure Proc;
end Pack_4;

--  pack_4.adb

package body Pack_4 is
   procedure Proc is separate;
end Pack_4;

--  pack_4-proc.adb

pragma Elaboration_Checks (Static);                                  --  Error

separate (Pack_4)
procedure Proc is begin null; end Proc;

--  gen.ads

generic
   with function Called_At_Elaboration return Boolean;

package Gen is
   procedure Proc;
end Gen;

--  gen.adb

package body Gen is
   procedure Proc is
      Obj : constant Boolean := Called_At_Elaboration;
   begin null; end Proc;
begin
   Proc;
end Gen;

--  abe_static.ads

pragma Elaboration_Checks (Static);

with Gen;

package ABE_Static is
   function ABE return Boolean;

   package Inst_1 is new Gen (ABE);
end ABE_Static;

--  abe_static.adb

package body ABE_Static is
   package Inst_2 is new Gen (ABE);

   package Subunit is
   end Subunit;

   package body Subunit is separate;

   function ABE return Boolean is
   begin
      return True;
   end ABE;
end ABE_Static;

--  abe_static-subunit.adb

separate (ABE_Static)

package body Subunit is
   package Inst_3 is new Gen (ABE);

   package Nested_Subunit is
   end Nested_Subunit;

   package body Nested_Subunit is separate;
end Subunit;

--  abe_static-subunit-nested_subunit.adb

separate (ABE_Static.Subunit)

package body Nested_Subunit is
   package Inst_4 is new Gen (ABE);
end Nested_Subunit;

--  abe_static_main.adb

with ABE_Static;

procedure ABE_Static_Main is begin null; end ABE_Static_Main;

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

$ gcc -c pack_1.ads -gnatec=elab_checks_1.adc
$ gcc -c pack_1.ads -gnatec=elab_checks_2.adc
$ gcc -c pack_1.ads
$ gcc -c pack_2.ads
$ gcc -c pack_3.adb
$ gcc -c pack_4.adb
$ gnatmake -q -gnatE abe_static_main.adb
elab_checks_2.adc:2:01: pragma "Elaboration_Checks" duplicates pragma declared
  at line 1
pack_2.ads:2:01: pragma "Elaboration_Checks" duplicates pragma declared at line
  1
pack_3.adb:1:01: warning: effects of pragma "Elaboration_Checks" are ignored
pack_3.adb:1:01: warning: place pragma on initial declaration of library unit
pack_4-proc.adb:1:01: warning: effects of pragma "Elaboration_Checks" are
  ignored
pack_4-proc.adb:1:01: warning: place pragma on initial declaration of library
  unit
abe_static.adb:2:04: warning: in instantiation at gen.adb:3
abe_static.adb:2:04: warning: cannot call "ABE" before body seen
abe_static.adb:2:04: warning: Program_Error may be raised at run time
abe_static.adb:2:04: warning:   body of unit "ABE_Static" elaborated
abe_static.adb:2:04: warning:   procedure "Proc" called at gen.adb:6, instance
  at line 2
abe_static.adb:2:04: warning:   function "ABE" called at gen.adb:3, instance at
  line 2
abe_static.ads:8:04: warning: in instantiation at gen.adb:3
abe_static.ads:8:04: warning: cannot call "ABE" before body seen
abe_static.ads:8:04: warning: Program_Error may be raised at run time
abe_static.ads:8:04: warning:   spec of unit "ABE_Static" elaborated
abe_static.ads:8:04: warning:   procedure "Proc" called at gen.adb:6, instance
  at line 8
abe_static.ads:8:04: warning:   function "ABE" called at gen.adb:3, instance at
  line 8
abe_static-subunit.adb:4:04: warning: in instantiation at gen.adb:3
abe_static-subunit.adb:4:04: warning: cannot call "ABE" before body seen
abe_static-subunit.adb:4:04: warning: Program_Error may be raised at run time
abe_static-subunit.adb:4:04: warning:   body of unit "ABE_Static" elaborated
abe_static-subunit.adb:4:04: warning:   procedure "Proc" called at gen.adb:6,
  instance at line 4
abe_static-subunit.adb:4:04: warning:   function "ABE" called at gen.adb:3,
  instance at line 4
abe_static-subunit-nested_subunit.adb:4:04: warning: in instantiation at
  gen.adb:3
abe_static-subunit-nested_subunit.adb:4:04: warning: cannot call "ABE" before
  body seen
abe_static-subunit-nested_subunit.adb:4:04: warning: Program_Error may be
  raised at run time
abe_static-subunit-nested_subunit.adb:4:04: warning:   body of unit
  "ABE_Static" elaborated
abe_static-subunit-nested_subunit.adb:4:04: warning:   procedure "Proc" called
  at gen.adb:6, instance at line 4
abe_static-subunit-nested_subunit.adb:4:04: warning:   function "ABE" called at
  gen.adb:3, instance at line 4
warning: "abe_static_main.adb" has dynamic elaboration checks and with's
warning:   "abe_static.ads" which has static elaboration checks

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

gcc/ada/

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Install the elaboration
	model of the compilation unit spec, if any.
	* sem_ch7.adb (Analyze_Package_Body_Helper): Install the elaboration
	model of the compilation unit spec, if any.
	* sem_ch10.adb (Analyze_Subunit): Install the elaboration model of the
	parent compilation unit spec, if any.
	* sem_elab.adb (Check_Elaboration_Scenarios): Restore the elaboration
	model of the main unit.
	(Is_Same_Unit): The routine now uses Unit_Entity.
	(Is_Subunit): Removed.
	(Normalize_Unit): Removed.
	(Unit_Entity): New routine.
	* sem_prag.adb (Analyze_Pragma): Reimplement the handling of pragma
	Elaboration_Checks. The analysis now ensures that the pragma appears at
	the configuration level, and on the initial declaration of a unit.
	Other placements are either flagged as illegal, or ignored.
	(Check_Duplicate_Elaboration_Checks_Pragma): New routine.
	(Ignore_Elaboration_Checks_Pragma): New routine.
	* sem_util.adb (Install_Elaboration_Model): New routine.
	* sem_util.ads (Install_Elaboration_Model): New routine.
	* doc/gnat_rm/implementation_defined_pragmas.rst: Update the
	documentation of pragma Elaboration_Checks.
	* gnat_rm.texi: Regenerate.

From-SVN: r260457

1 files changed, 6 insertions, 0 deletions

diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 9302f1a..b20f77c 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -749,6 +749,12 @@ package body Sem_Ch7 is
 
       Mark_And_Set_Ghost_Body (N, Spec_Id);
 
+      --  If the body completes the initial declaration of a compilation unit
+      --  which is subject to pragma Elaboration_Checks, set the model of the
+      --  pragma because it applies to all parts of the unit.
+
+      Install_Elaboration_Model (Spec_Id);
+
       Set_Is_Compilation_Unit (Body_Id, Is_Compilation_Unit (Spec_Id));
       Style.Check_Identifier (Body_Id, Spec_Id);