bindgen.adb (Gen_Elab_Calls): Skip reference to elab entity if none exists (Gen_Elab_Calls): Complain if...

2014-07-17  Robert Dewar  <dewar@adacore.com>

	* bindgen.adb (Gen_Elab_Calls): Skip reference to elab
	entity if none exists (Gen_Elab_Calls): Complain if clash with
	No_Multiple_Elaboration.
	* s-rident.ads, restrict.ads: Add restriction No_Multiple_Elaboration.
	* sem_util.adb (Build_Elaboration_Entity): Skip building entity
	if not needed.
	* gnat_rm.texi: Document restriction No_Multiple_Elaboration.
	* sem_ch4.adb: Minor comment updates.

From-SVN: r212735

7 files changed, 112 insertions, 18 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cb09d48..b3f3ce6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2014-07-17  Robert Dewar  <dewar@adacore.com>
+
+	* bindgen.adb (Gen_Elab_Calls): Skip reference to elab
+	entity if none exists (Gen_Elab_Calls): Complain if clash with
+	No_Multiple_Elaboration.
+	* s-rident.ads, restrict.ads: Add restriction No_Multiple_Elaboration.
+	* sem_util.adb (Build_Elaboration_Entity): Skip building entity
+	if not needed.
+	* gnat_rm.texi: Document restriction No_Multiple_Elaboration.
+	* sem_ch4.adb: Minor comment updates.
+
 2014-07-17  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch9.adb (Buid_Protected_Subprogram_Call): Preserve type
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 270aa5e..a192953 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1068,6 +1068,8 @@ package body Bindgen is
       Check_Elab_Flag : Boolean;
 
    begin
+      --  Loop through elaboration order entries
+
       for E in Elab_Order.First .. Elab_Order.Last loop
          declare
             Unum : constant Unit_Id := Elab_Order.Table (E);
@@ -1098,20 +1100,23 @@ package body Bindgen is
 
             --  Case of no elaboration code
 
-            --  In CodePeer mode, we special case subprogram bodies which
-            --  are handled in the 'else' part below, and lead to a call to
-            --  <subp>'Elab_Subp_Body.
-
             elsif U.No_Elab
+
+              --  In CodePeer mode, we special case subprogram bodies which
+              --  are handled in the 'else' part below, and lead to a call
+              --  to <subp>'Elab_Subp_Body.
+
               and then (not CodePeer_Mode
+
+                         --  Test for spec
+
                          or else U.Utype = Is_Spec
                          or else U.Utype = Is_Spec_Only
                          or else U.Unit_Kind /= 's')
             then
-
                --  In the case of a body with a separate spec, where the
                --  separate spec has an elaboration entity defined, this is
-               --  where we increment the elaboration entity.
+               --  where we increment the elaboration entity if one exists
 
                if U.Utype = Is_Body
                  and then Units.Table (Unum_Spec).Set_Elab_Entity
@@ -1142,8 +1147,7 @@ package body Bindgen is
                --  a spec with a body, the elaboration entity is initialized
                --  here. This is done because it's the only way to accomplish
                --  initialization of such entities, as there is no mechanism
-               --  provided for initializing global variables at load time on
-               --  AAMP.
+               --  for load time global variable initialization on AAMP.
 
                elsif AAMP_On_Target
                  and then U.Utype = Is_Spec
@@ -1179,8 +1183,7 @@ package body Bindgen is
                --  a spec with a body, the elaboration entity is initialized
                --  here. This is done because it's the only way to accomplish
                --  initialization of such entities, as there is no mechanism
-               --  provided for initializing global variables at load time on
-               --  AAMP.
+               --  for load time global variable initialization on AAMP.
 
                if AAMP_On_Target
                  and then U.Utype = Is_Spec
@@ -1192,8 +1195,39 @@ package body Bindgen is
                   Write_Statement_Buffer;
                end if;
 
+               --  Check incompatibilities with No_Multiple_Elaboration
+
+               if not CodePeer_Mode
+                 and then Cumulative_Restrictions.Set (No_Multiple_Elaboration)
+               then
+                  --  Force_Checking_Of_Elaboration_Flags (-F) not allowed
+
+                  if Force_Checking_Of_Elaboration_Flags then
+                     Osint.Fail
+                       ("-F (force elaboration checks) switch not allowed "
+                        & "with restriction No_Multiple_Elaboration active");
+
+                  --  Interfacing of libraries not allowed
+
+                  elsif Interface_Library_Unit then
+                     Osint.Fail
+                       ("binding of interfaced libraries not allowed "
+                        & "with restriction No_Multiple_Elaboration active");
+
+                  --  Non-Ada main program not allowed
+
+                  elsif not Bind_Main_Program then
+                     Osint.Fail
+                       ("non-Ada main program not allowed "
+                        & "with restriction No_Multiple_Elaboration active");
+                  end if;
+               end if;
+
+               --  OK, see if we need to test elaboration flag
+
                Check_Elab_Flag :=
-                 not CodePeer_Mode
+                 Units.Table (Unum_Spec).Set_Elab_Entity
+                   and then not CodePeer_Mode
                    and then (Force_Checking_Of_Elaboration_Flags
                               or Interface_Library_Unit
                               or not Bind_Main_Program);
@@ -1253,6 +1287,7 @@ package body Bindgen is
 
                if U.Utype /= Is_Spec
                  and then not CodePeer_Mode
+                 and then Units.Table (Unum_Spec).Set_Elab_Entity
                then
                   Set_String ("      E");
                   Set_Unit_Number (Unum_Spec);
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index f7b7403..3fd1c59 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -1,3 +1,4 @@
+
 \input texinfo   @c -*-texinfo-*-
 
 @c %**start of header
@@ -446,6 +447,7 @@ Partition-Wide Restrictions
 * No_Local_Protected_Objects::
 * No_Local_Timing_Events::
 * No_Long_Long_Integers::
+* No_Multiple_Elaboration::
 * No_Nested_Finalization::
 * No_Protected_Type_Allocators::
 * No_Protected_Types::
@@ -9941,6 +9943,7 @@ then all compilation units in the partition must obey the restriction).
 * No_Local_Protected_Objects::
 * No_Local_Timing_Events::
 * No_Long_Long_Integers::
+* No_Multiple_Elaboration::
 * No_Nested_Finalization::
 * No_Protected_Type_Allocators::
 * No_Protected_Types::
@@ -10398,6 +10401,23 @@ type Standard.Long_Long_Integer, and also forbids declaring range types whose
 implicit base type is Long_Long_Integer, and modular types whose size exceeds
 Long_Integer'Size.
 
+@node No_Multiple_Elaboration
+@unnumberedsubsec No_Multiple_Elaboration
+@findex No_Multiple_Elaboration
+[GNAT] Normally each package contains a 16-bit counter used to check for access
+before elaboration, and to control multiple elaboration attempts.
+This counter is eliminated for units compiled with the static model
+of elaboration if restriction @code{No_Elaboration_Code}
+is active but because of
+the need to check for multiple elaboration in the general case, these
+counters cannot be eliminated if elaboration code may be present. The
+restriction @code{No_Multiple_Elaboration}
+allows suppression of these counters
+in static elaboration units even if they do have elaboration code. If this
+restriction is used, then the situations in which multiple elaboration is
+possible, including non-Ada main programs, and Stand Alone libraries, are not
+permitted, and will be diagnosed by the binder.
+
 @node No_Nested_Finalization
 @unnumberedsubsec No_Nested_Finalization
 @findex No_Nested_Finalization
diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
index c71eb2b1..5cae0d6 100644
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -130,6 +130,7 @@ package Restrict is
       No_Initialize_Scalars              => True,
       No_Local_Protected_Objects         => True,
       No_Long_Long_Integers              => True,
+      No_Multiple_Elaboration            => True,
       No_Protected_Type_Allocators       => True,
       No_Relative_Delay                  => True,
       No_Requeue_Statements              => True,
diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads
index 3e6e25c..3b777f7 100644
--- a/gcc/ada/s-rident.ads
+++ b/gcc/ada/s-rident.ads
@@ -125,6 +125,7 @@ package System.Rident is
       No_Local_Timing_Events,                    -- (RM D.7(10.2/2))
       No_Local_Protected_Objects,                -- Ada 2012 (D.7(10/1.3))
       No_Long_Long_Integers,                     -- GNAT
+      No_Multiple_Elaboration,                   -- GNAT
       No_Nested_Finalization,                    -- (RM D.7(4))
       No_Protected_Type_Allocators,              -- Ada 2012 (D.7 (10.3/2))
       No_Protected_Types,                        -- (RM H.4(5))
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 8c68dab..21077f6 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -408,7 +408,7 @@ package body Sem_Ch4 is
 
       --  In accordance with H.4(7), the No_Allocators restriction only applies
       --  to user-written allocators. The same consideration applies to the
-      --  No_Allocators_Before_Elaboration restriction.
+      --  No_Standard_Allocators_Before_Elaboration restriction.
 
       if Comes_From_Source (N) then
          Check_Restriction (No_Allocators, N);
@@ -428,7 +428,8 @@ package body Sem_Ch4 is
               and then List_Containing (C) = Statements (P)
             then
                --  Check for allocator within task body, this is a definite
-               --  violation of No_Allocators_After_Elaboration we can detect.
+               --  violation of No_Allocators_After_Elaboration we can detect
+               --  at compile time.
 
                if Nkind (Original_Node (Parent (P))) = N_Task_Body then
                   Check_Restriction
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 709a548..072383e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1289,19 +1289,44 @@ package body Sem_Util is
    --  Start of processing for Build_Elaboration_Entity
 
    begin
-      --  Ignore if already constructed
+      --  Ignore call if already constructed
 
       if Present (Elaboration_Entity (Spec_Id)) then
          return;
-      end if;
 
       --  Ignore in ASIS mode, elaboration entity is not in source and plays
       --  no role in analysis.
 
-      if ASIS_Mode then
+      elsif ASIS_Mode then
+         return;
+
+      --  See if we need elaboration entity. We always need it for the dynamic
+      --  elaboration model, since it is needed to properly generate the PE
+      --  exception for access before elaboration.
+
+      elsif Dynamic_Elaboration_Checks then
+         null;
+
+      --  For the static model, we don't need the elaboration counter if this
+      --  unit is sure to have no elaboration code, since that means there
+      --  is no elaboration unit to be called. Note that we can't just decide
+      --  after the fact by looking to see whether there was elaboration code,
+      --  because that's too late to make this decision.
+
+      elsif Restriction_Active (No_Elaboration_Code) then
+         return;
+
+      --  Similarly, for the static model, we can skip the elaboration counter
+      --  if we have the No_Multiple_Elaboration restriction, since for the
+      --  static model, that's the only purpose of the counter (to avoid
+      --  multiple elaboration).
+
+      elsif Restriction_Active (No_Multiple_Elaboration) then
          return;
       end if;
 
+      --  Here we need the elaboration entity
+
       --  Construct name of elaboration entity as xxx_E, where xxx is the unit
       --  name with dots replaced by double underscore. We have to manually
       --  construct this name, since it will be elaborated in the outer scope,
@@ -1351,8 +1376,8 @@ package body Sem_Util is
       Disc : Entity_Id)
    is
       Loc : constant Source_Ptr := Sloc (Expr);
-   begin
 
+   begin
       --  An entity of a type with a reference aspect is overloaded with
       --  both interpretations: with and without the dereference. Now that
       --  the dereference is made explicit, set the type of the node properly,