Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             S E M _ E L A B                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1997-2011, 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- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --

-- for  more details.  You should have  received  a copy of the GNU General --

-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

with Atree;    use Atree;

with Checks;   use Checks;

with Debug;    use Debug;

with Einfo;    use Einfo;

with Elists;   use Elists;

with Errout;   use Errout;

with Exp_Tss;  use Exp_Tss;

with Exp_Util; use Exp_Util;

with Expander; use Expander;

with Fname;    use Fname;

with Lib;      use Lib;

with Lib.Load; use Lib.Load;

with Namet;    use Namet;

with Nlists;   use Nlists;

with Nmake;    use Nmake;

with Opt;      use Opt;

with Output;   use Output;

with Restrict; use Restrict;

with Rident;   use Rident;

with Sem;      use Sem;

with Sem_Aux;  use Sem_Aux;

with Sem_Cat;  use Sem_Cat;

with Sem_Ch7;  use Sem_Ch7;

with Sem_Ch8;  use Sem_Ch8;

with Sem_Res;  use Sem_Res;

with Sem_Type; use Sem_Type;

with Sem_Util; use Sem_Util;

with Sinfo;    use Sinfo;

with Sinput;   use Sinput;

with Snames;   use Snames;

with Stand;    use Stand;

with Table;

with Tbuild;   use Tbuild;

with Uintp;    use Uintp;

with Uname;    use Uname;

package body Sem_Elab is

   --  The following table records the recursive call chain for output in the

   --  Output routine. Each entry records the call node and the entity of the

   --  called routine. The number of entries in the table (i.e. the value of

   --  Elab_Call.Last) indicates the current depth of recursion and is used to

   --  identify the outer level.

   type Elab_Call_Entry is record

      Cloc : Source_Ptr;

      Ent  : Entity_Id;

   end record;

   package Elab_Call is new Table.Table (

     Table_Component_Type => Elab_Call_Entry,

     Table_Index_Type     => Int,

     Table_Low_Bound      => 1,

     Table_Initial        => 50,

     Table_Increment      => 100,

     Table_Name           => "Elab_Call");

   --  This table is initialized at the start of each outer level call. It

   --  holds the entities for all subprograms that have been examined for this

   --  particular outer level call, and is used to prevent both infinite

   --  recursion, and useless reanalysis of bodies already seen

   package Elab_Visited is new Table.Table (

     Table_Component_Type => Entity_Id,

     Table_Index_Type     => Int,

     Table_Low_Bound      => 1,

     Table_Initial        => 200,

     Table_Increment      => 100,

     Table_Name           => "Elab_Visited");

   --  This table stores calls to Check_Internal_Call that are delayed

   --  until all generics are instantiated, and in particular that all

   --  generic bodies have been inserted. We need to delay, because we

   --  need to be able to look through the inserted bodies.

   type Delay_Element is record

      N : Node_Id;

      --  The parameter N from the call to Check_Internal_Call. Note that

      --  this node may get rewritten over the delay period by expansion

      --  in the call case (but not in the instantiation case).

      E : Entity_Id;

      --  The parameter E from the call to Check_Internal_Call

      Orig_Ent : Entity_Id;

      --  The parameter Orig_Ent from the call to Check_Internal_Call

      Curscop : Entity_Id;

      --  The current scope of the call. This is restored when we complete

      --  the delayed call, so that we do this in the right scope.

      From_Elab_Code : Boolean;

      --  Save indication of whether this call is from elaboration code

      Outer_Scope : Entity_Id;

      --  Save scope of outer level call

   end record;

   package Delay_Check is new Table.Table (

     Table_Component_Type => Delay_Element,

     Table_Index_Type     => Int,

     Table_Low_Bound      => 1,

     Table_Initial        => 1000,

     Table_Increment      => 100,

     Table_Name           => "Delay_Check");

   C_Scope : Entity_Id;

   --  Top level scope of current scope. Compute this only once at the outer

   --  level, i.e. for a call to Check_Elab_Call from outside this unit.

   Outer_Level_Sloc : Source_Ptr;

   --  Save Sloc value for outer level call node for comparisons of source

   --  locations. A body is too late if it appears after the *outer* level

   --  call, not the particular call that is being analyzed.

   From_Elab_Code : Boolean;

   --  This flag shows whether the outer level call currently being examined

   --  is or is not in elaboration code. We are only interested in calls to

   --  routines in other units if this flag is True.

   In_Task_Activation : Boolean := False;

   --  This flag indicates whether we are performing elaboration checks on

   --  task procedures, at the point of activation. If true, we do not trace

   --  internal calls in these procedures, because all local bodies are known

   --  to be elaborated.

   Delaying_Elab_Checks : Boolean := True;

   --  This is set True till the compilation is complete, including the

   --  insertion of all instance bodies. Then when Check_Elab_Calls is called,

   --  the delay table is used to make the delayed calls and this flag is reset

   --  to False, so that the calls are processed

   -----------------------

   -- Local Subprograms --

   -----------------------

   --  Note: Outer_Scope in all following specs represents the scope of

   --  interest of the outer level call. If it is set to Standard_Standard,

   --  then it means the outer level call was at elaboration level, and that

   --  thus all calls are of interest. If it was set to some other scope,

   --  then the original call was an inner call, and we are not interested

   --  in calls that go outside this scope.

   procedure Activate_Elaborate_All_Desirable (N : Node_Id; U : Entity_Id);

   --  Analysis of construct N shows that we should set Elaborate_All_Desirable

   --  for the WITH clause for unit U (which will always be present). A special

   --  case is when N is a function or procedure instantiation, in which case

   --  it is sufficient to set Elaborate_Desirable, since in this case there is

   --  no possibility of transitive elaboration issues.

   procedure Check_A_Call

     (N                 : Node_Id;

      E                 : Entity_Id;

      Outer_Scope       : Entity_Id;

      Inter_Unit_Only   : Boolean;

      Generate_Warnings : Boolean := True;

      In_Init_Proc      : Boolean := False);

   --  This is the internal recursive routine that is called to check for a

   --  possible elaboration error. The argument N is a subprogram call or

   --  generic instantiation to be checked, and E is the entity of the called

   --  subprogram, or instantiated generic unit. The flag Outer_Scope is the

   --  outer level scope for the original call. Inter_Unit_Only is set if the

   --  call is only to be checked in the case where it is to another unit (and

   --  skipped if within a unit). Generate_Warnings is set to False to suppress

   --  warning messages about missing pragma Elaborate_All's. These messages

   --  are not wanted for inner calls in the dynamic model. Flag In_Init_Proc

   --  should be set whenever the current context is a type init proc.

   procedure Check_Bad_Instantiation (N : Node_Id);

   --  N is a node for an instantiation (if called with any other node kind,

   --  Check_Bad_Instantiation ignores the call). This subprogram checks for

   --  the special case of a generic instantiation of a generic spec in the

   --  same declarative part as the instantiation where a body is present and

   --  has not yet been seen. This is an obvious error, but needs to be checked

   --  specially at the time of the instantiation, since it is a case where we

   --  cannot insert the body anywhere. If this case is detected, warnings are

   --  generated, and a raise of Program_Error is inserted. In addition any

   --  subprograms in the generic spec are stubbed, and the Bad_Instantiation

   --  flag is set on the instantiation node. The caller in Sem_Ch12 uses this

   --  flag as an indication that no attempt should be made to insert an

   --  instance body.

   procedure Check_Internal_Call

     (N           : Node_Id;

      E           : Entity_Id;

      Outer_Scope : Entity_Id;

      Orig_Ent    : Entity_Id);

   --  N is a function call or procedure statement call node and E is the

   --  entity of the called function, which is within the current compilation

   --  unit (where subunits count as part of the parent). This call checks if

   --  this call, or any call within any accessed body could cause an ABE, and

   --  if so, outputs a warning. Orig_Ent differs from E only in the case of

   --  renamings, and points to the original name of the entity. This is used

   --  for error messages. Outer_Scope is the outer level scope for the

   --  original call.

   procedure Check_Internal_Call_Continue

     (N           : Node_Id;

      E           : Entity_Id;

      Outer_Scope : Entity_Id;

      Orig_Ent    : Entity_Id);

   --  The processing for Check_Internal_Call is divided up into two phases,

   --  and this represents the second phase. The second phase is delayed if

   --  Delaying_Elab_Calls is set to True. In this delayed case, the first

   --  phase makes an entry in the Delay_Check table, which is processed when

   --  Check_Elab_Calls is called. N, E and Orig_Ent are as for the call to

   --  Check_Internal_Call. Outer_Scope is the outer level scope for the

   --  original call.

   function Has_Generic_Body (N : Node_Id) return Boolean;

   --  N is a generic package instantiation node, and this routine determines

   --  if this package spec does in fact have a generic body. If so, then

   --  True is returned, otherwise False. Note that this is not at all the

   --  same as checking if the unit requires a body, since it deals with

   --  the case of optional bodies accurately (i.e. if a body is optional,

   --  then it looks to see if a body is actually present). Note: this

   --  function can only do a fully correct job if in generating code mode

   --  where all bodies have to be present. If we are operating in semantics

   --  check only mode, then in some cases of optional bodies, a result of

   --  False may incorrectly be given. In practice this simply means that

   --  some cases of warnings for incorrect order of elaboration will only

   --  be given when generating code, which is not a big problem (and is

   --  inevitable, given the optional body semantics of Ada).

   procedure Insert_Elab_Check (N : Node_Id; C : Node_Id := Empty);

   --  Given code for an elaboration check (or unconditional raise if the check

   --  is not needed), inserts the code in the appropriate place. N is the call

   --  or instantiation node for which the check code is required. C is the

   --  test whose failure triggers the raise.

   function Is_Finalization_Procedure (Id : Entity_Id) return Boolean;

   --  Determine whether entity Id denotes a [Deep_]Finalize procedure

   procedure Output_Calls (N : Node_Id);

   --  Outputs chain of calls stored in the Elab_Call table. The caller has

   --  already generated the main warning message, so the warnings generated

   --  are all continuation messages. The argument is the call node at which

   --  the messages are to be placed.

   function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean;

   --  Given two scopes, determine whether they are the same scope from an

   --  elaboration point of view, i.e. packages and blocks are ignored.

   procedure Set_C_Scope;

   --  On entry C_Scope is set to some scope. On return, C_Scope is reset

   --  to be the enclosing compilation unit of this scope.

   procedure Set_Elaboration_Constraint

    (Call : Node_Id;

     Subp : Entity_Id;

     Scop : Entity_Id);

   --  The current unit U may depend semantically on some unit P which is not

   --  in the current context. If there is an elaboration call that reaches P,

   --  we need to indicate that P requires an Elaborate_All, but this is not

   --  effective in U's ali file, if there is no with_clause for P. In this

   --  case we add the Elaborate_All on the unit Q that directly or indirectly

   --  makes P available. This can happen in two cases:

   --

   --    a) Q declares a subtype of a type declared in P, and the call is an

   --    initialization call for an object of that subtype.

   --

   --    b) Q declares an object of some tagged type whose root type is

   --    declared in P, and the initialization call uses object notation on

   --    that object to reach a primitive operation or a classwide operation

   --    declared in P.

   --

   --  If P appears in the context of U, the current processing is correct.

   --  Otherwise we must identify these two cases to retrieve Q and place the

   --  Elaborate_All_Desirable on it.

   function Spec_Entity (E : Entity_Id) return Entity_Id;

   --  Given a compilation unit entity, if it is a spec entity, it is returned

   --  unchanged. If it is a body entity, then the spec for the corresponding

   --  spec is returned

   procedure Supply_Bodies (N : Node_Id);

   --  Given a node, N, that is either a subprogram declaration or a package

   --  declaration, this procedure supplies dummy bodies for the subprogram

   --  or for all subprograms in the package. If the given node is not one

   --  of these two possibilities, then Supply_Bodies does nothing. The

   --  dummy body contains a single Raise statement.

   procedure Supply_Bodies (L : List_Id);

   --  Calls Supply_Bodies for all elements of the given list L

   function Within (E1, E2 : Entity_Id) return Boolean;

   --  Given two scopes E1 and E2, returns True if E1 is equal to E2, or is one

   --  of its contained scopes, False otherwise.

   function Within_Elaborate_All (E : Entity_Id) return Boolean;

   --  Before emitting a warning on a scope E for a missing elaborate_all,

   --  check whether E may be in the context of a directly visible unit U to

   --  which the pragma applies. This prevents spurious warnings when the

   --  called entity is renamed within U.

   --------------------------------------

   -- Activate_Elaborate_All_Desirable --

   --------------------------------------

   procedure Activate_Elaborate_All_Desirable (N : Node_Id; U : Entity_Id) is

      UN  : constant Unit_Number_Type := Get_Code_Unit (N);

      CU  : constant Node_Id          := Cunit (UN);

      UE  : constant Entity_Id        := Cunit_Entity (UN);

      Unm : constant Unit_Name_Type   := Unit_Name (UN);

      CI  : constant List_Id          := Context_Items (CU);

      Itm : Node_Id;

      Ent : Entity_Id;

      procedure Add_To_Context_And_Mark (Itm : Node_Id);

      --  This procedure is called when the elaborate indication must be

      --  applied to a unit not in the context of the referencing unit. The

      --  unit gets added to the context as an implicit with.

      function In_Withs_Of (UEs : Entity_Id) return Boolean;

      --  UEs is the spec entity of a unit. If the unit to be marked is

      --  in the context item list of this unit spec, then the call returns

      --  True and Itm is left set to point to the relevant N_With_Clause node.

      procedure Set_Elab_Flag (Itm : Node_Id);

      --  Sets Elaborate_[All_]Desirable as appropriate on Itm

      -----------------------------

      -- Add_To_Context_And_Mark --

      -----------------------------

      procedure Add_To_Context_And_Mark (Itm : Node_Id) is

         CW : constant Node_Id :=

                Make_With_Clause (Sloc (Itm),

                  Name => Name (Itm));

      begin

         Set_Library_Unit  (CW, Library_Unit (Itm));

         Set_Implicit_With (CW, True);

         --  Set elaborate all desirable on copy and then append the copy to

         --  the list of body with's and we are done.

         Set_Elab_Flag (CW);

         Append_To (CI, CW);

      end Add_To_Context_And_Mark;

      -----------------

      -- In_Withs_Of --

      -----------------

      function In_Withs_Of (UEs : Entity_Id) return Boolean is

         UNs : constant Unit_Number_Type := Get_Source_Unit (UEs);

         CUs : constant Node_Id          := Cunit (UNs);

         CIs : constant List_Id          := Context_Items (CUs);

      begin

         Itm := First (CIs);

         while Present (Itm) loop

            if Nkind (Itm) = N_With_Clause then

               Ent :=

                 Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm)));

               if U = Ent then

                  return True;

               end if;

            end if;

            Next (Itm);

         end loop;

         return False;

      end In_Withs_Of;

      -------------------

      -- Set_Elab_Flag --

      -------------------

      procedure Set_Elab_Flag (Itm : Node_Id) is

      begin

         if Nkind (N) in N_Subprogram_Instantiation then

            Set_Elaborate_Desirable (Itm);

         else

            Set_Elaborate_All_Desirable (Itm);

         end if;

      end Set_Elab_Flag;

   --  Start of processing for Activate_Elaborate_All_Desirable

   begin

      --  Do not set binder indication if expansion is disabled, as when

      --  compiling a generic unit.

      if not Expander_Active then

         return;

      end if;

      Itm := First (CI);

      while Present (Itm) loop

         if Nkind (Itm) = N_With_Clause then

            Ent := Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm)));

            --  If we find it, then mark elaborate all desirable and return

            if U = Ent then

               Set_Elab_Flag (Itm);

               return;

            end if;

         end if;

         Next (Itm);

      end loop;

      --  If we fall through then the with clause is not present in the

      --  current unit. One legitimate possibility is that the with clause

      --  is present in the spec when we are a body.

      if Is_Body_Name (Unm)

        and then In_Withs_Of (Spec_Entity (UE))

      then

         Add_To_Context_And_Mark (Itm);

         return;

      end if;

      --  Similarly, we may be in the spec or body of a child unit, where

      --  the unit in question is with'ed by some ancestor of the child unit.

      if Is_Child_Name (Unm) then

         declare

            Pkg : Entity_Id;

         begin

            Pkg := UE;

            loop

               Pkg := Scope (Pkg);

               exit when Pkg = Standard_Standard;

               if In_Withs_Of (Pkg) then

                  Add_To_Context_And_Mark (Itm);

                  return;

               end if;

            end loop;

         end;

      end if;

      --  Here if we do not find with clause on spec or body. We just ignore

      --  this case, it means that the elaboration involves some other unit

      --  than the unit being compiled, and will be caught elsewhere.

      null;

   end Activate_Elaborate_All_Desirable;

   ------------------

   -- Check_A_Call --

   ------------------

   procedure Check_A_Call

     (N                 : Node_Id;

      E                 : Entity_Id;

      Outer_Scope       : Entity_Id;

      Inter_Unit_Only   : Boolean;

      Generate_Warnings : Boolean := True;

      In_Init_Proc      : Boolean := False)

   is

      Loc  : constant Source_Ptr := Sloc (N);

      Ent  : Entity_Id;

      Decl : Node_Id;

      E_Scope : Entity_Id;

      --  Top level scope of entity for called subprogram. This value includes

      --  following renamings and derivations, so this scope can be in a

      --  non-visible unit. This is the scope that is to be investigated to

      --  see whether an elaboration check is required.

      W_Scope : Entity_Id;

      --  Top level scope of directly called entity for subprogram. This

      --  differs from E_Scope in the case where renamings or derivations

      --  are involved, since it does not follow these links. W_Scope is

      --  generally in a visible unit, and it is this scope that may require

      --  an Elaborate_All. However, there are some cases (initialization

      --  calls and calls involving object notation) where W_Scope might not

      --  be in the context of the current unit, and there is an intermediate

      --  package that is, in which case the Elaborate_All has to be placed

      --  on this intermediate package. These special cases are handled in

      --  Set_Elaboration_Constraint.

      Body_Acts_As_Spec : Boolean;

      --  Set to true if call is to body acting as spec (no separate spec)

      Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation;

      --  Indicates if we have instantiation case

      Caller_Unit_Internal : Boolean;

      Callee_Unit_Internal : Boolean;

      Inst_Caller : Source_Ptr;

      Inst_Callee : Source_Ptr;

      Unit_Caller : Unit_Number_Type;

      Unit_Callee : Unit_Number_Type;

      Cunit_SC : Boolean := False;

      --  Set to suppress dynamic elaboration checks where one of the

      --  enclosing scopes has Elaboration_Checks_Suppressed set, or else

      --  if a pragma Elaborate (_All) applies to that scope, in which case

      --  warnings on the scope are also suppressed. For the internal case,

      --  we ignore this flag.

   begin

      --  If the call is known to be within a local Suppress Elaboration

      --  pragma, nothing to check. This can happen in task bodies.

      if (Nkind (N) = N_Function_Call

           or else Nkind (N) = N_Procedure_Call_Statement)

        and then No_Elaboration_Check (N)

      then

         return;

      end if;

      --  Go to parent for derived subprogram, or to original subprogram in the

      --  case of a renaming (Alias covers both these cases).

      Ent := E;

      loop

         if (Suppress_Elaboration_Warnings (Ent)

              or else Elaboration_Checks_Suppressed (Ent))

           and then (Inst_Case or else No (Alias (Ent)))

         then

            return;

         end if;

         --  Nothing to do for imported entities

         if Is_Imported (Ent) then

            return;

         end if;

         exit when Inst_Case or else No (Alias (Ent));

         Ent := Alias (Ent);

      end loop;

      Decl := Unit_Declaration_Node (Ent);

      if Nkind (Decl) = N_Subprogram_Body then

         Body_Acts_As_Spec := True;

      elsif Nkind (Decl) = N_Subprogram_Declaration

        or else Nkind (Decl) = N_Subprogram_Body_Stub

        or else Inst_Case

      then

         Body_Acts_As_Spec := False;

      --  If we have none of an instantiation, subprogram body or

      --  subprogram declaration, then it is not a case that we want

      --  to check. (One case is a call to a generic formal subprogram,

      --  where we do not want the check in the template).

      else

         return;

      end if;

      E_Scope := Ent;

      loop

         if Elaboration_Checks_Suppressed (E_Scope)

           or else Suppress_Elaboration_Warnings (E_Scope)

         then

            Cunit_SC := True;

         end if;

         --  Exit when we get to compilation unit, not counting subunits

         exit when Is_Compilation_Unit (E_Scope)

           and then (Is_Child_Unit (E_Scope)

                       or else Scope (E_Scope) = Standard_Standard);

         --  If we did not find a compilation unit, other than standard,

         --  then nothing to check (happens in some instantiation cases)

         if E_Scope = Standard_Standard then

            return;

         --  Otherwise move up a scope looking for compilation unit

         else

            E_Scope := Scope (E_Scope);

         end if;

      end loop;

      --  No checks needed for pure or preelaborated compilation units

      if Is_Pure (E_Scope) or else Is_Preelaborated (E_Scope) then

         return;

      end if;

      --  If the generic entity is within a deeper instance than we are, then

      --  either the instantiation to which we refer itself caused an ABE, in

      --  which case that will be handled separately, or else we know that the

      --  body we need appears as needed at the point of the instantiation.

      --  However, this assumption is only valid if we are in static mode.

      if not Dynamic_Elaboration_Checks

        and then Instantiation_Depth (Sloc (Ent)) >

                 Instantiation_Depth (Sloc (N))

      then

         return;

      end if;

      --  Do not give a warning for a package with no body

      if Ekind (Ent) = E_Generic_Package

        and then not Has_Generic_Body (N)

      then

         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.

         if not From_Elab_Code and then not Dynamic_Elaboration_Checks then

            return;

         end if;

         --  Nothing to do if some scope said that no checks were required

         if Cunit_SC then

            return;

         end if;

         --  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 Is_Generic_Instance (Ent) and not Dynamic_Elaboration_Checks then

            return;

         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.

         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;

               begin

                  if not Is_Controlled (Typ) then

                     return;

                  else

                     Init := Find_Prim_Op (Typ, Name_Initialize);

                     if Comes_From_Source (Init) then

                        Ent := Init;

                     else

                        return;

                     end if;

                  end if;

               end;

            else

               return;

            end if;

         end if;

         --  Check cases of internal units

         Callee_Unit_Internal :=

           Is_Internal_File_Name

             (Unit_File_Name (Get_Source_Unit (E_Scope)));

         --  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)

         if Callee_Unit_Internal and Inst_Case 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;

         --  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 Callee_Unit_Internal and (not Caller_Unit_Internal) then

            return;

         end if;

         --  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 (Callee_Unit_Internal and Caller_Unit_Internal)

            and then not Debug_Flag_EE

         then

            return;

         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.

         --  However, if we are doing dynamic elaboration, we need to

         --  chase the call in the usual manner.

         --  We do not handle the case of calling a generic formal correctly

         --  in the static case. See test 4703-004 to explore this gap ???

         Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N)));

         Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent)));

         if Inst_Caller = No_Location then

            Unit_Caller := No_Unit;

         else

            Unit_Caller := Get_Source_Unit (N);

         end if;

         if Inst_Callee = No_Location then

            Unit_Callee := No_Unit;

         else

            Unit_Callee := Get_Source_Unit (Ent);

         end if;

         if Unit_Caller /= No_Unit

           and then Unit_Callee /= Unit_Caller

           and then not Dynamic_Elaboration_Checks

         then

            E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller));

            --  If we don't get a spec entity, just ignore call. Not quite

            --  clear why this check is necessary. ???

            if No (E_Scope) then

               return;

            end if;

            --  Otherwise step to enclosing compilation unit

            while not Is_Compilation_Unit (E_Scope) loop

               E_Scope := Scope (E_Scope);

            end loop;

         --  For the case N is not an instance, or a call within instance, 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.

         else

            --  Loop to carefully follow renamings and derivations one step

            --  outside the current unit, but not further.

            if not Inst_Case

              and then Present (Alias (Ent))

            then

               E_Scope := Alias (Ent);

            else

               E_Scope := Ent;