Subversion Repositories openrisc

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

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                              S E M . C H 8                               --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2012, 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 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 Fname;    use Fname;

with Freeze;   use Freeze;

with Impunit;  use Impunit;

with Lib;      use Lib;

with Lib.Load; use Lib.Load;

with Lib.Xref; use Lib.Xref;

with Namet;    use Namet;

with Namet.Sp; use Namet.Sp;

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 Rtsfind;  use Rtsfind;

with Sem;      use Sem;

with Sem_Aux;  use Sem_Aux;

with Sem_Cat;  use Sem_Cat;

with Sem_Ch3;  use Sem_Ch3;

with Sem_Ch4;  use Sem_Ch4;

with Sem_Ch6;  use Sem_Ch6;

with Sem_Ch12; use Sem_Ch12;

with Sem_Ch13; use Sem_Ch13;

with Sem_Dim;  use Sem_Dim;

with Sem_Disp; use Sem_Disp;

with Sem_Dist; use Sem_Dist;

with Sem_Eval; use Sem_Eval;

with Sem_Res;  use Sem_Res;

with Sem_Util; use Sem_Util;

with Sem_Type; use Sem_Type;

with Stand;    use Stand;

with Sinfo;    use Sinfo;

with Sinfo.CN; use Sinfo.CN;

with Snames;   use Snames;

with Style;    use Style;

with Table;

with Targparm; use Targparm;

with Tbuild;   use Tbuild;

with Uintp;    use Uintp;

package body Sem_Ch8 is

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

   -- Visibility and Name Resolution --

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

   --  This package handles name resolution and the collection of possible

   --  interpretations for overloaded names, prior to overload resolution.

   --  Name resolution is the process that establishes a mapping between source

   --  identifiers and the entities they denote at each point in the program.

   --  Each entity is represented by a defining occurrence. Each identifier

   --  that denotes an entity points to the corresponding defining occurrence.

   --  This is the entity of the applied occurrence. Each occurrence holds

   --  an index into the names table, where source identifiers are stored.

   --  Each entry in the names table for an identifier or designator uses the

   --  Info pointer to hold a link to the currently visible entity that has

   --  this name (see subprograms Get_Name_Entity_Id and Set_Name_Entity_Id

   --  in package Sem_Util). The visibility is initialized at the beginning of

   --  semantic processing to make entities in package Standard immediately

   --  visible. The visibility table is used in a more subtle way when

   --  compiling subunits (see below).

   --  Entities that have the same name (i.e. homonyms) are chained. In the

   --  case of overloaded entities, this chain holds all the possible meanings

   --  of a given identifier. The process of overload resolution uses type

   --  information to select from this chain the unique meaning of a given

   --  identifier.

   --  Entities are also chained in their scope, through the Next_Entity link.

   --  As a consequence, the name space is organized as a sparse matrix, where

   --  each row corresponds to a scope, and each column to a source identifier.

   --  Open scopes, that is to say scopes currently being compiled, have their

   --  corresponding rows of entities in order, innermost scope first.

   --  The scopes of packages that are mentioned in  context clauses appear in

   --  no particular order, interspersed among open scopes. This is because

   --  in the course of analyzing the context of a compilation, a package

   --  declaration is first an open scope, and subsequently an element of the

   --  context. If subunits or child units are present, a parent unit may

   --  appear under various guises at various times in the compilation.

   --  When the compilation of the innermost scope is complete, the entities

   --  defined therein are no longer visible. If the scope is not a package

   --  declaration, these entities are never visible subsequently, and can be

   --  removed from visibility chains. If the scope is a package declaration,

   --  its visible declarations may still be accessible. Therefore the entities

   --  defined in such a scope are left on the visibility chains, and only

   --  their visibility (immediately visibility or potential use-visibility)

   --  is affected.

   --  The ordering of homonyms on their chain does not necessarily follow

   --  the order of their corresponding scopes on the scope stack. For

   --  example, if package P and the enclosing scope both contain entities

   --  named E, then when compiling the package body the chain for E will

   --  hold the global entity first,  and the local one (corresponding to

   --  the current inner scope) next. As a result, name resolution routines

   --  do not assume any relative ordering of the homonym chains, either

   --  for scope nesting or to order of appearance of context clauses.

   --  When compiling a child unit, entities in the parent scope are always

   --  immediately visible. When compiling the body of a child unit, private

   --  entities in the parent must also be made immediately visible. There

   --  are separate routines to make the visible and private declarations

   --  visible at various times (see package Sem_Ch7).

   --              +--------+         +-----+

   --              | In use |-------->| EU1 |-------------------------->

   --              +--------+         +-----+

   --                                    |                      |

   --      +--------+                 +-----+                +-----+

   --      | Stand. |---------------->| ES1 |--------------->| ES2 |--->

   --      +--------+                 +-----+                +-----+

   --                                    |                      |

   --              +---------+           |                   +-----+

   --              | with'ed |------------------------------>| EW2 |--->

   --              +---------+           |                   +-----+

   --                                    |                      |

   --      +--------+                 +-----+                +-----+

   --      | Scope2 |---------------->| E12 |--------------->| E22 |--->

   --      +--------+                 +-----+                +-----+

   --                                    |                      |

   --      +--------+                 +-----+                +-----+

   --      | Scope1 |---------------->| E11 |--------------->| E12 |--->

   --      +--------+                 +-----+                +-----+

   --          ^                         |                      |

   --          |                         |                      |

   --          |   +---------+           |                      |

   --          |   | with'ed |----------------------------------------->

   --          |   +---------+           |                      |

   --          |                         |                      |

   --      Scope stack                   |                      |

   --      (innermost first)             |                      |

   --                                 +----------------------------+

   --      Names  table =>            | Id1 |     |    |     | Id2 |

   --                                 +----------------------------+

   --  Name resolution must deal with several syntactic forms: simple names,

   --  qualified names, indexed names, and various forms of calls.

   --  Each identifier points to an entry in the names table. The resolution

   --  of a simple name consists in traversing the homonym chain, starting

   --  from the names table. If an entry is immediately visible, it is the one

   --  designated by the identifier. If only potentially use-visible entities

   --  are on the chain, we must verify that they do not hide each other. If

   --  the entity we find is overloadable, we collect all other overloadable

   --  entities on the chain as long as they are not hidden.

   --

   --  To resolve expanded names, we must find the entity at the intersection

   --  of the entity chain for the scope (the prefix) and the homonym chain

   --  for the selector. In general, homonym chains will be much shorter than

   --  entity chains, so it is preferable to start from the names table as

   --  well. If the entity found is overloadable, we must collect all other

   --  interpretations that are defined in the scope denoted by the prefix.

   --  For records, protected types, and tasks, their local entities are

   --  removed from visibility chains on exit from the corresponding scope.

   --  From the outside, these entities are always accessed by selected

   --  notation, and the entity chain for the record type, protected type,

   --  etc. is traversed sequentially in  order to find the designated entity.

   --  The discriminants of a type and the operations of a protected type or

   --  task are unchained on  exit from the first view of the type, (such as

   --  a private or incomplete type declaration, or a protected type speci-

   --  fication) and re-chained when compiling the second view.

   --  In the case of operators,  we do not make operators on derived types

   --  explicit. As a result, the notation P."+" may denote either a user-

   --  defined function with name "+", or else an implicit declaration of the

   --  operator "+" in package P. The resolution of expanded names always

   --  tries to resolve an operator name as such an implicitly defined entity,

   --  in addition to looking for explicit declarations.

   --  All forms of names that denote entities (simple names, expanded names,

   --  character literals in some cases) have a Entity attribute, which

   --  identifies the entity denoted by the name.

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

   -- The Scope Stack --

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

   --  The Scope stack keeps track of the scopes currently been compiled.

   --  Every entity that contains declarations (including records) is placed

   --  on the scope stack while it is being processed, and removed at the end.

   --  Whenever a non-package scope is exited, the entities defined therein

   --  are removed from the visibility table, so that entities in outer scopes

   --  become visible (see previous description). On entry to Sem, the scope

   --  stack only contains the package Standard. As usual, subunits complicate

   --  this picture ever so slightly.

   --  The Rtsfind mechanism can force a call to Semantics while another

   --  compilation is in progress. The unit retrieved by Rtsfind must be

   --  compiled in  its own context, and has no access to the visibility of

   --  the unit currently being compiled. The procedures Save_Scope_Stack and

   --  Restore_Scope_Stack make entities in current open scopes invisible

   --  before compiling the retrieved unit, and restore the compilation

   --  environment afterwards.

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

   -- Compiling subunits --

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

   --  Subunits must be compiled in the environment of the corresponding stub,

   --  that is to say with the same visibility into the parent (and its

   --  context) that is available at the point of the stub declaration, but

   --  with the additional visibility provided by the context clause of the

   --  subunit itself. As a result, compilation of a subunit forces compilation

   --  of the parent (see description in lib-). At the point of the stub

   --  declaration, Analyze is called recursively to compile the proper body of

   --  the subunit, but without reinitializing the names table, nor the scope

   --  stack (i.e. standard is not pushed on the stack). In this fashion the

   --  context of the subunit is added to the context of the parent, and the

   --  subunit is compiled in the correct environment. Note that in the course

   --  of processing the context of a subunit, Standard will appear twice on

   --  the scope stack: once for the parent of the subunit, and once for the

   --  unit in the context clause being compiled. However, the two sets of

   --  entities are not linked by homonym chains, so that the compilation of

   --  any context unit happens in a fresh visibility environment.

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

   -- Processing of USE Clauses --

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

   --  Every defining occurrence has a flag indicating if it is potentially use

   --  visible. Resolution of simple names examines this flag. The processing

   --  of use clauses consists in setting this flag on all visible entities

   --  defined in the corresponding package. On exit from the scope of the use

   --  clause, the corresponding flag must be reset. However, a package may

   --  appear in several nested use clauses (pathological but legal, alas!)

   --  which forces us to use a slightly more involved scheme:

   --    a) The defining occurrence for a package holds a flag -In_Use- to

   --    indicate that it is currently in the scope of a use clause. If a

   --    redundant use clause is encountered, then the corresponding occurrence

   --    of the package name is flagged -Redundant_Use-.

   --    b) On exit from a scope, the use clauses in its declarative part are

   --    scanned. The visibility flag is reset in all entities declared in

   --    package named in a use clause, as long as the package is not flagged

   --    as being in a redundant use clause (in which case the outer use

   --    clause is still in effect, and the direct visibility of its entities

   --    must be retained).

   --  Note that entities are not removed from their homonym chains on exit

   --  from the package specification. A subsequent use clause does not need

   --  to rechain the visible entities, but only to establish their direct

   --  visibility.

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

   -- Handling private declarations --

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

   --  The principle that each entity has a single defining occurrence clashes

   --  with the presence of two separate definitions for private types: the

   --  first is the private type declaration, and second is the full type

   --  declaration. It is important that all references to the type point to

   --  the same defining occurrence, namely the first one. To enforce the two

   --  separate views of the entity, the corresponding information is swapped

   --  between the two declarations. Outside of the package, the defining

   --  occurrence only contains the private declaration information, while in

   --  the private part and the body of the package the defining occurrence

   --  contains the full declaration. To simplify the swap, the defining

   --  occurrence that currently holds the private declaration points to the

   --  full declaration. During semantic processing the defining occurrence

   --  also points to a list of private dependents, that is to say access types

   --  or composite types whose designated types or component types are

   --  subtypes or derived types of the private type in question. After the

   --  full declaration has been seen, the private dependents are updated to

   --  indicate that they have full definitions.

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

   -- Handling of Undefined Messages --

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

   --  In normal mode, only the first use of an undefined identifier generates

   --  a message. The table Urefs is used to record error messages that have

   --  been issued so that second and subsequent ones do not generate further

   --  messages. However, the second reference causes text to be added to the

   --  original undefined message noting "(more references follow)". The

   --  full error list option (-gnatf) forces messages to be generated for

   --  every reference and disconnects the use of this table.

   type Uref_Entry is record

      Node : Node_Id;

      --  Node for identifier for which original message was posted. The

      --  Chars field of this identifier is used to detect later references

      --  to the same identifier.

      Err : Error_Msg_Id;

      --  Records error message Id of original undefined message. Reset to

      --  No_Error_Msg after the second occurrence, where it is used to add

      --  text to the original message as described above.

      Nvis : Boolean;

      --  Set if the message is not visible rather than undefined

      Loc : Source_Ptr;

      --  Records location of error message. Used to make sure that we do

      --  not consider a, b : undefined as two separate instances, which

      --  would otherwise happen, since the parser converts this sequence

      --  to a : undefined; b : undefined.

   end record;

   package Urefs is new Table.Table (

     Table_Component_Type => Uref_Entry,

     Table_Index_Type     => Nat,

     Table_Low_Bound      => 1,

     Table_Initial        => 10,

     Table_Increment      => 100,

     Table_Name           => "Urefs");

   Candidate_Renaming : Entity_Id;

   --  Holds a candidate interpretation that appears in a subprogram renaming

   --  declaration and does not match the given specification, but matches at

   --  least on the first formal. Allows better error message when given

   --  specification omits defaulted parameters, a common error.

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

   -- Local Subprograms --

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

   procedure Analyze_Generic_Renaming

     (N : Node_Id;

      K : Entity_Kind);

   --  Common processing for all three kinds of generic renaming declarations.

   --  Enter new name and indicate that it renames the generic unit.

   procedure Analyze_Renamed_Character

     (N       : Node_Id;

      New_S   : Entity_Id;

      Is_Body : Boolean);

   --  Renamed entity is given by a character literal, which must belong

   --  to the return type of the new entity. Is_Body indicates whether the

   --  declaration is a renaming_as_body. If the original declaration has

   --  already been frozen (because of an intervening body, e.g.) the body of

   --  the function must be built now. The same applies to the following

   --  various renaming procedures.

   procedure Analyze_Renamed_Dereference

     (N       : Node_Id;

      New_S   : Entity_Id;

      Is_Body : Boolean);

   --  Renamed entity is given by an explicit dereference. Prefix must be a

   --  conformant access_to_subprogram type.

   procedure Analyze_Renamed_Entry

     (N       : Node_Id;

      New_S   : Entity_Id;

      Is_Body : Boolean);

   --  If the renamed entity in a subprogram renaming is an entry or protected

   --  subprogram, build a body for the new entity whose only statement is a

   --  call to the renamed entity.

   procedure Analyze_Renamed_Family_Member

     (N       : Node_Id;

      New_S   : Entity_Id;

      Is_Body : Boolean);

   --  Used when the renamed entity is an indexed component. The prefix must

   --  denote an entry family.

   procedure Analyze_Renamed_Primitive_Operation

     (N       : Node_Id;

      New_S   : Entity_Id;

      Is_Body : Boolean);

   --  If the renamed entity in a subprogram renaming is a primitive operation

   --  or a class-wide operation in prefix form, save the target object, which

   --  must be added to the list of actuals in any subsequent call.

   function Applicable_Use (Pack_Name : Node_Id) return Boolean;

   --  Common code to Use_One_Package and Set_Use, to determine whether use

   --  clause must be processed. Pack_Name is an entity name that references

   --  the package in question.

   procedure Attribute_Renaming (N : Node_Id);

   --  Analyze renaming of attribute as subprogram. The renaming declaration N

   --  is rewritten as a subprogram body that returns the attribute reference

   --  applied to the formals of the function.

   procedure Set_Entity_Or_Discriminal (N : Node_Id; E : Entity_Id);

   --  Set Entity, with style check if need be. For a discriminant reference,

   --  replace by the corresponding discriminal, i.e. the parameter of the

   --  initialization procedure that corresponds to the discriminant.

   procedure Check_Frozen_Renaming (N : Node_Id; Subp : Entity_Id);

   --  A renaming_as_body may occur after the entity of the original decla-

   --  ration has been frozen. In that case, the body of the new entity must

   --  be built now, because the usual mechanism of building the renamed

   --  body at the point of freezing will not work. Subp is the subprogram

   --  for which N provides the Renaming_As_Body.

   procedure Check_In_Previous_With_Clause

     (N   : Node_Id;

      Nam : Node_Id);

   --  N is a use_package clause and Nam the package name, or N is a use_type

   --  clause and Nam is the prefix of the type name. In either case, verify

   --  that the package is visible at that point in the context: either  it

   --  appears in a previous with_clause, or because it is a fully qualified

   --  name and the root ancestor appears in a previous with_clause.

   procedure Check_Library_Unit_Renaming (N : Node_Id; Old_E : Entity_Id);

   --  Verify that the entity in a renaming declaration that is a library unit

   --  is itself a library unit and not a nested unit or subunit. Also check

   --  that if the renaming is a child unit of a generic parent, then the

   --  renamed unit must also be a child unit of that parent. Finally, verify

   --  that a renamed generic unit is not an implicit child declared within

   --  an instance of the parent.

   procedure Chain_Use_Clause (N : Node_Id);

   --  Chain use clause onto list of uses clauses headed by First_Use_Clause in

   --  the proper scope table entry. This is usually the current scope, but it

   --  will be an inner scope when installing the use clauses of the private

   --  declarations of a parent unit prior to compiling the private part of a

   --  child unit. This chain is traversed when installing/removing use clauses

   --  when compiling a subunit or instantiating a generic body on the fly,

   --  when it is necessary to save and restore full environments.

   function Has_Implicit_Character_Literal (N : Node_Id) return Boolean;

   --  Find a type derived from Character or Wide_Character in the prefix of N.

   --  Used to resolved qualified names whose selector is a character literal.

   function Has_Private_With (E : Entity_Id) return Boolean;

   --  Ada 2005 (AI-262): Determines if the current compilation unit has a

   --  private with on E.

   procedure Find_Expanded_Name (N : Node_Id);

   --  The input is a selected component known to be an expanded name. Verify

   --  legality of selector given the scope denoted by prefix, and change node

   --  N into a expanded name with a properly set Entity field.

   function Find_Renamed_Entity

     (N         : Node_Id;

      Nam       : Node_Id;

      New_S     : Entity_Id;

      Is_Actual : Boolean := False) return Entity_Id;

   --  Find the renamed entity that corresponds to the given parameter profile

   --  in a subprogram renaming declaration. The renamed entity may be an

   --  operator, a subprogram, an entry, or a protected operation. Is_Actual

   --  indicates that the renaming is the one generated for an actual subpro-

   --  gram in an instance, for which special visibility checks apply.

   function Has_Implicit_Operator (N : Node_Id) return Boolean;

   --  N is an expanded name whose selector is an operator name (e.g. P."+").

   --  declarative part contains an implicit declaration of an operator if it

   --  has a declaration of a type to which one of the predefined operators

   --  apply. The existence of this routine is an implementation artifact. A

   --  more straightforward but more space-consuming choice would be to make

   --  all inherited operators explicit in the symbol table.

   procedure Inherit_Renamed_Profile (New_S : Entity_Id; Old_S : Entity_Id);

   --  A subprogram defined by a renaming declaration inherits the parameter

   --  profile of the renamed entity. The subtypes given in the subprogram

   --  specification are discarded and replaced with those of the renamed

   --  subprogram, which are then used to recheck the default values.

   function Is_Appropriate_For_Record (T : Entity_Id) return Boolean;

   --  Prefix is appropriate for record if it is of a record type, or an access

   --  to such.

   function Is_Appropriate_For_Entry_Prefix (T : Entity_Id) return Boolean;

   --  True if it is of a task type, a protected type, or else an access to one

   --  of these types.

   procedure Note_Redundant_Use (Clause : Node_Id);

   --  Mark the name in a use clause as redundant if the corresponding entity

   --  is already use-visible. Emit a warning if the use clause comes from

   --  source and the proper warnings are enabled.

   procedure Premature_Usage (N : Node_Id);

   --  Diagnose usage of an entity before it is visible

   procedure Use_One_Package (P : Entity_Id; N : Node_Id);

   --  Make visible entities declared in package P potentially use-visible

   --  in the current context. Also used in the analysis of subunits, when

   --  re-installing use clauses of parent units. N is the use_clause that

   --  names P (and possibly other packages).

   procedure Use_One_Type (Id : Node_Id; Installed : Boolean := False);

   --  Id is the subtype mark from a use type clause. This procedure makes

   --  the primitive operators of the type potentially use-visible. The

   --  boolean flag Installed indicates that the clause is being reinstalled

   --  after previous analysis, and primitive operations are already chained

   --  on the Used_Operations list of the clause.

   procedure Write_Info;

   --  Write debugging information on entities declared in current scope

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

   -- Analyze_Exception_Renaming --

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

   --  The language only allows a single identifier, but the tree holds an

   --  identifier list. The parser has already issued an error message if

   --  there is more than one element in the list.

   procedure Analyze_Exception_Renaming (N : Node_Id) is

      Id  : constant Node_Id := Defining_Identifier (N);

      Nam : constant Node_Id := Name (N);

   begin

      Check_SPARK_Restriction ("exception renaming is not allowed", N);

      Enter_Name (Id);

      Analyze (Nam);

      Set_Ekind          (Id, E_Exception);

      Set_Exception_Code (Id, Uint_0);

      Set_Etype          (Id, Standard_Exception_Type);

      Set_Is_Pure        (Id, Is_Pure (Current_Scope));

      if not Is_Entity_Name (Nam) or else

        Ekind (Entity (Nam)) /= E_Exception

      then

         Error_Msg_N ("invalid exception name in renaming", Nam);

      else

         if Present (Renamed_Object (Entity (Nam))) then

            Set_Renamed_Object (Id, Renamed_Object (Entity (Nam)));

         else

            Set_Renamed_Object (Id, Entity (Nam));

         end if;

      end if;

   end Analyze_Exception_Renaming;

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

   -- Analyze_Expanded_Name --

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

   procedure Analyze_Expanded_Name (N : Node_Id) is

   begin

      --  If the entity pointer is already set, this is an internal node, or a

      --  node that is analyzed more than once, after a tree modification. In

      --  such a case there is no resolution to perform, just set the type. For

      --  completeness, analyze prefix as well.

      if Present (Entity (N)) then

         if Is_Type (Entity (N)) then

            Set_Etype (N, Entity (N));

         else

            Set_Etype (N, Etype (Entity (N)));

         end if;

         Analyze (Prefix (N));

         return;

      else

         Find_Expanded_Name (N);

      end if;

   end Analyze_Expanded_Name;

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

   -- Analyze_Generic_Function_Renaming --

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

   procedure Analyze_Generic_Function_Renaming  (N : Node_Id) is

   begin

      Analyze_Generic_Renaming (N, E_Generic_Function);

   end Analyze_Generic_Function_Renaming;

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

   -- Analyze_Generic_Package_Renaming --

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

   procedure Analyze_Generic_Package_Renaming   (N : Node_Id) is

   begin

      --  Apply the Text_IO Kludge here, since we may be renaming one of the

      --  subpackages of Text_IO, then join common routine.

      Text_IO_Kludge (Name (N));

      Analyze_Generic_Renaming (N, E_Generic_Package);

   end Analyze_Generic_Package_Renaming;

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

   -- Analyze_Generic_Procedure_Renaming --

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

   procedure Analyze_Generic_Procedure_Renaming (N : Node_Id) is

   begin

      Analyze_Generic_Renaming (N, E_Generic_Procedure);

   end Analyze_Generic_Procedure_Renaming;

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

   -- Analyze_Generic_Renaming --

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

   procedure Analyze_Generic_Renaming

     (N : Node_Id;

      K : Entity_Kind)

   is

      New_P : constant Entity_Id := Defining_Entity (N);

      Old_P : Entity_Id;

      Inst  : Boolean   := False; -- prevent junk warning

   begin

      if Name (N) = Error then

         return;

      end if;

      Check_SPARK_Restriction ("generic renaming is not allowed", N);

      Generate_Definition (New_P);

      if Current_Scope /= Standard_Standard then

         Set_Is_Pure (New_P, Is_Pure (Current_Scope));

      end if;

      if Nkind (Name (N)) = N_Selected_Component then

         Check_Generic_Child_Unit (Name (N), Inst);

      else

         Analyze (Name (N));

      end if;

      if not Is_Entity_Name (Name (N)) then

         Error_Msg_N ("expect entity name in renaming declaration", Name (N));

         Old_P := Any_Id;

      else

         Old_P := Entity (Name (N));

      end if;

      Enter_Name (New_P);

      Set_Ekind (New_P, K);

      if Etype (Old_P) = Any_Type then

         null;

      elsif Ekind (Old_P) /= K then

         Error_Msg_N ("invalid generic unit name", Name (N));

      else

         if Present (Renamed_Object (Old_P)) then

            Set_Renamed_Object (New_P,  Renamed_Object (Old_P));

         else

            Set_Renamed_Object (New_P, Old_P);

         end if;

         Set_Is_Pure          (New_P, Is_Pure          (Old_P));

         Set_Is_Preelaborated (New_P, Is_Preelaborated (Old_P));

         Set_Etype (New_P, Etype (Old_P));

         Set_Has_Completion (New_P);

         if In_Open_Scopes (Old_P) then

            Error_Msg_N ("within its scope, generic denotes its instance", N);

         end if;

         Check_Library_Unit_Renaming (N, Old_P);

      end if;

   end Analyze_Generic_Renaming;

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

   -- Analyze_Object_Renaming --

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

   procedure Analyze_Object_Renaming (N : Node_Id) is

      Loc : constant Source_Ptr := Sloc (N);

      Id  : constant Entity_Id  := Defining_Identifier (N);

      Dec : Node_Id;

      Nam : constant Node_Id    := Name (N);

      T   : Entity_Id;

      T2  : Entity_Id;

      procedure Check_Constrained_Object;

      --  If the nominal type is unconstrained but the renamed object is

      --  constrained, as can happen with renaming an explicit dereference or

      --  a function return, build a constrained subtype from the object. If

      --  the renaming is for a formal in an accept statement, the analysis

      --  has already established its actual subtype. This is only relevant

      --  if the renamed object is an explicit dereference.

      function In_Generic_Scope (E : Entity_Id) return Boolean;

      --  Determine whether entity E is inside a generic cope

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

      -- Check_Constrained_Object --

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

      procedure Check_Constrained_Object is

         Subt : Entity_Id;

      begin

         if Nkind_In (Nam, N_Function_Call, N_Explicit_Dereference)

           and then Is_Composite_Type (Etype (Nam))

           and then not Is_Constrained (Etype (Nam))

           and then not Has_Unknown_Discriminants (Etype (Nam))

           and then Expander_Active

         then

            --  If Actual_Subtype is already set, nothing to do

            if Ekind_In (Id, E_Variable, E_Constant)

              and then Present (Actual_Subtype (Id))

            then

               null;

            --  A renaming of an unchecked union does not have an

            --  actual subtype.

            elsif Is_Unchecked_Union (Etype (Nam)) then

               null;

            else

               Subt := Make_Temporary (Loc, 'T');

               Remove_Side_Effects (Nam);

               Insert_Action (N,

                 Make_Subtype_Declaration (Loc,

                   Defining_Identifier => Subt,

                   Subtype_Indication  =>

                     Make_Subtype_From_Expr (Nam, Etype (Nam))));

               Rewrite (Subtype_Mark (N), New_Occurrence_Of (Subt, Loc));

               Set_Etype (Nam, Subt);

            end if;

         end if;

      end Check_Constrained_Object;

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

      -- In_Generic_Scope --

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

      function In_Generic_Scope (E : Entity_Id) return Boolean is

         S : Entity_Id;

      begin

         S := Scope (E);

         while Present (S) and then S /= Standard_Standard loop

            if Is_Generic_Unit (S) then

               return True;

            end if;

            S := Scope (S);

         end loop;

         return False;

      end In_Generic_Scope;

   --  Start of processing for Analyze_Object_Renaming

   begin

      if Nam = Error then

         return;

      end if;

      Check_SPARK_Restriction ("object renaming is not allowed", N);

      Set_Is_Pure (Id, Is_Pure (Current_Scope));

      Enter_Name (Id);

      --  The renaming of a component that depends on a discriminant requires

      --  an actual subtype, because in subsequent use of the object Gigi will

      --  be unable to locate the actual bounds. This explicit step is required

      --  when the renaming is generated in removing side effects of an

      --  already-analyzed expression.

      if Nkind (Nam) = N_Selected_Component

        and then Analyzed (Nam)

      then

         T := Etype (Nam);

         Dec :=  Build_Actual_Subtype_Of_Component (Etype (Nam), Nam);

         if Present (Dec) then

            Insert_Action (N, Dec);

            T := Defining_Identifier (Dec);

            Set_Etype (Nam, T);

         end if;