[multiple changes]

2015-05-26  Robert Dewar  <dewar@adacore.com>

	* errout.ads, sem_ch4.adb, sem_ch6.adb: Minor reformatting.

2015-05-26  Bob Duff  <duff@adacore.com>

	* sem_elab.adb (Check_A_Call): In the case where we're
	calling something in an instance of a generic package that is
	within this same unit (as the call), make sure we treat it
	as a call to an entity within the same unit. That is, call
	Check_Internal_Call, rather than putting "Elaborate_All(X)"
	on X, which would necessarily result in an elaboration cycle in
	static-elaboration mode.

2015-05-26  Eric Botcazou  <ebotcazou@adacore.com>

	* freeze.ads (Is_Atomic_VFA_Aggregate): Adjust profile.
	* freeze.adb (Is_Atomic_VFA_Aggregate): Change Entity
	parameter into Node parameter and remove Type parameter.
	Look at Is_Atomic_Or_VFA both on the type and on the object.
	(Freeze_Entity): Adjust call to Is_Atomic_VFA_Aggregate.
	* exp_aggr.adb (Expand_Record_Aggregate): Likewise.
	(Process_Atomic_Independent_Shared_Volatile): Remove code
	propagating Atomic or VFA from object to locally-defined type.

2015-05-26  Bob Duff  <duff@adacore.com>

	* exp_ch7.adb: Minor comment fix.

From-SVN: r223751

1 files changed, 303 insertions, 305 deletions

diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 9e514c1..07517bb 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -736,407 +736,405 @@ package body Sem_Elab is
          return;
       end if;
 
-      --  Case of entity is not in current unit (i.e. with'ed unit case)
-
-      if E_Scope /= C_Scope then
-
-         --  We are only interested in such calls if the outer call was from
-         --  elaboration code, or if we are in Dynamic_Elaboration_Checks mode.
+      --  Find top level scope for called entity (not following renamings
+      --  or derivations). This is where the Elaborate_All will go if it is
+      --  needed. We start with the called entity, except in the case of an
+      --  initialization procedure outside the current package, where the init
+      --  proc is in the root package, and we start from the entity of the name
+      --  in the call.
 
-         if not From_Elab_Code and then not Dynamic_Elaboration_Checks then
-            return;
+      declare
+         Ent : constant Entity_Id := Get_Referenced_Ent (N);
+      begin
+         if Is_Init_Proc (Ent)
+           and then not In_Same_Extended_Unit (N, Ent)
+         then
+            W_Scope := Scope (Ent);
+         else
+            W_Scope := E;
          end if;
+      end;
 
-         --  Nothing to do if some scope said that no checks were required
+      --  Now loop through scopes to get to the enclosing compilation unit
 
-         if Cunit_SC then
-            return;
-         end if;
+      while not Is_Compilation_Unit (W_Scope) loop
+         W_Scope := Scope (W_Scope);
+      end loop;
 
-         --  Nothing to do for a generic instance, because in this case the
-         --  checking was at the point of instantiation of the generic However,
-         --  this shortcut is only applicable in static mode.
+      --  Case of entity is in same unit as call or instantiation. In the
+      --  instantiation case, W_Scope may be different from E_Scope; we want
+      --  the unit in which the instantiation occurs, since we're analyzing
+      --  based on the expansion.
 
-         if Is_Generic_Instance (Ent) and not Dynamic_Elaboration_Checks then
-            return;
+      if W_Scope = C_Scope then
+         if not Inter_Unit_Only then
+            Check_Internal_Call (N, Ent, Outer_Scope, E);
          end if;
 
-         --  Nothing to do if subprogram with no separate spec. However, a
-         --  call to Deep_Initialize may result in a call to a user-defined
-         --  Initialize procedure, which imposes a body dependency. This
-         --  happens only if the type is controlled and the Initialize
-         --  procedure is not inherited.
+         return;
+      end if;
 
-         if Body_Acts_As_Spec then
-            if Is_TSS (Ent, TSS_Deep_Initialize) then
-               declare
-                  Typ  : constant Entity_Id := Etype (First_Formal (Ent));
-                  Init : Entity_Id;
+      --  Case of entity is not in current unit (i.e. with'ed unit case)
 
-               begin
-                  if not Is_Controlled (Typ) then
-                     return;
-                  else
-                     Init := Find_Prim_Op (Typ, Name_Initialize);
+      --  We are only interested in such calls if the outer call was from
+      --  elaboration code, or if we are in Dynamic_Elaboration_Checks mode.
 
-                     if Comes_From_Source (Init) then
-                        Ent := Init;
-                     else
-                        return;
-                     end if;
-                  end if;
-               end;
-
-            else
-               return;
-            end if;
-         end if;
+      if not From_Elab_Code and then not Dynamic_Elaboration_Checks then
+         return;
+      end if;
 
-         --  Check cases of internal units
+      --  Nothing to do if some scope said that no checks were required
 
-         Callee_Unit_Internal :=
-           Is_Internal_File_Name
-             (Unit_File_Name (Get_Source_Unit (E_Scope)));
+      if Cunit_SC then
+         return;
+      end if;
 
-         --  Do not give a warning if the with'ed unit is internal and this is
-         --  the generic instantiation case (this saves a lot of hassle dealing
-         --  with the Text_IO special child units)
+      --  Nothing to do for a generic instance, because in this case the
+      --  checking was at the point of instantiation of the generic However,
+      --  this shortcut is only applicable in static mode.
 
-         if Callee_Unit_Internal and Inst_Case then
-            return;
-         end if;
+      if Is_Generic_Instance (Ent) and not Dynamic_Elaboration_Checks then
+         return;
+      end if;
 
-         if C_Scope = Standard_Standard then
-            Caller_Unit_Internal := False;
-         else
-            Caller_Unit_Internal :=
-              Is_Internal_File_Name
-                (Unit_File_Name (Get_Source_Unit (C_Scope)));
-         end if;
+      --  Nothing to do if subprogram with no separate spec. However, a call
+      --  to Deep_Initialize may result in a call to a user-defined Initialize
+      --  procedure, which imposes a body dependency. This happens only if the
+      --  type is controlled and the Initialize procedure is not inherited.
 
-         --  Do not give a warning if the with'ed unit is internal and the
-         --  caller is not internal (since the binder always elaborates
-         --  internal units first).
+      if Body_Acts_As_Spec then
+         if Is_TSS (Ent, TSS_Deep_Initialize) then
+            declare
+               Typ  : constant Entity_Id := Etype (First_Formal (Ent));
+               Init : Entity_Id;
 
-         if Callee_Unit_Internal and (not Caller_Unit_Internal) then
-            return;
-         end if;
+            begin
+               if not Is_Controlled (Typ) then
+                  return;
+               else
+                  Init := Find_Prim_Op (Typ, Name_Initialize);
 
-         --  For now, if debug flag -gnatdE is not set, do no checking for
-         --  one internal unit withing another. This fixes the problem with
-         --  the sgi build and storage errors. To be resolved later ???
+                  if Comes_From_Source (Init) then
+                     Ent := Init;
+                  else
+                     return;
+                  end if;
+               end if;
+            end;
 
-         if (Callee_Unit_Internal and Caller_Unit_Internal)
-           and then not Debug_Flag_EE
-         then
+         else
             return;
          end if;
+      end if;
 
-         if Is_TSS (E, TSS_Deep_Initialize) then
-            Ent := E;
-         end if;
-
-         --  If the call is in an instance, and the called entity is not
-         --  defined in the same instance, then the elaboration issue focuses
-         --  around the unit containing the template, it is this unit which
-         --  requires an Elaborate_All.
+      --  Check cases of internal units
 
-         --  However, if we are doing dynamic elaboration, we need to chase the
-         --  call in the usual manner.
+      Callee_Unit_Internal :=
+        Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (E_Scope)));
 
-         --  We also need to chase the call in the usual manner if it is a call
-         --  to a generic formal parameter, since that case was not handled as
-         --  part of the processing of the template.
+      --  Do not give a warning if the with'ed unit is internal and this is
+      --  the generic instantiation case (this saves a lot of hassle dealing
+      --  with the Text_IO special child units)
 
-         Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N)));
-         Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent)));
+      if Callee_Unit_Internal and Inst_Case then
+         return;
+      end if;
 
-         if Inst_Caller = No_Location then
-            Unit_Caller := No_Unit;
-         else
-            Unit_Caller := Get_Source_Unit (N);
-         end if;
+      if C_Scope = Standard_Standard then
+         Caller_Unit_Internal := False;
+      else
+         Caller_Unit_Internal :=
+           Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (C_Scope)));
+      end if;
 
-         if Inst_Callee = No_Location then
-            Unit_Callee := No_Unit;
-         else
-            Unit_Callee := Get_Source_Unit (Ent);
-         end if;
+      --  Do not give a warning if the with'ed unit is internal and the
+      --  caller is not internal (since the binder always elaborates
+      --  internal units first).
 
-         if Unit_Caller /= No_Unit
-           and then Unit_Callee /= Unit_Caller
-           and then not Dynamic_Elaboration_Checks
-           and then not Is_Call_Of_Generic_Formal (N)
-         then
-            E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller));
+      if Callee_Unit_Internal and (not Caller_Unit_Internal) then
+         return;
+      end if;
 
-            --  If we don't get a spec entity, just ignore call. Not quite
-            --  clear why this check is necessary. ???
+      --  For now, if debug flag -gnatdE is not set, do no checking for
+      --  one internal unit withing another. This fixes the problem with
+      --  the sgi build and storage errors. To be resolved later ???
 
-            if No (E_Scope) then
-               return;
-            end if;
+      if (Callee_Unit_Internal and Caller_Unit_Internal)
+        and not Debug_Flag_EE
+      then
+         return;
+      end if;
 
-            --  Otherwise step to enclosing compilation unit
+      if Is_TSS (E, TSS_Deep_Initialize) then
+         Ent := E;
+      end if;
 
-            while not Is_Compilation_Unit (E_Scope) loop
-               E_Scope := Scope (E_Scope);
-            end loop;
+      --  If the call is in an instance, and the called entity is not
+      --  defined in the same instance, then the elaboration issue focuses
+      --  around the unit containing the template, it is this unit which
+      --  requires an Elaborate_All.
 
-         --  For the case where N is not an instance, and is not a call within
-         --  instance to other than a generic formal, we recompute E_Scope
-         --  for the error message, since we do NOT want to go to the unit
-         --  which has the ultimate declaration in the case of renaming and
-         --  derivation and we also want to go to the generic unit in the
-         --  case of an instance, and no further.
+      --  However, if we are doing dynamic elaboration, we need to chase the
+      --  call in the usual manner.
 
-         else
-            --  Loop to carefully follow renamings and derivations one step
-            --  outside the current unit, but not further.
+      --  We also need to chase the call in the usual manner if it is a call
+      --  to a generic formal parameter, since that case was not handled as
+      --  part of the processing of the template.
 
-            if not (Inst_Case or Variable_Case)
-              and then Present (Alias (Ent))
-            then
-               E_Scope := Alias (Ent);
-            else
-               E_Scope := Ent;
-            end if;
+      Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N)));
+      Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent)));
 
-            loop
-               while not Is_Compilation_Unit (E_Scope) loop
-                  E_Scope := Scope (E_Scope);
-               end loop;
+      if Inst_Caller = No_Location then
+         Unit_Caller := No_Unit;
+      else
+         Unit_Caller := Get_Source_Unit (N);
+      end if;
 
-               --  If E_Scope is the same as C_Scope, it means that there
-               --  definitely was a local renaming or derivation, and we
-               --  are not yet out of the current unit.
+      if Inst_Callee = No_Location then
+         Unit_Callee := No_Unit;
+      else
+         Unit_Callee := Get_Source_Unit (Ent);
+      end if;
 
-               exit when E_Scope /= C_Scope;
-               Ent := Alias (Ent);
-               E_Scope := Ent;
+      if Unit_Caller /= No_Unit
+        and then Unit_Callee /= Unit_Caller
+        and then not Dynamic_Elaboration_Checks
+        and then not Is_Call_Of_Generic_Formal (N)
+      then
+         E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller));
 
-               --  If no alias, there is a previous error
+         --  If we don't get a spec entity, just ignore call. Not quite
+         --  clear why this check is necessary. ???
 
-               if No (Ent) then
-                  Check_Error_Detected;
-                  return;
-               end if;
-            end loop;
-         end if;
-
-         if Within_Elaborate_All (Current_Sem_Unit, E_Scope) then
+         if No (E_Scope) then
             return;
          end if;
 
-         --  Find top level scope for called entity (not following renamings
-         --  or derivations). This is where the Elaborate_All will go if it
-         --  is needed. We start with the called entity, except in the case
-         --  of an initialization procedure outside the current package, where
-         --  the init proc is in the root package, and we start from the entity
-         --  of the name in the call.
-
-         declare
-            Ent : constant Entity_Id := Get_Referenced_Ent (N);
-         begin
-            if Is_Init_Proc (Ent)
-              and then not In_Same_Extended_Unit (N, Ent)
-            then
-               W_Scope := Scope (Ent);
-            else
-               W_Scope := E;
-            end if;
-         end;
-
-         --  Now loop through scopes to get to the enclosing compilation unit
+         --  Otherwise step to enclosing compilation unit
 
-         while not Is_Compilation_Unit (W_Scope) loop
-            W_Scope := Scope (W_Scope);
+         while not Is_Compilation_Unit (E_Scope) loop
+            E_Scope := Scope (E_Scope);
          end loop;
 
-         --  Now check if an elaborate_all (or dynamic check) is needed
+      --  For the case where N is not an instance, and is not a call within
+      --  instance to other than a generic formal, we recompute E_Scope
+      --  for the error message, since we do NOT want to go to the unit
+      --  which has the ultimate declaration in the case of renaming and
+      --  derivation and we also want to go to the generic unit in the
+      --  case of an instance, and no further.
 
-         if not Suppress_Elaboration_Warnings (Ent)
-           and then not Elaboration_Checks_Suppressed (Ent)
-           and then not Suppress_Elaboration_Warnings (E_Scope)
-           and then not Elaboration_Checks_Suppressed (E_Scope)
-           and then ((Elab_Warnings or Elab_Info_Messages)
-                      or else SPARK_Mode = On)
-           and then Generate_Warnings
+      else
+         --  Loop to carefully follow renamings and derivations one step
+         --  outside the current unit, but not further.
+
+         if not (Inst_Case or Variable_Case)
+           and then Present (Alias (Ent))
          then
-            --  Instantiation case
+            E_Scope := Alias (Ent);
+         else
+            E_Scope := Ent;
+         end if;
 
-            if Inst_Case then
-               if SPARK_Mode = On then
-                  Error_Msg_NE
-                    ("instantiation of & during elaboration in SPARK",
-                     N, Ent);
+         loop
+            while not Is_Compilation_Unit (E_Scope) loop
+               E_Scope := Scope (E_Scope);
+            end loop;
 
-               else
-                  Elab_Warning
-                    ("instantiation of & may raise Program_Error?l?",
-                     "info: instantiation of & during elaboration?$?", Ent);
-               end if;
+            --  If E_Scope is the same as C_Scope, it means that there
+            --  definitely was a local renaming or derivation, and we
+            --  are not yet out of the current unit.
 
-            --  Indirect call case, info message only in static elaboration
-            --  case, because the attribute reference itself cannot raise an
-            --  exception. Note that SPARK does not  permit indirect calls.
+            exit when E_Scope /= C_Scope;
+            Ent := Alias (Ent);
+            E_Scope := Ent;
 
-            elsif Access_Case then
-               Elab_Warning
-                 ("", "info: access to & during elaboration?$?", Ent);
+            --  If no alias, there is a previous error
 
-            --  Variable reference in SPARK mode
+            if No (Ent) then
+               Check_Error_Detected;
+               return;
+            end if;
+         end loop;
+      end if;
 
-            elsif Variable_Case then
-               Error_Msg_NE
-                 ("reference to & during elaboration in SPARK", N, Ent);
+      if Within_Elaborate_All (Current_Sem_Unit, E_Scope) then
+         return;
+      end if;
 
-            --  Subprogram call case
+      --  Now check if an Elaborate_All (or dynamic check) is needed
 
-            else
-               if Nkind (Name (N)) in N_Has_Entity
-                 and then Is_Init_Proc (Entity (Name (N)))
-                 and then Comes_From_Source (Ent)
-               then
-                  Elab_Warning
-                    ("implicit call to & may raise Program_Error?l?",
-                     "info: implicit call to & during elaboration?$?",
-                     Ent);
+      if not Suppress_Elaboration_Warnings (Ent)
+        and then not Elaboration_Checks_Suppressed (Ent)
+        and then not Suppress_Elaboration_Warnings (E_Scope)
+        and then not Elaboration_Checks_Suppressed (E_Scope)
+        and then ((Elab_Warnings or Elab_Info_Messages)
+                    or else SPARK_Mode = On)
+        and then Generate_Warnings
+      then
+         --  Instantiation case
 
-               elsif SPARK_Mode = On then
-                  Error_Msg_NE
-                    ("call to & during elaboration in SPARK", N, Ent);
+         if Inst_Case then
+            if SPARK_Mode = On then
+               Error_Msg_NE
+                 ("instantiation of & during elaboration in SPARK", N, Ent);
 
-               else
-                  Elab_Warning
-                    ("call to & may raise Program_Error?l?",
-                     "info: call to & during elaboration?$?",
-                     Ent);
-               end if;
+            else
+               Elab_Warning
+                 ("instantiation of & may raise Program_Error?l?",
+                  "info: instantiation of & during elaboration?$?", Ent);
             end if;
 
-            Error_Msg_Qual_Level := Nat'Last;
+         --  Indirect call case, info message only in static elaboration
+         --  case, because the attribute reference itself cannot raise an
+         --  exception. Note that SPARK does not  permit indirect calls.
 
-            --  Case of Elaborate_All not present and required, for SPARK this
-            --  is an error, so give an error message.
+         elsif Access_Case then
+            Elab_Warning ("", "info: access to & during elaboration?$?", Ent);
 
-            if SPARK_Mode = On then
-               Error_Msg_NE
-                 ("\Elaborate_All pragma required for&", N, W_Scope);
+         --  Variable reference in SPARK mode
+
+         elsif Variable_Case then
+            Error_Msg_NE
+              ("reference to & during elaboration in SPARK", N, Ent);
 
-            --  Otherwise we generate an implicit pragma. For a subprogram
-            --  instantiation, Elaborate is good enough, since no transitive
-            --  call is possible at elaboration time in this case.
+         --  Subprogram call case
 
-            elsif Nkind (N) in N_Subprogram_Instantiation then
+         else
+            if Nkind (Name (N)) in N_Has_Entity
+              and then Is_Init_Proc (Entity (Name (N)))
+              and then Comes_From_Source (Ent)
+            then
                Elab_Warning
-                 ("\missing pragma Elaborate for&?l?",
-                  "\implicit pragma Elaborate for& generated?$?",
-                  W_Scope);
+                 ("implicit call to & may raise Program_Error?l?",
+                  "info: implicit call to & during elaboration?$?",
+                  Ent);
 
-            --  For all other cases, we need an implicit Elaborate_All
+            elsif SPARK_Mode = On then
+               Error_Msg_NE ("call to & during elaboration in SPARK", N, Ent);
 
             else
                Elab_Warning
-                 ("\missing pragma Elaborate_All for&?l?",
-                  "\implicit pragma Elaborate_All for & generated?$?",
-                  W_Scope);
+                 ("call to & may raise Program_Error?l?",
+                  "info: call to & during elaboration?$?",
+                  Ent);
             end if;
+         end if;
 
-            Error_Msg_Qual_Level := 0;
+         Error_Msg_Qual_Level := Nat'Last;
 
-            --  Take into account the flags related to elaboration warning
-            --  messages when enumerating the various calls involved. This
-            --  ensures the proper pairing of the main warning and the
-            --  clarification messages generated by Output_Calls.
+         --  Case of Elaborate_All not present and required, for SPARK this
+         --  is an error, so give an error message.
 
-            Output_Calls (N, Check_Elab_Flag => True);
+         if SPARK_Mode = On then
+            Error_Msg_NE ("\Elaborate_All pragma required for&", N, W_Scope);
 
-            --  Set flag to prevent further warnings for same unit unless in
-            --  All_Errors_Mode.
+         --  Otherwise we generate an implicit pragma. For a subprogram
+         --  instantiation, Elaborate is good enough, since no transitive
+         --  call is possible at elaboration time in this case.
 
-            if not All_Errors_Mode and not Dynamic_Elaboration_Checks then
-               Set_Suppress_Elaboration_Warnings (W_Scope, True);
-            end if;
+         elsif Nkind (N) in N_Subprogram_Instantiation then
+            Elab_Warning
+              ("\missing pragma Elaborate for&?l?",
+               "\implicit pragma Elaborate for& generated?$?",
+               W_Scope);
+
+         --  For all other cases, we need an implicit Elaborate_All
+
+         else
+            Elab_Warning
+              ("\missing pragma Elaborate_All for&?l?",
+               "\implicit pragma Elaborate_All for & generated?$?",
+               W_Scope);
          end if;
 
-         --  Check for runtime elaboration check required
+         Error_Msg_Qual_Level := 0;
 
-         if Dynamic_Elaboration_Checks then
-            if not Elaboration_Checks_Suppressed (Ent)
-              and then not Elaboration_Checks_Suppressed (W_Scope)
-              and then not Elaboration_Checks_Suppressed (E_Scope)
-              and then not Cunit_SC
-            then
-               --  Runtime elaboration check required. Generate check of the
-               --  elaboration Boolean for the unit containing the entity.
+         --  Take into account the flags related to elaboration warning
+         --  messages when enumerating the various calls involved. This
+         --  ensures the proper pairing of the main warning and the
+         --  clarification messages generated by Output_Calls.
 
-               --  Note that for this case, we do check the real unit (the one
-               --  from following renamings, since that is the issue).
+         Output_Calls (N, Check_Elab_Flag => True);
 
-               --  Could this possibly miss a useless but required PE???
+         --  Set flag to prevent further warnings for same unit unless in
+         --  All_Errors_Mode.
 
-               Insert_Elab_Check (N,
-                 Make_Attribute_Reference (Loc,
-                   Attribute_Name => Name_Elaborated,
-                   Prefix         =>
-                     New_Occurrence_Of (Spec_Entity (E_Scope), Loc)));
+         if not All_Errors_Mode and not Dynamic_Elaboration_Checks then
+            Set_Suppress_Elaboration_Warnings (W_Scope, True);
+         end if;
+      end if;
 
-               --  Prevent duplicate elaboration checks on the same call,
-               --  which can happen if the body enclosing the call appears
-               --  itself in a call whose elaboration check is delayed.
+      --  Check for runtime elaboration check required
 
-               if Nkind (N) in N_Subprogram_Call then
-                  Set_No_Elaboration_Check (N);
-               end if;
-            end if;
+      if Dynamic_Elaboration_Checks then
+         if not Elaboration_Checks_Suppressed (Ent)
+           and then not Elaboration_Checks_Suppressed (W_Scope)
+           and then not Elaboration_Checks_Suppressed (E_Scope)
+           and then not Cunit_SC
+         then
+            --  Runtime elaboration check required. Generate check of the
+            --  elaboration Boolean for the unit containing the entity.
 
-         --  Case of static elaboration model
+            --  Note that for this case, we do check the real unit (the one
+            --  from following renamings, since that is the issue).
 
-         else
-            --  Do not do anything if elaboration checks suppressed. Note that
-            --  we check Ent here, not E, since we want the real entity for the
-            --  body to see if checks are suppressed for it, not the dummy
-            --  entry for renamings or derivations.
-
-            if Elaboration_Checks_Suppressed (Ent)
-              or else Elaboration_Checks_Suppressed (E_Scope)
-              or else Elaboration_Checks_Suppressed (W_Scope)
-            then
-               null;
+            --  Could this possibly miss a useless but required PE???
 
-            --  Do not generate an Elaborate_All for finalization routines
-            --  which perform partial clean up as part of initialization.
+            Insert_Elab_Check (N,
+              Make_Attribute_Reference (Loc,
+                Attribute_Name => Name_Elaborated,
+                Prefix         =>
+                  New_Occurrence_Of (Spec_Entity (E_Scope), Loc)));
 
-            elsif In_Init_Proc and then Is_Finalization_Procedure (Ent) then
-               null;
+            --  Prevent duplicate elaboration checks on the same call,
+            --  which can happen if the body enclosing the call appears
+            --  itself in a call whose elaboration check is delayed.
 
-            --  Here we need to generate an implicit elaborate all
+            if Nkind (N) in N_Subprogram_Call then
+               Set_No_Elaboration_Check (N);
+            end if;
+         end if;
 
-            else
-               --  Generate Elaborate_all warning unless suppressed
+      --  Case of static elaboration model
 
-               if (Elab_Info_Messages and Generate_Warnings and not Inst_Case)
-                 and then not Suppress_Elaboration_Warnings (Ent)
-                 and then not Suppress_Elaboration_Warnings (E_Scope)
-                 and then not Suppress_Elaboration_Warnings (W_Scope)
-               then
-                  Error_Msg_Node_2 := W_Scope;
-                  Error_Msg_NE
-                    ("info: call to& in elaboration code " &
-                     "requires pragma Elaborate_All on&?$?", N, E);
-               end if;
+      else
+         --  Do not do anything if elaboration checks suppressed. Note that
+         --  we check Ent here, not E, since we want the real entity for the
+         --  body to see if checks are suppressed for it, not the dummy
+         --  entry for renamings or derivations.
+
+         if Elaboration_Checks_Suppressed (Ent)
+           or else Elaboration_Checks_Suppressed (E_Scope)
+           or else Elaboration_Checks_Suppressed (W_Scope)
+         then
+            null;
+
+         --  Do not generate an Elaborate_All for finalization routines
+         --  which perform partial clean up as part of initialization.
 
-               --  Set indication for binder to generate Elaborate_All
+         elsif In_Init_Proc and then Is_Finalization_Procedure (Ent) then
+            null;
+
+         --  Here we need to generate an implicit elaborate all
 
-               Set_Elaboration_Constraint (N, E, W_Scope);
+         else
+            --  Generate Elaborate_All warning unless suppressed
+
+            if (Elab_Info_Messages and Generate_Warnings and not Inst_Case)
+              and then not Suppress_Elaboration_Warnings (Ent)
+              and then not Suppress_Elaboration_Warnings (E_Scope)
+              and then not Suppress_Elaboration_Warnings (W_Scope)
+            then
+               Error_Msg_Node_2 := W_Scope;
+               Error_Msg_NE
+                 ("info: call to& in elaboration code " &
+                  "requires pragma Elaborate_All on&?$?", N, E);
             end if;
-         end if;
 
-      --  Case of entity is in same unit as call or instantiation
+            --  Set indication for binder to generate Elaborate_All
 
-      elsif not Inter_Unit_Only then
-         Check_Internal_Call (N, Ent, Outer_Scope, E);
+            Set_Elaboration_Constraint (N, E, W_Scope);
+         end if;
       end if;
    end Check_A_Call;