[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

10 files changed, 351 insertions, 69 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fa449bf..4af6ce3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+2018-04-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* 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.
+
 2018-04-04  Olivier Hainque  <hainque@adacore.com>
 
 	* libgnat/s-trasym__dwarf.adb (Executable_Name): Return argv[0] instead
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
index d6ded29..b39625c 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
@@ -1678,18 +1678,23 @@ Syntax:
   pragma Elaboration_Checks (Dynamic | Static);
 
 
-This is a configuration pragma that provides control over the
-elaboration model used by the compilation affected by the
-pragma.  If the parameter is ``Dynamic``,
-then the dynamic elaboration
-model described in the Ada Reference Manual is used, as though
-the *-gnatE* switch had been specified on the command
-line.  If the parameter is ``Static``, then the default GNAT static
-model is used.  This configuration pragma overrides the setting
-of the command line.  For full details on the elaboration models
-used by the GNAT compiler, see the chapter on elaboration order handling
-in the *GNAT User's Guide*.
+This is a configuration pragma which specifies the elaboration model to be
+used during compilation. For more information on the elaboration models of
+GNAT, consult the chapter on elaboration order handling in the *GNAT User's
+Guide*.
 
+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.
+
+If the pragma argument is ``Dynamic``, then the dynamic elaboration model is in
+effect. If the pragma argument is ``Static``, then the static elaboration model
+is in effect.
 
 Pragma Eliminate
 ================
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 4c14cae..f8017d8 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -21,7 +21,7 @@
 
 @copying
 @quotation
-GNAT Reference Manual , Jan 10, 2018
+GNAT Reference Manual , Apr 20, 2018
 
 AdaCore
 
@@ -3067,17 +3067,29 @@ Syntax:
 pragma Elaboration_Checks (Dynamic | Static);
 @end example
 
-This is a configuration pragma that provides control over the
-elaboration model used by the compilation affected by the
-pragma.  If the parameter is @code{Dynamic},
-then the dynamic elaboration
-model described in the Ada Reference Manual is used, as though
-the @emph{-gnatE} switch had been specified on the command
-line.  If the parameter is @code{Static}, then the default GNAT static
-model is used.  This configuration pragma overrides the setting
-of the command line.  For full details on the elaboration models
-used by the GNAT compiler, see the chapter on elaboration order handling
-in the @emph{GNAT User's Guide}.
+This is a configuration pragma which specifies the elaboration model to be
+used during compilation. For more information on the elaboration models of
+GNAT, consult the chapter on elaboration order handling in the @emph{GNAT User's
+Guide}.
+
+The pragma may appear in the following contexts:
+
+
+@itemize *
+
+@item 
+Configuration pragmas file
+
+@item 
+Prior to the context clauses of a compilation unit's initial declaration
+@end itemize
+
+Any other placement of the pragma will result in a warning and the effects of
+the offending pragma will be ignored.
+
+If the pragma argument is @code{Dynamic}, then the dynamic elaboration model is in
+effect. If the pragma argument is @code{Static}, then the static elaboration model
+is in effect.
 
 @node Pragma Eliminate,Pragma Enable_Atomic_Synchronization,Pragma Elaboration_Checks,Implementation Defined Pragmas
 @anchor{gnat_rm/implementation_defined_pragmas pragma-eliminate}@anchor{5b}
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 6c36057..ac8e2be 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -2390,6 +2390,12 @@ package body Sem_Ch10 is
 
       Install_SPARK_Mode (Saved_SM, Saved_SMP);
 
+      --  If the subunit is part of a compilation unit which is subject to
+      --  pragma Elaboration_Checks, set the model specified by the pragma
+      --  because it applies to all parts of the unit.
+
+      Install_Elaboration_Model (Par_Unit);
+
       Analyze (Proper_Body (Unit (N)));
       Remove_Context (N);
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index e334920..c88721f 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -3528,6 +3528,13 @@ package body Sem_Ch6 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 specified by 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));
             Set_Is_Child_Unit       (Body_Id, Is_Child_Unit       (Spec_Id));
 
@@ -3573,6 +3580,12 @@ package body Sem_Ch6 is
 
                Mark_And_Set_Ghost_Body (N, Spec_Id);
 
+               --  If the body completes a compilation unit which is subject
+               --  to pragma Elaboration_Checks, set the model specified by
+               --  the pragma because it applies to all parts of the unit.
+
+               Install_Elaboration_Model (Spec_Id);
+
             else
                Spec_Id := Find_Corresponding_Spec (N);
 
@@ -3583,6 +3596,12 @@ package body Sem_Ch6 is
 
                Mark_And_Set_Ghost_Body (N, Spec_Id);
 
+               --  If the body completes a compilation unit which is subject
+               --  to pragma Elaboration_Checks, set the model specified by
+               --  the pragma because it applies to all parts of the unit.
+
+               Install_Elaboration_Model (Spec_Id);
+
                --  In GNATprove mode, if the body has no previous spec, create
                --  one so that the inlining machinery can operate properly.
                --  Transfer aspects, if any, to the new spec, so that they
@@ -3683,6 +3702,13 @@ package body Sem_Ch6 is
             --  and expansion are properly marked as Ghost.
 
             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 specified by the pragma because it applies to all parts
+            --  of the unit.
+
+            Install_Elaboration_Model (Spec_Id);
          end if;
       end if;
 
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);
 
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index cc5d045..69d46f4 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -1780,6 +1780,10 @@ package body Sem_Elab is
    --  suitable elaboration scenarios and process them. State is the current
    --  state of the Processing phase.
 
+   function Unit_Entity (Unit_Id : Entity_Id) return Entity_Id;
+   pragma Inline (Unit_Entity);
+   --  Return the entity of the initial declaration for unit Unit_Id
+
    procedure Update_Elaboration_Scenario (New_N : Node_Id; Old_N : Node_Id);
    pragma Inline (Update_Elaboration_Scenario);
    --  Update all relevant internal data structures when scenario Old_N is
@@ -2341,6 +2345,13 @@ package body Sem_Elab is
          return;
       end if;
 
+      --  Restore the original elaboration model which was in effect when the
+      --  scenarios were first recorded. The model may be specified by pragma
+      --  Elaboration_Checks which appears on the initial declaration of the
+      --  main unit.
+
+      Install_Elaboration_Model (Unit_Entity (Cunit_Entity (Main_Unit)));
+
       --  Examine the context of the main unit and record all units with prior
       --  elaboration with respect to it.
 
@@ -7120,50 +7131,8 @@ package body Sem_Elab is
      (Unit_1 : Entity_Id;
       Unit_2 : Entity_Id) return Boolean
    is
-      function Is_Subunit (Unit_Id : Entity_Id) return Boolean;
-      pragma Inline (Is_Subunit);
-      --  Determine whether unit Unit_Id is a subunit
-
-      function Normalize_Unit (Unit_Id : Entity_Id) return Entity_Id;
-      --  Strip a potential subunit chain ending with unit Unit_Id and return
-      --  the corresponding spec.
-
-      ----------------
-      -- Is_Subunit --
-      ----------------
-
-      function Is_Subunit (Unit_Id : Entity_Id) return Boolean is
-      begin
-         return Nkind (Parent (Unit_Declaration_Node (Unit_Id))) = N_Subunit;
-      end Is_Subunit;
-
-      --------------------
-      -- Normalize_Unit --
-      --------------------
-
-      function Normalize_Unit (Unit_Id : Entity_Id) return Entity_Id is
-         Result : Entity_Id;
-
-      begin
-         --  Eliminate a potential chain of subunits to reach to proper body
-
-         Result := Unit_Id;
-         while Present (Result)
-           and then Result /= Standard_Standard
-           and then Is_Subunit (Result)
-         loop
-            Result := Scope (Result);
-         end loop;
-
-         --  Obtain the entity of the corresponding spec (if any)
-
-         return Unique_Entity (Result);
-      end Normalize_Unit;
-
-   --  Start of processing for Is_Same_Unit
-
    begin
-      return Normalize_Unit (Unit_1) = Normalize_Unit (Unit_2);
+      return Unit_Entity (Unit_1) = Unit_Entity (Unit_2);
    end Is_Same_Unit;
 
    -----------------
@@ -11153,6 +11122,55 @@ package body Sem_Elab is
       end if;
    end Traverse_Body;
 
+   -----------------
+   -- Unit_Entity --
+   -----------------
+
+   function Unit_Entity (Unit_Id : Entity_Id) return Entity_Id is
+      function Is_Subunit (Id : Entity_Id) return Boolean;
+      pragma Inline (Is_Subunit);
+      --  Determine whether the entity of an initial declaration denotes a
+      --  subunit.
+
+      ----------------
+      -- Is_Subunit --
+      ----------------
+
+      function Is_Subunit (Id : Entity_Id) return Boolean is
+         Decl : constant Node_Id := Unit_Declaration_Node (Id);
+
+      begin
+         return
+           Nkind_In (Decl, N_Generic_Package_Declaration,
+                           N_Generic_Subprogram_Declaration,
+                           N_Package_Declaration,
+                           N_Protected_Type_Declaration,
+                           N_Subprogram_Declaration,
+                           N_Task_Type_Declaration)
+             and then Present (Corresponding_Body (Decl))
+             and then Nkind (Parent (Unit_Declaration_Node
+                        (Corresponding_Body (Decl)))) = N_Subunit;
+      end Is_Subunit;
+
+      --  Local variables
+
+      Id : Entity_Id;
+
+   --  Start of processing for Unit_Entity
+
+   begin
+      Id := Unique_Entity (Unit_Id);
+
+      --  Skip all subunits found in the scope chain which ends at the input
+      --  unit.
+
+      while Is_Subunit (Id) loop
+         Id := Scope (Id);
+      end loop;
+
+      return Id;
+   end Unit_Entity;
+
    ---------------------------------
    -- Update_Elaboration_Scenario --
    ---------------------------------
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 4a5026c..11f978a 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -15267,16 +15267,118 @@ package body Sem_Prag is
 
          --  pragma Elaboration_Checks (Static | Dynamic);
 
-         when Pragma_Elaboration_Checks =>
+         when Pragma_Elaboration_Checks => Elaboration_Checks : declare
+            procedure Check_Duplicate_Elaboration_Checks_Pragma;
+            --  Emit an error if the current context list already contains
+            --  a previous Elaboration_Checks pragma. This routine raises
+            --  Pragma_Exit if a duplicate is found.
+
+            procedure Ignore_Elaboration_Checks_Pragma;
+            --  Warn that the effects of the pragma are ignored. This routine
+            --  raises Pragma_Exit.
+
+            -----------------------------------------------
+            -- Check_Duplicate_Elaboration_Checks_Pragma --
+            -----------------------------------------------
+
+            procedure Check_Duplicate_Elaboration_Checks_Pragma is
+               Item : Node_Id;
+
+            begin
+               Item := Prev (N);
+               while Present (Item) loop
+                  if Nkind (Item) = N_Pragma
+                    and then Pragma_Name (Item) = Name_Elaboration_Checks
+                  then
+                     Duplication_Error
+                       (Prag => N,
+                        Prev => Item);
+                     raise Pragma_Exit;
+                  end if;
+
+                  Prev (Item);
+               end loop;
+            end Check_Duplicate_Elaboration_Checks_Pragma;
+
+            --------------------------------------
+            -- Ignore_Elaboration_Checks_Pragma --
+            --------------------------------------
+
+            procedure Ignore_Elaboration_Checks_Pragma is
+            begin
+               Error_Msg_Name_1 := Pname;
+               Error_Msg_N ("??effects of pragma % are ignored", N);
+               Error_Msg_N
+                 ("\place pragma on initial declaration of library unit", N);
+
+               raise Pragma_Exit;
+            end Ignore_Elaboration_Checks_Pragma;
+
+            --  Local variables
+
+            Context : constant Node_Id := Parent (N);
+            Unt     : Node_Id;
+
+         --  Start of processing for Elaboration_Checks
+
+         begin
             GNAT_Pragma;
             Check_Arg_Count (1);
             Check_Arg_Is_One_Of (Arg1, Name_Static, Name_Dynamic);
 
-            --  Set flag accordingly (ignore attempt at dynamic elaboration
-            --  checks in SPARK mode).
+            --  The pragma appears in a configuration file
+
+            if No (Context) then
+               Check_Valid_Configuration_Pragma;
+               Check_Duplicate_Elaboration_Checks_Pragma;
+
+            --  The pragma acts as a configuration pragma in a compilation unit
+
+            --    pragma Elaboration_Checks (...);
+            --    package Pack is ...;
+
+            elsif Nkind (Context) = N_Compilation_Unit
+              and then List_Containing (N) = Context_Items (Context)
+            then
+               Check_Valid_Configuration_Pragma;
+               Check_Duplicate_Elaboration_Checks_Pragma;
+
+               Unt := Unit (Context);
+
+               --  The pragma must appear on the initial declaration of a unit.
+               --  If this is not the case, warn that the effects of the pragma
+               --  are ignored.
+
+               if Nkind (Unt) = N_Package_Body then
+                  Ignore_Elaboration_Checks_Pragma;
+
+               --  Check the Acts_As_Spec flag of the compilation units itself
+               --  to determine whether the subprogram body completes since it
+               --  has not been analyzed yet. This is safe because compilation
+               --  units are not overloadable.
+
+               elsif Nkind (Unt) = N_Subprogram_Body
+                 and then not Acts_As_Spec (Context)
+               then
+                  Ignore_Elaboration_Checks_Pragma;
+
+               elsif Nkind (Unt) = N_Subunit then
+                  Ignore_Elaboration_Checks_Pragma;
+               end if;
+
+            --  Otherwise the pragma does not appear at the configuration level
+            --  and is illegal.
+
+            else
+               Pragma_Misplaced;
+            end if;
+
+            --  At this point the pragma is not a duplicate, and appears in the
+            --  proper context. Set the elaboration model in effect.
 
             Dynamic_Elaboration_Checks :=
               Chars (Get_Pragma_Arg (Arg1)) = Name_Dynamic;
+         end Elaboration_Checks;
 
          ---------------
          -- Eliminate --
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 958efb0..cba7c46 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -12583,6 +12583,82 @@ package body Sem_Util is
       end loop;
    end Inspect_Deferred_Constant_Completion;
 
+   -------------------------------
+   -- Install_Elaboration_Model --
+   -------------------------------
+
+   procedure Install_Elaboration_Model (Unit_Id : Entity_Id) is
+      function Find_Elaboration_Checks_Pragma (L : List_Id) return Node_Id;
+      --  Try to find pragma Elaboration_Checks in arbitrary list L. Return
+      --  Empty if there is no such pragma.
+
+      ------------------------------------
+      -- Find_Elaboration_Checks_Pragma --
+      ------------------------------------
+
+      function Find_Elaboration_Checks_Pragma (L : List_Id) return Node_Id is
+         Item : Node_Id;
+
+      begin
+         Item := First (L);
+         while Present (Item) loop
+            if Nkind (Item) = N_Pragma
+              and then Pragma_Name (Item) = Name_Elaboration_Checks
+            then
+               return Item;
+            end if;
+
+            Next (Item);
+         end loop;
+
+         return Empty;
+      end Find_Elaboration_Checks_Pragma;
+
+      --  Local variables
+
+      Args  : List_Id;
+      Model : Node_Id;
+      Prag  : Node_Id;
+      Unit  : Node_Id;
+
+   --  Start of processing for Install_Elaboration_Model
+
+   begin
+      --  Nothing to do when the unit does not exist
+
+      if No (Unit_Id) then
+         return;
+      end if;
+
+      Unit := Parent (Unit_Declaration_Node (Unit_Id));
+
+      --  Nothing to do when the unit is not a library unit
+
+      if Nkind (Unit) /= N_Compilation_Unit then
+         return;
+      end if;
+
+      Prag := Find_Elaboration_Checks_Pragma (Context_Items (Unit));
+
+      --  The compilation unit is subject to pragma Elaboration_Checks. Set the
+      --  elaboration model as specified by the pragma.
+
+      if Present (Prag) then
+         Args := Pragma_Argument_Associations (Prag);
+
+         --  Guard against an illegal pragma. The sole argument must be an
+         --  identifier which specifies either Dynamic or Static model.
+
+         if Present (Args) then
+            Model := Get_Pragma_Arg (First (Args));
+
+            if Nkind (Model) = N_Identifier then
+               Dynamic_Elaboration_Checks := Chars (Model) = Name_Dynamic;
+            end if;
+         end if;
+      end if;
+   end Install_Elaboration_Model;
+
    -----------------------------
    -- Install_Generic_Formals --
    -----------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 3de3944..a990851 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1453,6 +1453,11 @@ package Sem_Util is
    --  whether they have been completed by a full constant declaration or an
    --  Import pragma. Emit the error message if that is not the case.
 
+   procedure Install_Elaboration_Model (Unit_Id : Entity_Id);
+   --  Install the elaboration model specified by pragma Elaboration_Checks
+   --  associated with compilation unit Unit_Id. No action is taken when the
+   --  unit lacks such pragma.
+
    procedure Install_Generic_Formals (Subp_Id : Entity_Id);
    --  Install both the generic formal parameters and the formal parameters of
    --  generic subprogram Subp_Id into visibility.