[gcc.git] / gcc / ada / sem_res.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              S E M _ R E S                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2008, 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 Debug_A;  use Debug_A;
with Einfo;    use Einfo;
with Elists;   use Elists;
with Errout;   use Errout;
with Expander; use Expander;
with Exp_Disp; use Exp_Disp;
with Exp_Ch6;  use Exp_Ch6;
with Exp_Ch7;  use Exp_Ch7;
with Exp_Tss;  use Exp_Tss;
with Exp_Util; use Exp_Util;
with Fname;    use Fname;
with Freeze;   use Freeze;
with Itypes;   use Itypes;
with Lib;      use Lib;
with Lib.Xref; use Lib.Xref;
with Namet;    use Namet;
with Nmake;    use Nmake;
with Nlists;   use Nlists;
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_Aggr; use Sem_Aggr;
with Sem_Attr; use Sem_Attr;
with Sem_Cat;  use Sem_Cat;
with Sem_Ch4;  use Sem_Ch4;
with Sem_Ch6;  use Sem_Ch6;
with Sem_Ch8;  use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
with Sem_Elab; use Sem_Elab;
with Sem_Eval; use Sem_Eval;
with Sem_Intr; use Sem_Intr;
with Sem_Util; use Sem_Util;
with Sem_Type; use Sem_Type;
with Sem_Warn; use Sem_Warn;
with Sinfo;    use Sinfo;
with Snames;   use Snames;
with Stand;    use Stand;
with Stringt;  use Stringt;
with Style;    use Style;
with Targparm; use Targparm;
with Tbuild;   use Tbuild;
with Uintp;    use Uintp;
with Urealp;   use Urealp;

package body Sem_Res is

   -----------------------
   -- Local Subprograms --
   -----------------------

   --  Second pass (top-down) type checking and overload resolution procedures
   --  Typ is the type required by context. These procedures propagate the
   --  type information recursively to the descendants of N. If the node
   --  is not overloaded, its Etype is established in the first pass. If
   --  overloaded,  the Resolve routines set the correct type. For arith.
   --  operators, the Etype is the base type of the context.

   --  Note that Resolve_Attribute is separated off in Sem_Attr

   procedure Check_Discriminant_Use (N : Node_Id);
   --  Enforce the restrictions on the use of discriminants when constraining
   --  a component of a discriminated type (record or concurrent type).

   procedure Check_For_Visible_Operator (N : Node_Id; T : Entity_Id);
   --  Given a node for an operator associated with type T, check that
   --  the operator is visible. Operators all of whose operands are
   --  universal must be checked for visibility during resolution
   --  because their type is not determinable based on their operands.

   procedure Check_Fully_Declared_Prefix
     (Typ  : Entity_Id;
      Pref : Node_Id);
   --  Check that the type of the prefix of a dereference is not incomplete

   function Check_Infinite_Recursion (N : Node_Id) return Boolean;
   --  Given a call node, N, which is known to occur immediately within the
   --  subprogram being called, determines whether it is a detectable case of
   --  an infinite recursion, and if so, outputs appropriate messages. Returns
   --  True if an infinite recursion is detected, and False otherwise.

   procedure Check_Initialization_Call (N : Entity_Id; Nam : Entity_Id);
   --  If the type of the object being initialized uses the secondary stack
   --  directly or indirectly, create a transient scope for the call to the
   --  init proc. This is because we do not create transient scopes for the
   --  initialization of individual components within the init proc itself.
   --  Could be optimized away perhaps?

   function Is_Definite_Access_Type (E : Entity_Id) return Boolean;
   --  Determine whether E is an access type declared by an access
   --  declaration, and not an (anonymous) allocator type.

   function Is_Predefined_Op (Nam : Entity_Id) return Boolean;
   --  Utility to check whether the name in the call is a predefined
   --  operator, in which case the call is made into an operator node.
   --  An instance of an intrinsic conversion operation may be given
   --  an operator name, but is not treated like an operator.

   procedure Replace_Actual_Discriminants (N : Node_Id; Default : Node_Id);
   --  If a default expression in entry call N depends on the discriminants
   --  of the task, it must be replaced with a reference to the discriminant
   --  of the task being called.

   procedure Resolve_Op_Concat_Arg
     (N       : Node_Id;
      Arg     : Node_Id;
      Typ     : Entity_Id;
      Is_Comp : Boolean);
   --  Internal procedure for Resolve_Op_Concat to resolve one operand of
   --  concatenation operator.  The operand is either of the array type or of
   --  the component type. If the operand is an aggregate, and the component
   --  type is composite, this is ambiguous if component type has aggregates.

   procedure Resolve_Op_Concat_First (N : Node_Id; Typ : Entity_Id);
   --  Does the first part of the work of Resolve_Op_Concat

   procedure Resolve_Op_Concat_Rest (N : Node_Id; Typ : Entity_Id);
   --  Does the "rest" of the work of Resolve_Op_Concat, after the left operand
   --  has been resolved. See Resolve_Op_Concat for details.

   procedure Resolve_Allocator                 (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Arithmetic_Op             (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Call                      (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Character_Literal         (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Comparison_Op             (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Conditional_Expression    (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Equality_Op               (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Explicit_Dereference      (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Entity_Name               (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Indexed_Component         (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Integer_Literal           (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Logical_Op                (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Membership_Op             (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Null                      (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Operator_Symbol           (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Op_Concat                 (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Op_Expon                  (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Op_Not                    (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Qualified_Expression      (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Range                     (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Real_Literal              (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Reference                 (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Selected_Component        (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Shift                     (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Short_Circuit             (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Slice                     (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_String_Literal            (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Subprogram_Info           (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Type_Conversion           (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Unary_Op                  (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Unchecked_Expression      (N : Node_Id; Typ : Entity_Id);
   procedure Resolve_Unchecked_Type_Conversion (N : Node_Id; Typ : Entity_Id);

   function Operator_Kind
     (Op_Name   : Name_Id;
      Is_Binary : Boolean) return Node_Kind;
   --  Utility to map the name of an operator into the corresponding Node. Used
   --  by other node rewriting procedures.

   procedure Resolve_Actuals (N : Node_Id; Nam : Entity_Id);
   --  Resolve actuals of call, and add default expressions for missing ones.
   --  N is the Node_Id for the subprogram call, and Nam is the entity of the
   --  called subprogram.

   procedure Resolve_Entry_Call (N : Node_Id; Typ : Entity_Id);
   --  Called from Resolve_Call, when the prefix denotes an entry or element
   --  of entry family. Actuals are resolved as for subprograms, and the node
   --  is rebuilt as an entry call. Also called for protected operations. Typ
   --  is the context type, which is used when the operation is a protected
   --  function with no arguments, and the return value is indexed.

   procedure Resolve_Intrinsic_Operator (N : Node_Id; Typ : Entity_Id);
   --  A call to a user-defined intrinsic operator is rewritten as a call
   --  to the corresponding predefined operator, with suitable conversions.

   procedure Resolve_Intrinsic_Unary_Operator (N : Node_Id; Typ : Entity_Id);
   --  Ditto, for unary operators (only arithmetic ones)

   procedure Rewrite_Operator_As_Call (N : Node_Id; Nam : Entity_Id);
   --  If an operator node resolves to a call to a user-defined operator,
   --  rewrite the node as a function call.

   procedure Make_Call_Into_Operator
     (N     : Node_Id;
      Typ   : Entity_Id;
      Op_Id : Entity_Id);
   --  Inverse transformation: if an operator is given in functional notation,
   --  then after resolving the node, transform into an operator node, so
   --  that operands are resolved properly. Recall that predefined operators
   --  do not have a full signature and special resolution rules apply.

   procedure Rewrite_Renamed_Operator
     (N   : Node_Id;
      Op  : Entity_Id;
      Typ : Entity_Id);
   --  An operator can rename another, e.g. in  an instantiation. In that
   --  case, the proper operator node must be constructed and resolved.

   procedure Set_String_Literal_Subtype (N : Node_Id; Typ : Entity_Id);
   --  The String_Literal_Subtype is built for all strings that are not
   --  operands of a static concatenation operation. If the argument is
   --  not a N_String_Literal node, then the call has no effect.

   procedure Set_Slice_Subtype (N : Node_Id);
   --  Build subtype of array type, with the range specified by the slice

   procedure Simplify_Type_Conversion (N : Node_Id);
   --  Called after N has been resolved and evaluated, but before range checks
   --  have been applied. Currently simplifies a combination of floating-point
   --  to integer conversion and Truncation attribute.

   function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
   --  A universal_fixed expression in an universal context is unambiguous
   --  if there is only one applicable fixed point type. Determining whether
   --  there is only one requires a search over all visible entities, and
   --  happens only in very pathological cases (see 6115-006).

   function Valid_Conversion
     (N       : Node_Id;
      Target  : Entity_Id;
      Operand : Node_Id) return Boolean;
   --  Verify legality rules given in 4.6 (8-23). Target is the target
   --  type of the conversion, which may be an implicit conversion of
   --  an actual parameter to an anonymous access type (in which case
   --  N denotes the actual parameter and N = Operand).

   -------------------------
   -- Ambiguous_Character --
   -------------------------

   procedure Ambiguous_Character (C : Node_Id) is
      E : Entity_Id;

   begin
      if Nkind (C) = N_Character_Literal then
         Error_Msg_N ("ambiguous character literal", C);

         --  First the ones in Standard

         Error_Msg_N
           ("\\possible interpretation: Character!", C);
         Error_Msg_N
           ("\\possible interpretation: Wide_Character!", C);

         --  Include Wide_Wide_Character in Ada 2005 mode

         if Ada_Version >= Ada_05 then
            Error_Msg_N
              ("\\possible interpretation: Wide_Wide_Character!", C);
         end if;

         --  Now any other types that match

         E := Current_Entity (C);
         while Present (E) loop
            Error_Msg_NE ("\\possible interpretation:}!", C, Etype (E));
            E := Homonym (E);
         end loop;
      end if;
   end Ambiguous_Character;

   -------------------------
   -- Analyze_And_Resolve --
   -------------------------

   procedure Analyze_And_Resolve (N : Node_Id) is
   begin
      Analyze (N);
      Resolve (N);
   end Analyze_And_Resolve;

   procedure Analyze_And_Resolve (N : Node_Id; Typ : Entity_Id) is
   begin
      Analyze (N);
      Resolve (N, Typ);
   end Analyze_And_Resolve;

   --  Version withs check(s) suppressed

   procedure Analyze_And_Resolve
     (N        : Node_Id;
      Typ      : Entity_Id;
      Suppress : Check_Id)
   is
      Scop : constant Entity_Id := Current_Scope;

   begin
      if Suppress = All_Checks then
         declare
            Svg : constant Suppress_Array := Scope_Suppress;
         begin
            Scope_Suppress := (others => True);
            Analyze_And_Resolve (N, Typ);
            Scope_Suppress := Svg;
         end;

      else
         declare
            Svg : constant Boolean := Scope_Suppress (Suppress);

         begin
            Scope_Suppress (Suppress) := True;
            Analyze_And_Resolve (N, Typ);
            Scope_Suppress (Suppress) := Svg;
         end;
      end if;

      if Current_Scope /= Scop
        and then Scope_Is_Transient
      then
         --  This can only happen if a transient scope was created
         --  for an inner expression, which will be removed upon
         --  completion of the analysis of an enclosing construct.
         --  The transient scope must have the suppress status of
         --  the enclosing environment, not of this Analyze call.

         Scope_Stack.Table (Scope_Stack.Last).Save_Scope_Suppress :=
           Scope_Suppress;
      end if;
   end Analyze_And_Resolve;

   procedure Analyze_And_Resolve
     (N        : Node_Id;
      Suppress : Check_Id)
   is
      Scop : constant Entity_Id := Current_Scope;

   begin
      if Suppress = All_Checks then
         declare
            Svg : constant Suppress_Array := Scope_Suppress;
         begin
            Scope_Suppress := (others => True);
            Analyze_And_Resolve (N);
            Scope_Suppress := Svg;
         end;

      else
         declare
            Svg : constant Boolean := Scope_Suppress (Suppress);

         begin
            Scope_Suppress (Suppress) := True;
            Analyze_And_Resolve (N);
            Scope_Suppress (Suppress) := Svg;
         end;
      end if;

      if Current_Scope /= Scop
        and then Scope_Is_Transient
      then
         Scope_Stack.Table (Scope_Stack.Last).Save_Scope_Suppress :=
           Scope_Suppress;
      end if;
   end Analyze_And_Resolve;

   ----------------------------
   -- Check_Discriminant_Use --
   ----------------------------

   procedure Check_Discriminant_Use (N : Node_Id) is
      PN   : constant Node_Id   := Parent (N);
      Disc : constant Entity_Id := Entity (N);
      P    : Node_Id;
      D    : Node_Id;

   begin
      --  Any use in a spec-expression is legal

      if In_Spec_Expression then
         null;

      elsif Nkind (PN) = N_Range then

         --  Discriminant cannot be used to constrain a scalar type

         P := Parent (PN);

         if Nkind (P) = N_Range_Constraint
           and then Nkind (Parent (P)) = N_Subtype_Indication
           and then Nkind (Parent (Parent (P))) = N_Component_Definition
         then
            Error_Msg_N ("discriminant cannot constrain scalar type", N);

         elsif Nkind (P) = N_Index_Or_Discriminant_Constraint then

            --  The following check catches the unusual case where
            --  a discriminant appears within an index constraint
            --  that is part of a larger expression within a constraint
            --  on a component, e.g. "C : Int range 1 .. F (new A(1 .. D))".
            --  For now we only check case of record components, and
            --  note that a similar check should also apply in the
            --  case of discriminant constraints below. ???

            --  Note that the check for N_Subtype_Declaration below is to
            --  detect the valid use of discriminants in the constraints of a
            --  subtype declaration when this subtype declaration appears
            --  inside the scope of a record type (which is syntactically
            --  illegal, but which may be created as part of derived type
            --  processing for records). See Sem_Ch3.Build_Derived_Record_Type
            --  for more info.

            if Ekind (Current_Scope) = E_Record_Type
              and then Scope (Disc) = Current_Scope
              and then not
                (Nkind (Parent (P)) = N_Subtype_Indication
                  and then
                    Nkind_In (Parent (Parent (P)), N_Component_Definition,
                                                   N_Subtype_Declaration)
                  and then Paren_Count (N) = 0)
            then
               Error_Msg_N
                 ("discriminant must appear alone in component constraint", N);
               return;
            end if;

            --   Detect a common beginner error:

            --   type R (D : Positive := 100) is record
            --     Name : String (1 .. D);
            --   end record;

            --  The default value causes an object of type R to be
            --  allocated with room for Positive'Last characters.

            declare
               SI : Node_Id;
               T  : Entity_Id;
               TB : Node_Id;
               CB : Entity_Id;

               function Large_Storage_Type (T : Entity_Id) return Boolean;
               --  Return True if type T has a large enough range that
               --  any array whose index type covered the whole range of
               --  the type would likely raise Storage_Error.

               ------------------------
               -- Large_Storage_Type --
               ------------------------

               function Large_Storage_Type (T : Entity_Id) return Boolean is
               begin
                  --  The type is considered large if its bounds are known at
                  --  compile time and if it requires at least as many bits as
                  --  a Positive to store the possible values.

                  return Compile_Time_Known_Value (Type_Low_Bound (T))
                    and then Compile_Time_Known_Value (Type_High_Bound (T))
                    and then
                      Minimum_Size (T, Biased => True) >=
                        Esize (Standard_Integer) - 1;
               end Large_Storage_Type;

            begin
               --  Check that the Disc has a large range

               if not Large_Storage_Type (Etype (Disc)) then
                  goto No_Danger;
               end if;

               --  If the enclosing type is limited, we allocate only the
               --  default value, not the maximum, and there is no need for
               --  a warning.

               if Is_Limited_Type (Scope (Disc)) then
                  goto No_Danger;
               end if;

               --  Check that it is the high bound

               if N /= High_Bound (PN)
                 or else No (Discriminant_Default_Value (Disc))
               then
                  goto No_Danger;
               end if;

               --  Check the array allows a large range at this bound.
               --  First find the array

               SI := Parent (P);

               if Nkind (SI) /= N_Subtype_Indication then
                  goto No_Danger;
               end if;

               T := Entity (Subtype_Mark (SI));

               if not Is_Array_Type (T) then
                  goto No_Danger;
               end if;

               --  Next, find the dimension

               TB := First_Index (T);
               CB := First (Constraints (P));
               while True
                 and then Present (TB)
                 and then Present (CB)
                 and then CB /= PN
               loop
                  Next_Index (TB);
                  Next (CB);
               end loop;

               if CB /= PN then
                  goto No_Danger;
               end if;

               --  Now, check the dimension has a large range

               if not Large_Storage_Type (Etype (TB)) then
                  goto No_Danger;
               end if;

               --  Warn about the danger

               Error_Msg_N
                 ("?creation of & object may raise Storage_Error!",
                  Scope (Disc));

               <<No_Danger>>
                  null;

            end;
         end if;

      --  Legal case is in index or discriminant constraint

      elsif Nkind_In (PN, N_Index_Or_Discriminant_Constraint,
                          N_Discriminant_Association)
      then
         if Paren_Count (N) > 0 then
            Error_Msg_N
              ("discriminant in constraint must appear alone",  N);

         elsif Nkind (N) = N_Expanded_Name
           and then Comes_From_Source (N)
         then
            Error_Msg_N
              ("discriminant must appear alone as a direct name", N);
         end if;

         return;

      --  Otherwise, context is an expression. It should not be within
      --  (i.e. a subexpression of) a constraint for a component.

      else
         D := PN;
         P := Parent (PN);
         while not Nkind_In (P, N_Component_Declaration,
                                N_Subtype_Indication,
                                N_Entry_Declaration)
         loop
            D := P;
            P := Parent (P);
            exit when No (P);
         end loop;

         --  If the discriminant is used in an expression that is a bound
         --  of a scalar type, an Itype is created and the bounds are attached
         --  to its range,  not to the original subtype indication. Such use
         --  is of course a double fault.

         if (Nkind (P) = N_Subtype_Indication
              and then Nkind_In (Parent (P), N_Component_Definition,
                                             N_Derived_Type_Definition)
              and then D = Constraint (P))

         --  The constraint itself may be given by a subtype indication,
         --  rather than by a more common discrete range.

           or else (Nkind (P) = N_Subtype_Indication
                      and then
                    Nkind (Parent (P)) = N_Index_Or_Discriminant_Constraint)
           or else Nkind (P) = N_Entry_Declaration
           or else Nkind (D) = N_Defining_Identifier
         then
            Error_Msg_N
              ("discriminant in constraint must appear alone",  N);
         end if;
      end if;
   end Check_Discriminant_Use;

   --------------------------------
   -- Check_For_Visible_Operator --
   --------------------------------

   procedure Check_For_Visible_Operator (N : Node_Id; T : Entity_Id) is
   begin
      if Is_Invisible_Operator (N, T) then
         Error_Msg_NE
           ("operator for} is not directly visible!", N, First_Subtype (T));
         Error_Msg_N ("use clause would make operation legal!", N);
      end if;
   end Check_For_Visible_Operator;

   ----------------------------------
   --  Check_Fully_Declared_Prefix --
   ----------------------------------

   procedure Check_Fully_Declared_Prefix
     (Typ  : Entity_Id;
      Pref : Node_Id)
   is
   begin
      --  Check that the designated type of the prefix of a dereference is
      --  not an incomplete type. This cannot be done unconditionally, because
      --  dereferences of private types are legal in default expressions. This
      --  case is taken care of in Check_Fully_Declared, called below. There
      --  are also 2005 cases where it is legal for the prefix to be unfrozen.

      --  This consideration also applies to similar checks for allocators,
      --  qualified expressions, and type conversions.

      --  An additional exception concerns other per-object expressions that
      --  are not directly related to component declarations, in particular
      --  representation pragmas for tasks. These will be per-object
      --  expressions if they depend on discriminants or some global entity.
      --  If the task has access discriminants, the designated type may be
      --  incomplete at the point the expression is resolved. This resolution
      --  takes place within the body of the initialization procedure, where
      --  the discriminant is replaced by its discriminal.

      if Is_Entity_Name (Pref)
        and then Ekind (Entity (Pref)) = E_In_Parameter
      then
         null;

      --  Ada 2005 (AI-326): Tagged incomplete types allowed. The wrong usages
      --  are handled by Analyze_Access_Attribute, Analyze_Assignment,
      --  Analyze_Object_Renaming, and Freeze_Entity.

      elsif Ada_Version >= Ada_05
        and then Is_Entity_Name (Pref)
        and then Ekind (Directly_Designated_Type (Etype (Pref))) =
                                                       E_Incomplete_Type
        and then Is_Tagged_Type (Directly_Designated_Type (Etype (Pref)))
      then
         null;
      else
         Check_Fully_Declared (Typ, Parent (Pref));
      end if;
   end Check_Fully_Declared_Prefix;

   ------------------------------
   -- Check_Infinite_Recursion --
   ------------------------------

   function Check_Infinite_Recursion (N : Node_Id) return Boolean is
      P : Node_Id;
      C : Node_Id;

      function Same_Argument_List return Boolean;
      --  Check whether list of actuals is identical to list of formals
      --  of called function (which is also the enclosing scope).

      ------------------------
      -- Same_Argument_List --
      ------------------------

      function Same_Argument_List return Boolean is
         A    : Node_Id;
         F    : Entity_Id;
         Subp : Entity_Id;

      begin
         if not Is_Entity_Name (Name (N)) then
            return False;
         else
            Subp := Entity (Name (N));
         end if;

         F := First_Formal (Subp);
         A := First_Actual (N);
         while Present (F) and then Present (A) loop
            if not Is_Entity_Name (A)
              or else Entity (A) /= F
            then
               return False;
            end if;

            Next_Actual (A);
            Next_Formal (F);
         end loop;

         return True;
      end Same_Argument_List;

   --  Start of processing for Check_Infinite_Recursion

   begin
      --  Special case, if this is a procedure call and is a call to the
      --  current procedure with the same argument list, then this is for
      --  sure an infinite recursion and we insert a call to raise SE.

      if Is_List_Member (N)
        and then List_Length (List_Containing (N)) = 1
        and then Same_Argument_List
      then
         declare
            P : constant Node_Id := Parent (N);
         begin
            if Nkind (P) = N_Handled_Sequence_Of_Statements
              and then Nkind (Parent (P)) = N_Subprogram_Body
              and then Is_Empty_List (Declarations (Parent (P)))
            then
               Error_Msg_N ("!?infinite recursion", N);
               Error_Msg_N ("\!?Storage_Error will be raised at run time", N);
               Insert_Action (N,
                 Make_Raise_Storage_Error (Sloc (N),
                   Reason => SE_Infinite_Recursion));
               return True;
            end if;
         end;
      end if;

      --  If not that special case, search up tree, quitting if we reach a
      --  construct (e.g. a conditional) that tells us that this is not a
      --  case for an infinite recursion warning.

      C := N;
      loop
         P := Parent (C);

         --  If no parent, then we were not inside a subprogram, this can for
         --  example happen when processing certain pragmas in a spec. Just
         --  return False in this case.

         if No (P) then
            return False;
         end if;

         --  Done if we get to subprogram body, this is definitely an infinite
         --  recursion case if we did not find anything to stop us.

         exit when Nkind (P) = N_Subprogram_Body;

         --  If appearing in conditional, result is false

         if Nkind_In (P, N_Or_Else,
                         N_And_Then,
                         N_If_Statement,
                         N_Case_Statement)
         then
            return False;

         elsif Nkind (P) = N_Handled_Sequence_Of_Statements
           and then C /= First (Statements (P))
         then
            --  If the call is the expression of a return statement and the
            --  actuals are identical to the formals, it's worth a warning.
            --  However, we skip this if there is an immediately preceding
            --  raise statement, since the call is never executed.

            --  Furthermore, this corresponds to a common idiom:

            --    function F (L : Thing) return Boolean is
            --    begin
            --       raise Program_Error;
            --       return F (L);
            --    end F;

            --  for generating a stub function

            if Nkind (Parent (N)) = N_Simple_Return_Statement
              and then Same_Argument_List
            then
               exit when not Is_List_Member (Parent (N));

               --  OK, return statement is in a statement list, look for raise

               declare
                  Nod : Node_Id;

               begin
                  --  Skip past N_Freeze_Entity nodes generated by expansion

                  Nod := Prev (Parent (N));
                  while Present (Nod)
                    and then Nkind (Nod) = N_Freeze_Entity
                  loop
                     Prev (Nod);
                  end loop;

                  --  If no raise statement, give warning

                  exit when Nkind (Nod) /= N_Raise_Statement
                    and then
                      (Nkind (Nod) not in N_Raise_xxx_Error
                         or else Present (Condition (Nod)));
               end;
            end if;

            return False;

         else
            C := P;
         end if;
      end loop;

      Error_Msg_N ("!?possible infinite recursion", N);
      Error_Msg_N ("\!?Storage_Error may be raised at run time", N);

      return True;
   end Check_Infinite_Recursion;

   -------------------------------
   -- Check_Initialization_Call --
   -------------------------------

   procedure Check_Initialization_Call (N : Entity_Id; Nam : Entity_Id) is
      Typ : constant Entity_Id := Etype (First_Formal (Nam));

      function Uses_SS (T : Entity_Id) return Boolean;
      --  Check whether the creation of an object of the type will involve
      --  use of the secondary stack. If T is a record type, this is true
      --  if the expression for some component uses the secondary stack, e.g.
      --  through a call to a function that returns an unconstrained value.
      --  False if T is controlled, because cleanups occur elsewhere.

      -------------
      -- Uses_SS --
      -------------

      function Uses_SS (T : Entity_Id) return Boolean is
         Comp      : Entity_Id;
         Expr      : Node_Id;
         Full_Type : Entity_Id := Underlying_Type (T);

      begin
         --  Normally we want to use the underlying type, but if it's not set
         --  then continue with T.

         if not Present (Full_Type) then
            Full_Type := T;
         end if;

         if Is_Controlled (Full_Type) then
            return False;

         elsif Is_Array_Type (Full_Type) then
            return Uses_SS (Component_Type (Full_Type));

         elsif Is_Record_Type (Full_Type) then
            Comp := First_Component (Full_Type);
            while Present (Comp) loop
               if Ekind (Comp) = E_Component
                 and then Nkind (Parent (Comp)) = N_Component_Declaration
               then
                  --  The expression for a dynamic component may be rewritten
                  --  as a dereference, so retrieve original node.

                  Expr := Original_Node (Expression (Parent (Comp)));

                  --  Return True if the expression is a call to a function
                  --  (including an attribute function such as Image) with
                  --  a result that requires a transient scope.

                  if (Nkind (Expr) = N_Function_Call
                       or else (Nkind (Expr) = N_Attribute_Reference
                                 and then Present (Expressions (Expr))))
                    and then Requires_Transient_Scope (Etype (Expr))
                  then
                     return True;

                  elsif Uses_SS (Etype (Comp)) then
                     return True;
                  end if;
               end if;

               Next_Component (Comp);
            end loop;

            return False;

         else
            return False;
         end if;
      end Uses_SS;

   --  Start of processing for Check_Initialization_Call

   begin
      --  Establish a transient scope if the type needs it

      if Uses_SS (Typ) then
         Establish_Transient_Scope (First_Actual (N), Sec_Stack => True);
      end if;
   end Check_Initialization_Call;

   ------------------------------
   -- Check_Parameterless_Call --
   ------------------------------

   procedure Check_Parameterless_Call (N : Node_Id) is
      Nam : Node_Id;

      function Prefix_Is_Access_Subp return Boolean;
      --  If the prefix is of an access_to_subprogram type, the node must be
      --  rewritten as a call. Ditto if the prefix is overloaded and all its
      --  interpretations are access to subprograms.

      ---------------------------
      -- Prefix_Is_Access_Subp --
      ---------------------------

      function Prefix_Is_Access_Subp return Boolean is
         I   : Interp_Index;
         It  : Interp;

      begin
         if not Is_Overloaded (N) then
            return
              Ekind (Etype (N)) = E_Subprogram_Type
                and then Base_Type (Etype (Etype (N))) /= Standard_Void_Type;
         else
            Get_First_Interp (N, I, It);
            while Present (It.Typ) loop
               if Ekind (It.Typ) /= E_Subprogram_Type
                 or else Base_Type (Etype (It.Typ)) = Standard_Void_Type
               then
                  return False;
               end if;

               Get_Next_Interp (I, It);
            end loop;

            return True;
         end if;
      end Prefix_Is_Access_Subp;

   --  Start of processing for Check_Parameterless_Call

   begin
      --  Defend against junk stuff if errors already detected

      if Total_Errors_Detected /= 0 then
         if Nkind (N) in N_Has_Etype and then Etype (N) = Any_Type then
            return;
         elsif Nkind (N) in N_Has_Chars
           and then Chars (N) in Error_Name_Or_No_Name
         then
            return;
         end if;

         Require_Entity (N);
      end if;

      --  If the context expects a value, and the name is a procedure, this is
      --  most likely a missing 'Access. Don't try to resolve the parameterless
      --  call, error will be caught when the outer call is analyzed.

      if Is_Entity_Name (N)
        and then Ekind (Entity (N)) = E_Procedure
        and then not Is_Overloaded (N)
        and then
         Nkind_In (Parent (N), N_Parameter_Association,
                               N_Function_Call,
                               N_Procedure_Call_Statement)
      then
         return;
      end if;

      --  Rewrite as call if overloadable entity that is (or could be, in the
      --  overloaded case) a function call. If we know for sure that the entity
      --  is an enumeration literal, we do not rewrite it.

      if (Is_Entity_Name (N)
            and then Is_Overloadable (Entity (N))
            and then (Ekind (Entity (N)) /= E_Enumeration_Literal
                        or else Is_Overloaded (N)))

      --  Rewrite as call if it is an explicit deference of an expression of
      --  a subprogram access type, and the subprogram type is not that of a
      --  procedure or entry.

      or else
        (Nkind (N) = N_Explicit_Dereference and then Prefix_Is_Access_Subp)

      --  Rewrite as call if it is a selected component which is a function,
      --  this is the case of a call to a protected function (which may be
      --  overloaded with other protected operations).

      or else
        (Nkind (N) = N_Selected_Component
          and then (Ekind (Entity (Selector_Name (N))) = E_Function
                      or else
                        ((Ekind (Entity (Selector_Name (N))) = E_Entry
                            or else
                          Ekind (Entity (Selector_Name (N))) = E_Procedure)
                            and then Is_Overloaded (Selector_Name (N)))))

      --  If one of the above three conditions is met, rewrite as call.
      --  Apply the rewriting only once.

      then
         if Nkind (Parent (N)) /= N_Function_Call
           or else N /= Name (Parent (N))
         then
            Nam := New_Copy (N);

            --  If overloaded, overload set belongs to new copy

            Save_Interps (N, Nam);

            --  Change node to parameterless function call (note that the
            --  Parameter_Associations associations field is left set to Empty,
            --  its normal default value since there are no parameters)

            Change_Node (N, N_Function_Call);
            Set_Name (N, Nam);
            Set_Sloc (N, Sloc (Nam));
            Analyze_Call (N);
         end if;

      elsif Nkind (N) = N_Parameter_Association then
         Check_Parameterless_Call (Explicit_Actual_Parameter (N));
      end if;
   end Check_Parameterless_Call;

   -----------------------------
   -- Is_Definite_Access_Type --
   -----------------------------

   function Is_Definite_Access_Type (E : Entity_Id) return Boolean is
      Btyp : constant Entity_Id := Base_Type (E);
   begin
      return Ekind (Btyp) = E_Access_Type
        or else (Ekind (Btyp) = E_Access_Subprogram_Type
                  and then Comes_From_Source (Btyp));
   end Is_Definite_Access_Type;

   ----------------------
   -- Is_Predefined_Op --
   ----------------------

   function Is_Predefined_Op (Nam : Entity_Id) return Boolean is
   begin
      return Is_Intrinsic_Subprogram (Nam)
        and then not Is_Generic_Instance (Nam)
        and then Chars (Nam) in Any_Operator_Name
        and then (No (Alias (Nam))
                   or else Is_Predefined_Op (Alias (Nam)));
   end Is_Predefined_Op;

   -----------------------------
   -- Make_Call_Into_Operator --
   -----------------------------

   procedure Make_Call_Into_Operator
     (N     : Node_Id;
      Typ   : Entity_Id;
      Op_Id : Entity_Id)
   is
      Op_Name   : constant Name_Id := Chars (Op_Id);
      Act1      : Node_Id := First_Actual (N);
      Act2      : Node_Id := Next_Actual (Act1);
      Error     : Boolean := False;
      Func      : constant Entity_Id := Entity (Name (N));
      Is_Binary : constant Boolean   := Present (Act2);
      Op_Node   : Node_Id;
      Opnd_Type : Entity_Id;
      Orig_Type : Entity_Id := Empty;
      Pack      : Entity_Id;

      type Kind_Test is access function (E : Entity_Id) return Boolean;

      function Operand_Type_In_Scope (S : Entity_Id) return Boolean;
      --  If the operand is not universal, and the operator is given by a
      --  expanded name,  verify that the operand has an interpretation with
      --  a type defined in the given scope of the operator.

      function Type_In_P (Test : Kind_Test) return Entity_Id;
      --  Find a type of the given class in the package Pack that contains
      --  the operator.

      ---------------------------
      -- Operand_Type_In_Scope --
      ---------------------------

      function Operand_Type_In_Scope (S : Entity_Id) return Boolean is
         Nod : constant Node_Id := Right_Opnd (Op_Node);
         I   : Interp_Index;
         It  : Interp;

      begin
         if not Is_Overloaded (Nod) then
            return Scope (Base_Type (Etype (Nod))) = S;

         else
            Get_First_Interp (Nod, I, It);
            while Present (It.Typ) loop
               if Scope (Base_Type (It.Typ)) = S then
                  return True;
               end if;

               Get_Next_Interp (I, It);
            end loop;

            return False;
         end if;
      end Operand_Type_In_Scope;

      ---------------
      -- Type_In_P --
      ---------------

      function Type_In_P (Test : Kind_Test) return Entity_Id is
         E : Entity_Id;

         function In_Decl return Boolean;
         --  Verify that node is not part of the type declaration for the
         --  candidate type, which would otherwise be invisible.

         -------------
         -- In_Decl --
         -------------

         function In_Decl return Boolean is
            Decl_Node : constant Node_Id := Parent (E);
            N2        : Node_Id;

         begin
            N2 := N;

            if Etype (E) = Any_Type then
               return True;

            elsif No (Decl_Node) then
               return False;

            else
               while Present (N2)
                 and then Nkind (N2) /= N_Compilation_Unit
               loop
                  if N2 = Decl_Node then
                     return True;
                  else
                     N2 := Parent (N2);
                  end if;
               end loop;

               return False;
            end if;
         end In_Decl;

      --  Start of processing for Type_In_P

      begin
         --  If the context type is declared in the prefix package, this
         --  is the desired base type.

         if Scope (Base_Type (Typ)) = Pack
           and then Test (Typ)
         then
            return Base_Type (Typ);

         else
            E := First_Entity (Pack);
            while Present (E) loop
               if Test (E)
                 and then not In_Decl
               then
                  return E;
               end if;

               Next_Entity (E);
            end loop;

            return Empty;
         end if;
      end Type_In_P;

   --  Start of processing for Make_Call_Into_Operator

   begin
      Op_Node := New_Node (Operator_Kind (Op_Name, Is_Binary), Sloc (N));

      --  Binary operator

      if Is_Binary then
         Set_Left_Opnd  (Op_Node, Relocate_Node (Act1));
         Set_Right_Opnd (Op_Node, Relocate_Node (Act2));
         Save_Interps (Act1, Left_Opnd  (Op_Node));
         Save_Interps (Act2, Right_Opnd (Op_Node));
         Act1 := Left_Opnd (Op_Node);
         Act2 := Right_Opnd (Op_Node);

      --  Unary operator

      else
         Set_Right_Opnd (Op_Node, Relocate_Node (Act1));
         Save_Interps (Act1, Right_Opnd (Op_Node));
         Act1 := Right_Opnd (Op_Node);
      end if;

      --  If the operator is denoted by an expanded name, and the prefix is
      --  not Standard, but the operator is a predefined one whose scope is
      --  Standard, then this is an implicit_operator, inserted as an
      --  interpretation by the procedure of the same name. This procedure
      --  overestimates the presence of implicit operators, because it does
      --  not examine the type of the operands. Verify now that the operand
      --  type appears in the given scope. If right operand is universal,
      --  check the other operand. In the case of concatenation, either
      --  argument can be the component type, so check the type of the result.
      --  If both arguments are literals, look for a type of the right kind
      --  defined in the given scope. This elaborate nonsense is brought to
      --  you courtesy of b33302a. The type itself must be frozen, so we must
      --  find the type of the proper class in the given scope.

      --  A final wrinkle is the multiplication operator for fixed point
      --  types, which is defined in Standard only, and not in the scope of
      --  the fixed_point type itself.

      if Nkind (Name (N)) = N_Expanded_Name then
         Pack := Entity (Prefix (Name (N)));

         --  If the entity being called is defined in the given package,
         --  it is a renaming of a predefined operator, and known to be
         --  legal.

         if Scope (Entity (Name (N))) = Pack
            and then Pack /= Standard_Standard
         then
            null;

         --  Visibility does not need to be checked in an instance: if the
         --  operator was not visible in the generic it has been diagnosed
         --  already, else there is an implicit copy of it in the instance.

         elsif In_Instance then
            null;

         elsif (Op_Name =  Name_Op_Multiply
              or else Op_Name = Name_Op_Divide)
           and then Is_Fixed_Point_Type (Etype (Left_Opnd  (Op_Node)))
           and then Is_Fixed_Point_Type (Etype (Right_Opnd (Op_Node)))
         then
            if Pack /= Standard_Standard then
               Error := True;
            end if;

         --  Ada 2005, AI-420:  Predefined equality on Universal_Access
         --  is available.

         elsif Ada_Version >= Ada_05
           and then (Op_Name = Name_Op_Eq or else Op_Name = Name_Op_Ne)
           and then Ekind (Etype (Act1)) = E_Anonymous_Access_Type
         then
            null;

         else
            Opnd_Type := Base_Type (Etype (Right_Opnd (Op_Node)));

            if Op_Name = Name_Op_Concat then
               Opnd_Type := Base_Type (Typ);

            elsif (Scope (Opnd_Type) = Standard_Standard
                     and then Is_Binary)
              or else (Nkind (Right_Opnd (Op_Node)) = N_Attribute_Reference
                        and then Is_Binary
                        and then not Comes_From_Source (Opnd_Type))
            then
               Opnd_Type := Base_Type (Etype (Left_Opnd (Op_Node)));
            end if;

            if Scope (Opnd_Type) = Standard_Standard then

               --  Verify that the scope contains a type that corresponds to
               --  the given literal. Optimize the case where Pack is Standard.

               if Pack /= Standard_Standard then

                  if Opnd_Type = Universal_Integer then
                     Orig_Type :=  Type_In_P (Is_Integer_Type'Access);

                  elsif Opnd_Type = Universal_Real then
                     Orig_Type := Type_In_P (Is_Real_Type'Access);

                  elsif Opnd_Type = Any_String then
                     Orig_Type := Type_In_P (Is_String_Type'Access);

                  elsif Opnd_Type = Any_Access then
                     Orig_Type :=  Type_In_P (Is_Definite_Access_Type'Access);

                  elsif Opnd_Type = Any_Composite then
                     Orig_Type := Type_In_P (Is_Composite_Type'Access);

                     if Present (Orig_Type) then
                        if Has_Private_Component (Orig_Type) then
                           Orig_Type := Empty;
                        else
                           Set_Etype (Act1, Orig_Type);

                           if Is_Binary then
                              Set_Etype (Act2, Orig_Type);
                           end if;
                        end if;
                     end if;

                  else
                     Orig_Type := Empty;
                  end if;

                  Error := No (Orig_Type);
               end if;

            elsif Ekind (Opnd_Type) = E_Allocator_Type
               and then No (Type_In_P (Is_Definite_Access_Type'Access))
            then
               Error := True;

            --  If the type is defined elsewhere, and the operator is not
            --  defined in the given scope (by a renaming declaration, e.g.)
            --  then this is an error as well. If an extension of System is
            --  present, and the type may be defined there, Pack must be
            --  System itself.

            elsif Scope (Opnd_Type) /= Pack
              and then Scope (Op_Id) /= Pack
              and then (No (System_Aux_Id)
                         or else Scope (Opnd_Type) /= System_Aux_Id
                         or else Pack /= Scope (System_Aux_Id))
            then
               if not Is_Overloaded (Right_Opnd (Op_Node)) then
                  Error := True;
               else
                  Error := not Operand_Type_In_Scope (Pack);
               end if;

            elsif Pack = Standard_Standard
              and then not Operand_Type_In_Scope (Standard_Standard)
            then
               Error := True;
            end if;
         end if;

         if Error then
            Error_Msg_Node_2 := Pack;
            Error_Msg_NE
              ("& not declared in&", N, Selector_Name (Name (N)));
            Set_Etype (N, Any_Type);
            return;
         end if;
      end if;

      Set_Chars  (Op_Node, Op_Name);

      if not Is_Private_Type (Etype (N)) then
         Set_Etype (Op_Node, Base_Type (Etype (N)));
      else
         Set_Etype (Op_Node, Etype (N));
      end if;

      --  If this is a call to a function that renames a predefined equality,
      --  the renaming declaration provides a type that must be used to
      --  resolve the operands. This must be done now because resolution of
      --  the equality node will not resolve any remaining ambiguity, and it
      --  assumes that the first operand is not overloaded.

      if (Op_Name = Name_Op_Eq or else Op_Name = Name_Op_Ne)
        and then Ekind (Func) = E_Function
        and then Is_Overloaded (Act1)
      then
         Resolve (Act1, Base_Type (Etype (First_Formal (Func))));
         Resolve (Act2, Base_Type (Etype (First_Formal (Func))));
      end if;

      Set_Entity (Op_Node, Op_Id);
      Generate_Reference (Op_Id, N, ' ');

      --  Do rewrite setting Comes_From_Source on the result if the original
      --  call came from source. Although it is not strictly the case that the
      --  operator as such comes from the source, logically it corresponds
      --  exactly to the function call in the source, so it should be marked
      --  this way (e.g. to make sure that validity checks work fine).

      declare
         CS : constant Boolean := Comes_From_Source (N);
      begin
         Rewrite (N, Op_Node);
         Set_Comes_From_Source (N, CS);
      end;

      --  If this is an arithmetic operator and the result type is private,
      --  the operands and the result must be wrapped in conversion to
      --  expose the underlying numeric type and expand the proper checks,
      --  e.g. on division.

      if Is_Private_Type (Typ) then
         case Nkind (N) is
            when N_Op_Add  | N_Op_Subtract | N_Op_Multiply | N_Op_Divide |
            N_Op_Expon     | N_Op_Mod      | N_Op_Rem      =>
               Resolve_Intrinsic_Operator (N, Typ);

            when N_Op_Plus | N_Op_Minus    | N_Op_Abs      =>
               Resolve_Intrinsic_Unary_Operator (N, Typ);

            when others =>
               Resolve (N, Typ);
         end case;
      else
         Resolve (N, Typ);
      end if;

      --  For predefined operators on literals, the operation freezes
      --  their type.

      if Present (Orig_Type) then
         Set_Etype (Act1, Orig_Type);
         Freeze_Expression (Act1);
      end if;
   end Make_Call_Into_Operator;

   -------------------
   -- Operator_Kind --
   -------------------

   function Operator_Kind
     (Op_Name   : Name_Id;
      Is_Binary : Boolean) return Node_Kind
   is
      Kind : Node_Kind;

   begin
      if Is_Binary then
         if    Op_Name =  Name_Op_And      then
            Kind := N_Op_And;
         elsif Op_Name =  Name_Op_Or       then
            Kind := N_Op_Or;
         elsif Op_Name =  Name_Op_Xor      then
            Kind := N_Op_Xor;
         elsif Op_Name =  Name_Op_Eq       then
            Kind := N_Op_Eq;
         elsif Op_Name =  Name_Op_Ne       then
            Kind := N_Op_Ne;
         elsif Op_Name =  Name_Op_Lt       then
            Kind := N_Op_Lt;
         elsif Op_Name =  Name_Op_Le       then
            Kind := N_Op_Le;
         elsif Op_Name =  Name_Op_Gt       then
            Kind := N_Op_Gt;
         elsif Op_Name =  Name_Op_Ge       then
            Kind := N_Op_Ge;
         elsif Op_Name =  Name_Op_Add      then
            Kind := N_Op_Add;
         elsif Op_Name =  Name_Op_Subtract then
            Kind := N_Op_Subtract;
         elsif Op_Name =  Name_Op_Concat   then
            Kind := N_Op_Concat;
         elsif Op_Name =  Name_Op_Multiply then
            Kind := N_Op_Multiply;
         elsif Op_Name =  Name_Op_Divide   then
            Kind := N_Op_Divide;
         elsif Op_Name =  Name_Op_Mod      then
            Kind := N_Op_Mod;
         elsif Op_Name =  Name_Op_Rem      then
            Kind := N_Op_Rem;
         elsif Op_Name =  Name_Op_Expon    then
            Kind := N_Op_Expon;
         else
            raise Program_Error;
         end if;

      --  Unary operators

      else
         if    Op_Name =  Name_Op_Add      then
            Kind := N_Op_Plus;
         elsif Op_Name =  Name_Op_Subtract then
            Kind := N_Op_Minus;
         elsif Op_Name =  Name_Op_Abs      then
            Kind := N_Op_Abs;
         elsif Op_Name =  Name_Op_Not      then
            Kind := N_Op_Not;
         else
            raise Program_Error;
         end if;
      end if;

      return Kind;
   end Operator_Kind;

   ----------------------------
   -- Preanalyze_And_Resolve --
   ----------------------------

   procedure Preanalyze_And_Resolve (N : Node_Id; T : Entity_Id) is
      Save_Full_Analysis : constant Boolean := Full_Analysis;

   begin
      Full_Analysis := False;
      Expander_Mode_Save_And_Set (False);

      --  We suppress all checks for this analysis, since the checks will
      --  be applied properly, and in the right location, when the default
      --  expression is reanalyzed and reexpanded later on.

      Analyze_And_Resolve (N, T, Suppress => All_Checks);

      Expander_Mode_Restore;
      Full_Analysis := Save_Full_Analysis;
   end Preanalyze_And_Resolve;

   --  Version without context type

   procedure Preanalyze_And_Resolve (N : Node_Id) is
      Save_Full_Analysis : constant Boolean := Full_Analysis;

   begin
      Full_Analysis := False;
      Expander_Mode_Save_And_Set (False);

      Analyze (N);
      Resolve (N, Etype (N), Suppress => All_Checks);

      Expander_Mode_Restore;
      Full_Analysis := Save_Full_Analysis;
   end Preanalyze_And_Resolve;

   ----------------------------------
   -- Replace_Actual_Discriminants --
   ----------------------------------

   procedure Replace_Actual_Discriminants (N : Node_Id; Default : Node_Id) is
      Loc : constant Source_Ptr := Sloc (N);
      Tsk : Node_Id := Empty;

      function Process_Discr (Nod : Node_Id) return Traverse_Result;

      -------------------
      -- Process_Discr --
      -------------------

      function Process_Discr (Nod : Node_Id) return Traverse_Result is
         Ent : Entity_Id;

      begin
         if Nkind (Nod) = N_Identifier then
            Ent := Entity (Nod);

            if Present (Ent)
              and then Ekind (Ent) = E_Discriminant
            then
               Rewrite (Nod,
                 Make_Selected_Component (Loc,
                   Prefix        => New_Copy_Tree (Tsk, New_Sloc => Loc),
                   Selector_Name => Make_Identifier (Loc, Chars (Ent))));

               Set_Etype (Nod, Etype (Ent));
            end if;

         end if;

         return OK;
      end Process_Discr;

      procedure Replace_Discrs is new Traverse_Proc (Process_Discr);

   --  Start of processing for Replace_Actual_Discriminants

   begin
      if not Expander_Active then
         return;
      end if;

      if Nkind (Name (N)) = N_Selected_Component then
         Tsk := Prefix (Name (N));

      elsif Nkind (Name (N)) = N_Indexed_Component then
         Tsk := Prefix (Prefix (Name (N)));
      end if;

      if No (Tsk) then
         return;
      else
         Replace_Discrs (Default);
      end if;
   end Replace_Actual_Discriminants;

   -------------
   -- Resolve --
   -------------

   procedure Resolve (N : Node_Id; Typ : Entity_Id) is
      Ambiguous : Boolean   := False;
      Ctx_Type  : Entity_Id := Typ;
      Expr_Type : Entity_Id := Empty; -- prevent junk warning
      Err_Type  : Entity_Id := Empty;
      Found     : Boolean   := False;
      From_Lib  : Boolean;
      I         : Interp_Index;
      I1        : Interp_Index := 0;  -- prevent junk warning
      It        : Interp;
      It1       : Interp;
      Seen      : Entity_Id := Empty; -- prevent junk warning

      function Comes_From_Predefined_Lib_Unit (Nod : Node_Id) return Boolean;
      --  Determine whether a node comes from a predefined library unit or
      --  Standard.

      procedure Patch_Up_Value (N : Node_Id; Typ : Entity_Id);
      --  Try and fix up a literal so that it matches its expected type. New
      --  literals are manufactured if necessary to avoid cascaded errors.

      procedure Resolution_Failed;
      --  Called when attempt at resolving current expression fails

      ------------------------------------
      -- Comes_From_Predefined_Lib_Unit --
      -------------------------------------

      function Comes_From_Predefined_Lib_Unit (Nod : Node_Id) return Boolean is
      begin
         return
           Sloc (Nod) = Standard_Location
             or else Is_Predefined_File_Name (Unit_File_Name (
                       Get_Source_Unit (Sloc (Nod))));
      end Comes_From_Predefined_Lib_Unit;

      --------------------
      -- Patch_Up_Value --
      --------------------

      procedure Patch_Up_Value (N : Node_Id; Typ : Entity_Id) is
      begin
         if Nkind (N) = N_Integer_Literal
           and then Is_Real_Type (Typ)
         then
            Rewrite (N,
              Make_Real_Literal (Sloc (N),
                Realval => UR_From_Uint (Intval (N))));
            Set_Etype (N, Universal_Real);
            Set_Is_Static_Expression (N);

         elsif Nkind (N) = N_Real_Literal
           and then Is_Integer_Type (Typ)
         then
            Rewrite (N,
              Make_Integer_Literal (Sloc (N),
                Intval => UR_To_Uint (Realval (N))));
            Set_Etype (N, Universal_Integer);
            Set_Is_Static_Expression (N);

         elsif Nkind (N) = N_String_Literal
           and then Is_Character_Type (Typ)
         then
            Set_Character_Literal_Name (Char_Code (Character'Pos ('A')));
            Rewrite (N,
              Make_Character_Literal (Sloc (N),
                Chars => Name_Find,
                Char_Literal_Value =>
                  UI_From_Int (Character'Pos ('A'))));
            Set_Etype (N, Any_Character);
            Set_Is_Static_Expression (N);

         elsif Nkind (N) /= N_String_Literal
           and then Is_String_Type (Typ)
         then
            Rewrite (N,
              Make_String_Literal (Sloc (N),
                Strval => End_String));

         elsif Nkind (N) = N_Range then
            Patch_Up_Value (Low_Bound (N), Typ);
            Patch_Up_Value (High_Bound (N), Typ);
         end if;
      end Patch_Up_Value;

      -----------------------
      -- Resolution_Failed --
      -----------------------

      procedure Resolution_Failed is
      begin
         Patch_Up_Value (N, Typ);
         Set_Etype (N, Typ);
         Debug_A_Exit ("resolving  ", N, " (done, resolution failed)");
         Set_Is_Overloaded (N, False);

         --  The caller will return without calling the expander, so we need
         --  to set the analyzed flag. Note that it is fine to set Analyzed
         --  to True even if we are in the middle of a shallow analysis,
         --  (see the spec of sem for more details) since this is an error
         --  situation anyway, and there is no point in repeating the
         --  analysis later (indeed it won't work to repeat it later, since
         --  we haven't got a clear resolution of which entity is being
         --  referenced.)

         Set_Analyzed (N, True);
         return;
      end Resolution_Failed;

   --  Start of processing for Resolve

   begin
      if N = Error then
         return;
      end if;

      --  Access attribute on remote subprogram cannot be used for
      --  a non-remote access-to-subprogram type.

      if Nkind (N) = N_Attribute_Reference
        and then (Attribute_Name (N) = Name_Access
                    or else Attribute_Name (N) = Name_Unrestricted_Access
                    or else Attribute_Name (N) = Name_Unchecked_Access)
        and then Comes_From_Source (N)
        and then Is_Entity_Name (Prefix (N))
        and then Is_Subprogram (Entity (Prefix (N)))
        and then Is_Remote_Call_Interface (Entity (Prefix (N)))
        and then not Is_Remote_Access_To_Subprogram_Type (Typ)
      then
         Error_Msg_N
           ("prefix must statically denote a non-remote subprogram", N);
      end if;

      From_Lib := Comes_From_Predefined_Lib_Unit (N);

      --  If the context is a Remote_Access_To_Subprogram, access attributes
      --  must be resolved with the corresponding fat pointer. There is no need
      --  to check for the attribute name since the return type of an
      --  attribute is never a remote type.

      if Nkind (N) = N_Attribute_Reference
        and then Comes_From_Source (N)
        and then (Is_Remote_Call_Interface (Typ)
                    or else Is_Remote_Types (Typ))
      then
         declare
            Attr      : constant Attribute_Id :=
                          Get_Attribute_Id (Attribute_Name (N));
            Pref      : constant Node_Id      := Prefix (N);
            Decl      : Node_Id;
            Spec      : Node_Id;
            Is_Remote : Boolean := True;

         begin
            --  Check that Typ is a remote access-to-subprogram type

            if Is_Remote_Access_To_Subprogram_Type (Typ) then
               --  Prefix (N) must statically denote a remote subprogram
               --  declared in a package specification.

               if Attr = Attribute_Access then
                  Decl := Unit_Declaration_Node (Entity (Pref));

                  if Nkind (Decl) = N_Subprogram_Body then
                     Spec := Corresponding_Spec (Decl);

                     if not No (Spec) then
                        Decl := Unit_Declaration_Node (Spec);
                     end if;
                  end if;

                  Spec := Parent (Decl);

                  if not Is_Entity_Name (Prefix (N))
                    or else Nkind (Spec) /= N_Package_Specification
                    or else
                      not Is_Remote_Call_Interface (Defining_Entity (Spec))
                  then
                     Is_Remote := False;
                     Error_Msg_N
                       ("prefix must statically denote a remote subprogram ",
                        N);
                  end if;
               end if;

               --   If we are generating code for a distributed program.
               --   perform semantic checks against the corresponding
               --   remote entities.

               if (Attr = Attribute_Access
                    or else Attr = Attribute_Unchecked_Access
                    or else Attr = Attribute_Unrestricted_Access)
                 and then Expander_Active
                 and then Get_PCS_Name /= Name_No_DSA
               then
                  Check_Subtype_Conformant
                    (New_Id  => Entity (Prefix (N)),
                     Old_Id  => Designated_Type
                       (Corresponding_Remote_Type (Typ)),
                     Err_Loc => N);

                  if Is_Remote then
                     Process_Remote_AST_Attribute (N, Typ);
                  end if;
               end if;
            end if;
         end;
      end if;

      Debug_A_Entry ("resolving  ", N);

      if Comes_From_Source (N) then
         if Is_Fixed_Point_Type (Typ) then
            Check_Restriction (No_Fixed_Point, N);

         elsif Is_Floating_Point_Type (Typ)
           and then Typ /= Universal_Real
           and then Typ /= Any_Real
         then
            Check_Restriction (No_Floating_Point, N);
         end if;
      end if;

      --  Return if already analyzed

      if Analyzed (N) then
         Debug_A_Exit ("resolving  ", N, "  (done, already analyzed)");
         return;

      --  Return if type = Any_Type (previous error encountered)

      elsif Etype (N) = Any_Type then
         Debug_A_Exit ("resolving  ", N, "  (done, Etype = Any_Type)");
         return;
      end if;

      Check_Parameterless_Call (N);

      --  If not overloaded, then we know the type, and all that needs doing
      --  is to check that this type is compatible with the context.

      if not Is_Overloaded (N) then
         Found := Covers (Typ, Etype (N));
         Expr_Type := Etype (N);

      --  In the overloaded case, we must select the interpretation that
      --  is compatible with the context (i.e. the type passed to Resolve)

      else
         --  Loop through possible interpretations

         Get_First_Interp (N, I, It);
         Interp_Loop : while Present (It.Typ) loop

            --  We are only interested in interpretations that are compatible
            --  with the expected type, any other interpretations are ignored.

            if not Covers (Typ, It.Typ) then
               if Debug_Flag_V then
                  Write_Str ("    interpretation incompatible with context");
                  Write_Eol;
               end if;

            else
               --  Skip the current interpretation if it is disabled by an
               --  abstract operator. This action is performed only when the
               --  type against which we are resolving is the same as the
               --  type of the interpretation.

               if Ada_Version >= Ada_05
                 and then It.Typ = Typ
                 and then Typ /= Universal_Integer
                 and then Typ /= Universal_Real
                 and then Present (It.Abstract_Op)
               then
                  goto Continue;
               end if;

               --  First matching interpretation

               if not Found then
                  Found := True;
                  I1    := I;
                  Seen  := It.Nam;
                  Expr_Type := It.Typ;

               --  Matching interpretation that is not the first, maybe an
               --  error, but there are some cases where preference rules are
               --  used to choose between the two possibilities. These and
               --  some more obscure cases are handled in Disambiguate.

               else
                  --  If the current statement is part of a predefined library
                  --  unit, then all interpretations which come from user level
                  --  packages should not be considered.

                  if From_Lib
                    and then not Comes_From_Predefined_Lib_Unit (It.Nam)
                  then
                     goto Continue;
                  end if;

                  Error_Msg_Sloc := Sloc (Seen);
                  It1 := Disambiguate (N, I1, I, Typ);

                  --  Disambiguation has succeeded. Skip the remaining
                  --  interpretations.

                  if It1 /= No_Interp then
                     Seen := It1.Nam;
                     Expr_Type := It1.Typ;

                     while Present (It.Typ) loop
                        Get_Next_Interp (I, It);
                     end loop;

                  else
                     --  Before we issue an ambiguity complaint, check for
                     --  the case of a subprogram call where at least one
                     --  of the arguments is Any_Type, and if so, suppress
                     --  the message, since it is a cascaded error.

                     if Nkind_In (N, N_Function_Call,
                                     N_Procedure_Call_Statement)
                     then
                        declare
                           A : Node_Id;
                           E : Node_Id;

                        begin
                           A := First_Actual (N);
                           while Present (A) loop
                              E := A;

                              if Nkind (E) = N_Parameter_Association then
                                 E := Explicit_Actual_Parameter (E);
                              end if;

                              if Etype (E) = Any_Type then
                                 if Debug_Flag_V then
                                    Write_Str ("Any_Type in call");
                                    Write_Eol;
                                 end if;

                                 exit Interp_Loop;
                              end if;

                              Next_Actual (A);
                           end loop;
                        end;

                     elsif Nkind (N) in N_Binary_Op
                       and then (Etype (Left_Opnd (N)) = Any_Type
                                  or else Etype (Right_Opnd (N)) = Any_Type)
                     then
                        exit Interp_Loop;

                     elsif Nkind (N) in  N_Unary_Op
                       and then Etype (Right_Opnd (N)) = Any_Type
                     then
                        exit Interp_Loop;
                     end if;

                     --  Not that special case, so issue message using the
                     --  flag Ambiguous to control printing of the header
                     --  message only at the start of an ambiguous set.

                     if not Ambiguous then
                        if Nkind (N) = N_Function_Call
                          and then Nkind (Name (N)) = N_Explicit_Dereference
                        then
                           Error_Msg_N
                             ("ambiguous expression "
                               & "(cannot resolve indirect call)!", N);
                        else
                           Error_Msg_NE
                             ("ambiguous expression (cannot resolve&)!",
                              N, It.Nam);
                        end if;

                        Ambiguous := True;

                        if Nkind (Parent (Seen)) = N_Full_Type_Declaration then
                           Error_Msg_N
                             ("\\possible interpretation (inherited)#!", N);
                        else
                           Error_Msg_N ("\\possible interpretation#!", N);
                        end if;
                     end if;

                     Error_Msg_Sloc := Sloc (It.Nam);

                     --  By default, the error message refers to the candidate
                     --  interpretation. But if it is a predefined operator, it
                     --  is implicitly declared at the declaration of the type
                     --  of the operand. Recover the sloc of that declaration
                     --  for the error message.

                     if Nkind (N) in N_Op
                       and then Scope (It.Nam) = Standard_Standard
                       and then not Is_Overloaded (Right_Opnd (N))
                       and then Scope (Base_Type (Etype (Right_Opnd (N)))) /=
                                                             Standard_Standard
                     then
                        Err_Type := First_Subtype (Etype (Right_Opnd (N)));

                        if Comes_From_Source (Err_Type)
                          and then Present (Parent (Err_Type))
                        then
                           Error_Msg_Sloc := Sloc (Parent (Err_Type));
                        end if;

                     elsif Nkind (N) in N_Binary_Op
                       and then Scope (It.Nam) = Standard_Standard
                       and then not Is_Overloaded (Left_Opnd (N))
                       and then Scope (Base_Type (Etype (Left_Opnd (N)))) /=
                                                             Standard_Standard
                     then
                        Err_Type := First_Subtype (Etype (Left_Opnd (N)));

                        if Comes_From_Source (Err_Type)
                          and then Present (Parent (Err_Type))
                        then
                           Error_Msg_Sloc := Sloc (Parent (Err_Type));
                        end if;

                     --  If this is an indirect call, use the subprogram_type
                     --  in the message, to have a meaningful location.
                     --  Indicate as well if this is an inherited operation,
                     --  created by a type declaration.

                     elsif Nkind (N) = N_Function_Call
                       and then Nkind (Name (N)) = N_Explicit_Dereference
                       and then Is_Type (It.Nam)
                     then
                        Err_Type := It.Nam;
                        Error_Msg_Sloc :=
                          Sloc (Associated_Node_For_Itype (Err_Type));
                     else
                        Err_Type := Empty;
                     end if;

                     if Nkind (N) in N_Op
                       and then Scope (It.Nam) = Standard_Standard
                       and then Present (Err_Type)
                     then
                        --  Special-case the message for universal_fixed
                        --  operators, which are not declared with the type
                        --  of the operand, but appear forever in Standard.

                        if  It.Typ = Universal_Fixed
                          and then Scope (It.Nam) = Standard_Standard
                        then
                           Error_Msg_N
                             ("\\possible interpretation as " &
                                "universal_fixed operation " &
                                  "(RM 4.5.5 (19))", N);
                        else
                           Error_Msg_N
                             ("\\possible interpretation (predefined)#!", N);
                        end if;

                     elsif
                       Nkind (Parent (It.Nam)) = N_Full_Type_Declaration
                     then
                        Error_Msg_N
                          ("\\possible interpretation (inherited)#!", N);
                     else
                        Error_Msg_N ("\\possible interpretation#!", N);
                     end if;

                  end if;
               end if;

               --  We have a matching interpretation, Expr_Type is the type
               --  from this interpretation, and Seen is the entity.

               --  For an operator, just set the entity name. The type will be
               --  set by the specific operator resolution routine.

               if Nkind (N) in N_Op then
                  Set_Entity (N, Seen);
                  Generate_Reference (Seen, N);

               elsif Nkind (N) = N_Character_Literal then
                  Set_Etype (N, Expr_Type);

               --  For an explicit dereference, attribute reference, range,
               --  short-circuit form (which is not an operator node), or call
               --  with a name that is an explicit dereference, there is
               --  nothing to be done at this point.

               elsif Nkind_In (N, N_Explicit_Dereference,
                                  N_Attribute_Reference,
                                  N_And_Then,
                                  N_Indexed_Component,
                                  N_Or_Else,
                                  N_Range,
                                  N_Selected_Component,
                                  N_Slice)
                 or else Nkind (Name (N)) = N_Explicit_Dereference
               then
                  null;

               --  For procedure or function calls, set the type of the name,
               --  and also the entity pointer for the prefix

               elsif Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call)
                 and then (Is_Entity_Name (Name (N))
                            or else Nkind (Name (N)) = N_Operator_Symbol)
               then
                  Set_Etype  (Name (N), Expr_Type);
                  Set_Entity (Name (N), Seen);
                  Generate_Reference (Seen, Name (N));

               elsif Nkind (N) = N_Function_Call
                 and then Nkind (Name (N)) = N_Selected_Component
               then
                  Set_Etype (Name (N), Expr_Type);
                  Set_Entity (Selector_Name (Name (N)), Seen);
                  Generate_Reference (Seen, Selector_Name (Name (N)));

               --  For all other cases, just set the type of the Name

               else
                  Set_Etype (Name (N), Expr_Type);
               end if;

            end if;

            <<Continue>>

            --  Move to next interpretation

            exit Interp_Loop when No (It.Typ);

            Get_Next_Interp (I, It);
         end loop Interp_Loop;
      end if;

      --  At this stage Found indicates whether or not an acceptable
      --  interpretation exists. If not, then we have an error, except
      --  that if the context is Any_Type as a result of some other error,
      --  then we suppress the error report.

      if not Found then
         if Typ /= Any_Type then

            --  If type we are looking for is Void, then this is the procedure
            --  call case, and the error is simply that what we gave is not a
            --  procedure name (we think of procedure calls as expressions with
            --  types internally, but the user doesn't think of them this way!)

            if Typ = Standard_Void_Type then

               --  Special case message if function used as a procedure

               if Nkind (N) = N_Procedure_Call_Statement
                 and then Is_Entity_Name (Name (N))
                 and then Ekind (Entity (Name (N))) = E_Function
               then
                  Error_Msg_NE
                    ("cannot use function & in a procedure call",
                     Name (N), Entity (Name (N)));

               --  Otherwise give general message (not clear what cases this
               --  covers, but no harm in providing for them!)

               else
                  Error_Msg_N ("expect procedure name in procedure call", N);
               end if;

               Found := True;

            --  Otherwise we do have a subexpression with the wrong type

            --  Check for the case of an allocator which uses an access type
            --  instead of the designated type. This is a common error and we
            --  specialize the message, posting an error on the operand of the
            --  allocator, complaining that we expected the designated type of
            --  the allocator.

            elsif Nkind (N) = N_Allocator
              and then Ekind (Typ) in Access_Kind
              and then Ekind (Etype (N)) in Access_Kind
              and then Designated_Type (Etype (N)) = Typ
            then
               Wrong_Type (Expression (N), Designated_Type (Typ));
               Found := True;

            --  Check for view mismatch on Null in instances, for which the
            --  view-swapping mechanism has no identifier.

            elsif (In_Instance or else In_Inlined_Body)
              and then (Nkind (N) = N_Null)
              and then Is_Private_Type (Typ)
              and then Is_Access_Type (Full_View (Typ))
            then
               Resolve (N, Full_View (Typ));
               Set_Etype (N, Typ);
               return;

            --  Check for an aggregate. Sometimes we can get bogus aggregates
            --  from misuse of parentheses, and we are about to complain about
            --  the aggregate without even looking inside it.

            --  Instead, if we have an aggregate of type Any_Composite, then
            --  analyze and resolve the component fields, and then only issue
            --  another message if we get no errors doing this (otherwise
            --  assume that the errors in the aggregate caused the problem).

            elsif Nkind (N) = N_Aggregate
              and then Etype (N) = Any_Composite
            then
               --  Disable expansion in any case. If there is a type mismatch
               --  it may be fatal to try to expand the aggregate. The flag
               --  would otherwise be set to false when the error is posted.

               Expander_Active := False;

               declare
                  procedure Check_Aggr (Aggr : Node_Id);
                  --  Check one aggregate, and set Found to True if we have a
                  --  definite error in any of its elements

                  procedure Check_Elmt (Aelmt : Node_Id);
                  --  Check one element of aggregate and set Found to True if
                  --  we definitely have an error in the element.

                  ----------------
                  -- Check_Aggr --
                  ----------------

                  procedure Check_Aggr (Aggr : Node_Id) is
                     Elmt : Node_Id;

                  begin
                     if Present (Expressions (Aggr)) then
                        Elmt := First (Expressions (Aggr));
                        while Present (Elmt) loop
                           Check_Elmt (Elmt);
                           Next (Elmt);
                        end loop;
                     end if;

                     if Present (Component_Associations (Aggr)) then
                        Elmt := First (Component_Associations (Aggr));
                        while Present (Elmt) loop

                           --  If this is a default-initialized component, then
                           --  there is nothing to check. The box will be
                           --  replaced by the appropriate call during late
                           --  expansion.

                           if not Box_Present (Elmt) then
                              Check_Elmt (Expression (Elmt));
                           end if;

                           Next (Elmt);
                        end loop;
                     end if;
                  end Check_Aggr;

                  ----------------
                  -- Check_Elmt --
                  ----------------

                  procedure Check_Elmt (Aelmt : Node_Id) is
                  begin
                     --  If we have a nested aggregate, go inside it (to
                     --  attempt a naked analyze-resolve of the aggregate
                     --  can cause undesirable cascaded errors). Do not
                     --  resolve expression if it needs a type from context,
                     --  as for integer * fixed expression.

                     if Nkind (Aelmt) = N_Aggregate then
                        Check_Aggr (Aelmt);

                     else
                        Analyze (Aelmt);

                        if not Is_Overloaded (Aelmt)
                          and then Etype (Aelmt) /= Any_Fixed
                        then
                           Resolve (Aelmt);
                        end if;

                        if Etype (Aelmt) = Any_Type then
                           Found := True;
                        end if;
                     end if;
                  end Check_Elmt;

               begin
                  Check_Aggr (N);
               end;
            end if;

            --  If an error message was issued already, Found got reset
            --  to True, so if it is still False, issue the standard
            --  Wrong_Type message.

            if not Found then
               if Is_Overloaded (N)
                 and then Nkind (N) = N_Function_Call
               then
                  declare
                     Subp_Name : Node_Id;
                  begin
                     if Is_Entity_Name (Name (N)) then
                        Subp_Name := Name (N);

                     elsif Nkind (Name (N)) = N_Selected_Component then

                        --  Protected operation: retrieve operation name

                        Subp_Name := Selector_Name (Name (N));
                     else
                        raise Program_Error;
                     end if;

                     Error_Msg_Node_2 := Typ;
                     Error_Msg_NE ("no visible interpretation of&" &
                       " matches expected type&", N, Subp_Name);
                  end;

                  if All_Errors_Mode then
                     declare
                        Index : Interp_Index;
                        It    : Interp;

                     begin
                        Error_Msg_N ("\\possible interpretations:", N);

                        Get_First_Interp (Name (N), Index, It);
                        while Present (It.Nam) loop
                           Error_Msg_Sloc := Sloc (It.Nam);
                           Error_Msg_Node_2 := It.Nam;
                           Error_Msg_NE
                             ("\\  type& for & declared#", N, It.Typ);
                           Get_Next_Interp (Index, It);
                        end loop;
                     end;

                  else
                     Error_Msg_N ("\use -gnatf for details", N);
                  end if;
               else
                  Wrong_Type (N, Typ);
               end if;
            end if;
         end if;

         Resolution_Failed;
         return;

      --  Test if we have more than one interpretation for the context

      elsif Ambiguous then
         Resolution_Failed;
         return;

      --  Here we have an acceptable interpretation for the context

      else
         --  Propagate type information and normalize tree for various
         --  predefined operations. If the context only imposes a class of
         --  types, rather than a specific type, propagate the actual type
         --  downward.

         if Typ = Any_Integer
           or else Typ = Any_Boolean
           or else Typ = Any_Modular
           or else Typ = Any_Real
           or else Typ = Any_Discrete
         then
            Ctx_Type := Expr_Type;

            --  Any_Fixed is legal in a real context only if a specific
            --  fixed point type is imposed. If Norman Cohen can be
            --  confused by this, it deserves a separate message.

            if Typ = Any_Real
              and then Expr_Type = Any_Fixed
            then
               Error_Msg_N ("illegal context for mixed mode operation", N);
               Set_Etype (N, Universal_Real);
               Ctx_Type := Universal_Real;
            end if;
         end if;

         --  A user-defined operator is transformed into a function call at
         --  this point, so that further processing knows that operators are
         --  really operators (i.e. are predefined operators). User-defined
         --  operators that are intrinsic are just renamings of the predefined
         --  ones, and need not be turned into calls either, but if they rename
         --  a different operator, we must transform the node accordingly.
         --  Instantiations of Unchecked_Conversion are intrinsic but are
         --  treated as functions, even if given an operator designator.

         if Nkind (N) in N_Op
           and then Present (Entity (N))
           and then Ekind (Entity (N)) /= E_Operator
         then

            if not Is_Predefined_Op (Entity (N)) then
               Rewrite_Operator_As_Call (N, Entity (N));

            elsif Present (Alias (Entity (N)))
              and then
                Nkind (Parent (Parent (Entity (N)))) =
                                    N_Subprogram_Renaming_Declaration
            then
               Rewrite_Renamed_Operator (N, Alias (Entity (N)), Typ);

               --  If the node is rewritten, it will be fully resolved in
               --  Rewrite_Renamed_Operator.

               if Analyzed (N) then
                  return;
               end if;
            end if;
         end if;

         case N_Subexpr'(Nkind (N)) is

            when N_Aggregate => Resolve_Aggregate                (N, Ctx_Type);

            when N_Allocator => Resolve_Allocator                (N, Ctx_Type);

            when N_And_Then | N_Or_Else
                             => Resolve_Short_Circuit            (N, Ctx_Type);

            when N_Attribute_Reference
                             => Resolve_Attribute                (N, Ctx_Type);

            when N_Character_Literal
                             => Resolve_Character_Literal        (N, Ctx_Type);

            when N_Conditional_Expression
                             => Resolve_Conditional_Expression   (N, Ctx_Type);

            when N_Expanded_Name
                             => Resolve_Entity_Name              (N, Ctx_Type);

            when N_Extension_Aggregate
                             => Resolve_Extension_Aggregate      (N, Ctx_Type);

            when N_Explicit_Dereference
                             => Resolve_Explicit_Dereference     (N, Ctx_Type);

            when N_Function_Call
                             => Resolve_Call                     (N, Ctx_Type);

            when N_Identifier
                             => Resolve_Entity_Name              (N, Ctx_Type);

            when N_Indexed_Component
                             => Resolve_Indexed_Component        (N, Ctx_Type);

            when N_Integer_Literal
                             => Resolve_Integer_Literal          (N, Ctx_Type);

            when N_Membership_Test
                             => Resolve_Membership_Op            (N, Ctx_Type);

            when N_Null      => Resolve_Null                     (N, Ctx_Type);

            when N_Op_And | N_Op_Or | N_Op_Xor
                             => Resolve_Logical_Op               (N, Ctx_Type);

            when N_Op_Eq | N_Op_Ne
                             => Resolve_Equality_Op              (N, Ctx_Type);

            when N_Op_Lt | N_Op_Le | N_Op_Gt | N_Op_Ge
                             => Resolve_Comparison_Op            (N, Ctx_Type);

            when N_Op_Not    => Resolve_Op_Not                   (N, Ctx_Type);

            when N_Op_Add    | N_Op_Subtract | N_Op_Multiply |
                 N_Op_Divide | N_Op_Mod      | N_Op_Rem

                             => Resolve_Arithmetic_Op            (N, Ctx_Type);

            when N_Op_Concat => Resolve_Op_Concat                (N, Ctx_Type);

            when N_Op_Expon  => Resolve_Op_Expon                 (N, Ctx_Type);

            when N_Op_Plus | N_Op_Minus  | N_Op_Abs
                             => Resolve_Unary_Op                 (N, Ctx_Type);

            when N_Op_Shift  => Resolve_Shift                    (N, Ctx_Type);

            when N_Procedure_Call_Statement
                             => Resolve_Call                     (N, Ctx_Type);

            when N_Operator_Symbol
                             => Resolve_Operator_Symbol          (N, Ctx_Type);

            when N_Qualified_Expression
                             => Resolve_Qualified_Expression     (N, Ctx_Type);

            when N_Raise_xxx_Error
                             => Set_Etype (N, Ctx_Type);

            when N_Range     => Resolve_Range                    (N, Ctx_Type);

            when N_Real_Literal
                             => Resolve_Real_Literal             (N, Ctx_Type);

            when N_Reference => Resolve_Reference                (N, Ctx_Type);

            when N_Selected_Component
                             => Resolve_Selected_Component       (N, Ctx_Type);

            when N_Slice     => Resolve_Slice                    (N, Ctx_Type);

            when N_String_Literal
                             => Resolve_String_Literal           (N, Ctx_Type);

            when N_Subprogram_Info
                             => Resolve_Subprogram_Info          (N, Ctx_Type);

            when N_Type_Conversion
                             => Resolve_Type_Conversion          (N, Ctx_Type);

            when N_Unchecked_Expression =>
               Resolve_Unchecked_Expression                      (N, Ctx_Type);

            when N_Unchecked_Type_Conversion =>
               Resolve_Unchecked_Type_Conversion                 (N, Ctx_Type);

         end case;

         --  If the subexpression was replaced by a non-subexpression, then
         --  all we do is to expand it. The only legitimate case we know of
         --  is converting procedure call statement to entry call statements,
         --  but there may be others, so we are making this test general.

         if Nkind (N) not in N_Subexpr then
            Debug_A_Exit ("resolving  ", N, "  (done)");
            Expand (N);
            return;
         end if;

         --  The expression is definitely NOT overloaded at this point, so
         --  we reset the Is_Overloaded flag to avoid any confusion when
         --  reanalyzing the node.

         Set_Is_Overloaded (N, False);

         --  Freeze expression type, entity if it is a name, and designated
         --  type if it is an allocator (RM 13.14(10,11,13)).

         --  Now that the resolution of the type of the node is complete,
         --  and we did not detect an error, we can expand this node. We
         --  skip the expand call if we are in a default expression, see
         --  section "Handling of Default Expressions" in Sem spec.

         Debug_A_Exit ("resolving  ", N, "  (done)");

         --  We unconditionally freeze the expression, even if we are in
         --  default expression mode (the Freeze_Expression routine tests
         --  this flag and only freezes static types if it is set).

         Freeze_Expression (N);

         --  Now we can do the expansion

         Expand (N);
      end if;
   end Resolve;

   -------------
   -- Resolve --
   -------------

   --  Version with check(s) suppressed

   procedure Resolve (N : Node_Id; Typ : Entity_Id; Suppress : Check_Id) is
   begin
      if Suppress = All_Checks then
         declare
            Svg : constant Suppress_Array := Scope_Suppress;
         begin
            Scope_Suppress := (others => True);
            Resolve (N, Typ);
            Scope_Suppress := Svg;
         end;

      else
         declare
            Svg : constant Boolean := Scope_Suppress (Suppress);
         begin
            Scope_Suppress (Suppress) := True;
            Resolve (N, Typ);
            Scope_Suppress (Suppress) := Svg;
         end;
      end if;
   end Resolve;

   -------------
   -- Resolve --
   -------------

   --  Version with implicit type

   procedure Resolve (N : Node_Id) is
   begin
      Resolve (N, Etype (N));
   end Resolve;

   ---------------------
   -- Resolve_Actuals --
   ---------------------

   procedure Resolve_Actuals (N : Node_Id; Nam : Entity_Id) is
      Loc    : constant Source_Ptr := Sloc (N);
      A      : Node_Id;
      F      : Entity_Id;
      A_Typ  : Entity_Id;
      F_Typ  : Entity_Id;
      Prev   : Node_Id := Empty;
      Orig_A : Node_Id;

      procedure Check_Argument_Order;
      --  Performs a check for the case where the actuals are all simple
      --  identifiers that correspond to the formal names, but in the wrong
      --  order, which is considered suspicious and cause for a warning.

      procedure Check_Prefixed_Call;
      --  If the original node is an overloaded call in prefix notation,
      --  insert an 'Access or a dereference as needed over the first actual.
      --  Try_Object_Operation has already verified that there is a valid
      --  interpretation, but the form of the actual can only be determined
      --  once the primitive operation is identified.

      procedure Insert_Default;
      --  If the actual is missing in a call, insert in the actuals list
      --  an instance of the default expression. The insertion is always
      --  a named association.

      function Same_Ancestor (T1, T2 : Entity_Id) return Boolean;
      --  Check whether T1 and T2, or their full views, are derived from a
      --  common type. Used to enforce the restrictions on array conversions
      --  of AI95-00246.

      --------------------------
      -- Check_Argument_Order --
      --------------------------

      procedure Check_Argument_Order is
      begin
         --  Nothing to do if no parameters, or original node is neither a
         --  function call nor a procedure call statement (happens in the
         --  operator-transformed-to-function call case), or the call does
         --  not come from source, or this warning is off.

         if not Warn_On_Parameter_Order
           or else
             No (Parameter_Associations (N))
           or else
             not Nkind_In (Original_Node (N), N_Procedure_Call_Statement,
                                              N_Function_Call)
           or else
             not Comes_From_Source (N)
         then
            return;
         end if;

         declare
            Nargs : constant Nat := List_Length (Parameter_Associations (N));

         begin
            --  Nothing to do if only one parameter

            if Nargs < 2 then
               return;
            end if;

            --  Here if at least two arguments

            declare
               Actuals : array (1 .. Nargs) of Node_Id;
               Actual  : Node_Id;
               Formal  : Node_Id;

               Wrong_Order : Boolean := False;
               --  Set True if an out of order case is found

            begin
               --  Collect identifier names of actuals, fail if any actual is
               --  not a simple identifier, and record max length of name.

               Actual := First (Parameter_Associations (N));
               for J in Actuals'Range loop
                  if Nkind (Actual) /= N_Identifier then
                     return;
                  else
                     Actuals (J) := Actual;
                     Next (Actual);
                  end if;
               end loop;

               --  If we got this far, all actuals are identifiers and the list
               --  of their names is stored in the Actuals array.

               Formal := First_Formal (Nam);
               for J in Actuals'Range loop

                  --  If we ran out of formals, that's odd, probably an error
                  --  which will be detected elsewhere, but abandon the search.

                  if No (Formal) then
                     return;
                  end if;

                  --  If name matches and is in order OK

                  if Chars (Formal) = Chars (Actuals (J)) then
                     null;

                  else
                     --  If no match, see if it is elsewhere in list and if so
                     --  flag potential wrong order if type is compatible.

                     for K in Actuals'Range loop
                        if Chars (Formal) = Chars (Actuals (K))
                          and then
                            Has_Compatible_Type (Actuals (K), Etype (Formal))
                        then
                           Wrong_Order := True;
                           goto Continue;
                        end if;
                     end loop;

                     --  No match

                     return;
                  end if;

                  <<Continue>> Next_Formal (Formal);
               end loop;

               --  If Formals left over, also probably an error, skip warning

               if Present (Formal) then
                  return;
               end if;

               --  Here we give the warning if something was out of order

               if Wrong_Order then
                  Error_Msg_N
                    ("actuals for this call may be in wrong order?", N);
               end if;
            end;
         end;
      end Check_Argument_Order;

      -------------------------
      -- Check_Prefixed_Call --
      -------------------------

      procedure Check_Prefixed_Call is
         Act    : constant Node_Id   := First_Actual (N);
         A_Type : constant Entity_Id := Etype (Act);
         F_Type : constant Entity_Id := Etype (First_Formal (Nam));
         Orig   : constant Node_Id := Original_Node (N);
         New_A  : Node_Id;

      begin
         --  Check whether the call is a prefixed call, with or without
         --  additional actuals.

         if Nkind (Orig) = N_Selected_Component
           or else
             (Nkind (Orig) = N_Indexed_Component
               and then Nkind (Prefix (Orig)) = N_Selected_Component
               and then Is_Entity_Name (Prefix (Prefix (Orig)))
               and then Is_Entity_Name (Act)
               and then Chars (Act) = Chars (Prefix (Prefix (Orig))))
         then
            if Is_Access_Type (A_Type)
              and then not Is_Access_Type (F_Type)
            then
               --  Introduce dereference on object in prefix

               New_A :=
                 Make_Explicit_Dereference (Sloc (Act),
                   Prefix => Relocate_Node (Act));
               Rewrite (Act, New_A);
               Analyze (Act);

            elsif Is_Access_Type (F_Type)
              and then not Is_Access_Type (A_Type)
            then
               --  Introduce an implicit 'Access in prefix

               if not Is_Aliased_View (Act) then
                  Error_Msg_NE
                    ("object in prefixed call to& must be aliased"
                         & " (RM-2005 4.3.1 (13))",
                    Prefix (Act), Nam);
               end if;

               Rewrite (Act,
                 Make_Attribute_Reference (Loc,
                   Attribute_Name => Name_Access,
                   Prefix         => Relocate_Node (Act)));
            end if;

            Analyze (Act);
         end if;
      end Check_Prefixed_Call;

      --------------------
      -- Insert_Default --
      --------------------

      procedure Insert_Default is
         Actval : Node_Id;
         Assoc  : Node_Id;

      begin
         --  Missing argument in call, nothing to insert

         if No (Default_Value (F)) then
            return;

         else
            --  Note that we do a full New_Copy_Tree, so that any associated
            --  Itypes are properly copied. This may not be needed any more,
            --  but it does no harm as a safety measure! Defaults of a generic
            --  formal may be out of bounds of the corresponding actual (see
            --  cc1311b) and an additional check may be required.

            Actval :=
              New_Copy_Tree
                (Default_Value (F),
                 New_Scope => Current_Scope,
                 New_Sloc  => Loc);

            if Is_Concurrent_Type (Scope (Nam))
              and then Has_Discriminants (Scope (Nam))
            then
               Replace_Actual_Discriminants (N, Actval);
            end if;

            if Is_Overloadable (Nam)
              and then Present (Alias (Nam))
            then
               if Base_Type (Etype (F)) /= Base_Type (Etype (Actval))
                 and then not Is_Tagged_Type (Etype (F))
               then
                  --  If default is a real literal, do not introduce a
                  --  conversion whose effect may depend on the run-time
                  --  size of universal real.

                  if Nkind (Actval) = N_Real_Literal then
                     Set_Etype (Actval, Base_Type (Etype (F)));
                  else
                     Actval := Unchecked_Convert_To (Etype (F), Actval);
                  end if;
               end if;

               if Is_Scalar_Type (Etype (F)) then
                  Enable_Range_Check (Actval);
               end if;

               Set_Parent (Actval, N);

               --  Resolve aggregates with their base type, to avoid scope
               --  anomalies: the subtype was first built in the subprogram
               --  declaration, and the current call may be nested.

               if Nkind (Actval) = N_Aggregate
                 and then Has_Discriminants (Etype (Actval))
               then
                  Analyze_And_Resolve (Actval, Base_Type (Etype (Actval)));
               else
                  Analyze_And_Resolve (Actval, Etype (Actval));
               end if;

            else
               Set_Parent (Actval, N);

               --  See note above concerning aggregates

               if Nkind (Actval) = N_Aggregate
                 and then Has_Discriminants (Etype (Actval))
               then
                  Analyze_And_Resolve (Actval, Base_Type (Etype (Actval)));

               --  Resolve entities with their own type, which may differ
               --  from the type of a reference in a generic context (the
               --  view swapping mechanism did not anticipate the re-analysis
               --  of default values in calls).

               elsif Is_Entity_Name (Actval) then
                  Analyze_And_Resolve (Actval, Etype (Entity (Actval)));

               else
                  Analyze_And_Resolve (Actval, Etype (Actval));
               end if;
            end if;

            --  If default is a tag indeterminate function call, propagate
            --  tag to obtain proper dispatching.

            if Is_Controlling_Formal (F)
              and then Nkind (Default_Value (F)) = N_Function_Call
            then
               Set_Is_Controlling_Actual (Actval);
            end if;

         end if;

         --  If the default expression raises constraint error, then just
         --  silently replace it with an N_Raise_Constraint_Error node,
         --  since we already gave the warning on the subprogram spec.

         if Raises_Constraint_Error (Actval) then
            Rewrite (Actval,
              Make_Raise_Constraint_Error (Loc,
                Reason => CE_Range_Check_Failed));
            Set_Raises_Constraint_Error (Actval);
            Set_Etype (Actval, Etype (F));
         end if;

         Assoc :=
           Make_Parameter_Association (Loc,
             Explicit_Actual_Parameter => Actval,
             Selector_Name => Make_Identifier (Loc, Chars (F)));

         --  Case of insertion is first named actual

         if No (Prev) or else
            Nkind (Parent (Prev)) /= N_Parameter_Association
         then
            Set_Next_Named_Actual (Assoc, First_Named_Actual (N));
            Set_First_Named_Actual (N, Actval);

            if No (Prev) then
               if No (Parameter_Associations (N)) then
                  Set_Parameter_Associations (N, New_List (Assoc));
               else
                  Append (Assoc, Parameter_Associations (N));
               end if;

            else
               Insert_After (Prev, Assoc);
            end if;

         --  Case of insertion is not first named actual

         else
            Set_Next_Named_Actual
              (Assoc, Next_Named_Actual (Parent (Prev)));
            Set_Next_Named_Actual (Parent (Prev), Actval);
            Append (Assoc, Parameter_Associations (N));
         end if;

         Mark_Rewrite_Insertion (Assoc);
         Mark_Rewrite_Insertion (Actval);

         Prev := Actval;
      end Insert_Default;

      -------------------
      -- Same_Ancestor --
      -------------------

      function Same_Ancestor (T1, T2 : Entity_Id) return Boolean is
         FT1 : Entity_Id := T1;
         FT2 : Entity_Id := T2;

      begin
         if Is_Private_Type (T1)
           and then Present (Full_View (T1))
         then
            FT1 := Full_View (T1);
         end if;

         if Is_Private_Type (T2)
           and then Present (Full_View (T2))
         then
            FT2 := Full_View (T2);
         end if;

         return Root_Type (Base_Type (FT1)) = Root_Type (Base_Type (FT2));
      end Same_Ancestor;

   --  Start of processing for Resolve_Actuals

   begin
      Check_Argument_Order;

      if Present (First_Actual (N)) then
         Check_Prefixed_Call;
      end if;

      A := First_Actual (N);
      F := First_Formal (Nam);
      while Present (F) loop
         if No (A) and then Needs_No_Actuals (Nam) then
            null;

         --  If we have an error in any actual or formal, indicated by
         --  a type of Any_Type, then abandon resolution attempt, and
         --  set result type to Any_Type.

         elsif (Present (A) and then Etype (A) = Any_Type)
           or else Etype (F) = Any_Type
         then
            Set_Etype (N, Any_Type);
            return;
         end if;

         --  Case where actual is present

         --  If the actual is an entity, generate a reference to it now. We
         --  do this before the actual is resolved, because a formal of some
         --  protected subprogram, or a task discriminant, will be rewritten
         --  during expansion, and the reference to the source entity may
         --  be lost.

         if Present (A)
           and then Is_Entity_Name (A)
           and then Comes_From_Source (N)
         then
            Orig_A := Entity (A);

            if Present (Orig_A) then
               if Is_Formal (Orig_A)
                 and then Ekind (F) /= E_In_Parameter
               then
                  Generate_Reference (Orig_A, A, 'm');
               elsif not Is_Overloaded (A) then
                  Generate_Reference (Orig_A, A);
               end if;
            end if;
         end if;

         if Present (A)
           and then (Nkind (Parent (A)) /= N_Parameter_Association
                       or else
                     Chars (Selector_Name (Parent (A))) = Chars (F))
         then
            --  If style checking mode on, check match of formal name

            if Style_Check then
               if Nkind (Parent (A)) = N_Parameter_Association then
                  Check_Identifier (Selector_Name (Parent (A)), F);
               end if;
            end if;

            --  If the formal is Out or In_Out, do not resolve and expand the
            --  conversion, because it is subsequently expanded into explicit
            --  temporaries and assignments. However, the object of the
            --  conversion can be resolved. An exception is the case of tagged
            --  type conversion with a class-wide actual. In that case we want
            --  the tag check to occur and no temporary will be needed (no
            --  representation change can occur) and the parameter is passed by
            --  reference, so we go ahead and resolve the type conversion.
            --  Another exception is the case of reference to component or
            --  subcomponent of a bit-packed array, in which case we want to
            --  defer expansion to the point the in and out assignments are
            --  performed.

            if Ekind (F) /= E_In_Parameter
              and then Nkind (A) = N_Type_Conversion
              and then not Is_Class_Wide_Type (Etype (Expression (A)))
            then
               if Ekind (F) = E_In_Out_Parameter
                 and then Is_Array_Type (Etype (F))
               then
                  if Has_Aliased_Components (Etype (Expression (A)))
                    /= Has_Aliased_Components (Etype (F))
                  then

                     --  In a view conversion, the conversion must be legal in
                     --  both directions, and thus both component types must be
                     --  aliased, or neither (4.6 (8)).

                     --  The additional rule 4.6 (24.9.2) seems unduly
                     --  restrictive: the privacy requirement should not
                     --  apply to generic types, and should be checked in
                     --  an instance. ARG query is in order.

                     Error_Msg_N
                       ("both component types in a view conversion must be"
                         & " aliased, or neither", A);

                  elsif
                     not Same_Ancestor (Etype (F), Etype (Expression (A)))
                  then
                     if Is_By_Reference_Type (Etype (F))
                        or else Is_By_Reference_Type (Etype (Expression (A)))
                     then
                        Error_Msg_N
                          ("view conversion between unrelated by reference " &
                           "array types not allowed (\'A'I-00246)", A);
                     else
                        declare
                           Comp_Type : constant Entity_Id :=
                                         Component_Type
                                           (Etype (Expression (A)));
                        begin
                           if Comes_From_Source (A)
                             and then Ada_Version >= Ada_05
                             and then
                               ((Is_Private_Type (Comp_Type)
                                   and then not Is_Generic_Type (Comp_Type))
                                 or else Is_Tagged_Type (Comp_Type)
                                 or else Is_Volatile (Comp_Type))
                           then
                              Error_Msg_N
                                ("component type of a view conversion cannot"
                                   & " be private, tagged, or volatile"
                                   & " (RM 4.6 (24))",
                                   Expression (A));
                           end if;
                        end;
                     end if;
                  end if;
               end if;

               if (Conversion_OK (A)
                     or else Valid_Conversion (A, Etype (A), Expression (A)))
                 and then not Is_Ref_To_Bit_Packed_Array (Expression (A))
               then
                  Resolve (Expression (A));
               end if;

            --  If the actual is a function call that returns a limited
            --  unconstrained object that needs finalization, create a
            --  transient scope for it, so that it can receive the proper
            --  finalization list.

            elsif Nkind (A) = N_Function_Call
              and then Is_Limited_Record (Etype (F))
              and then not Is_Constrained (Etype (F))
              and then Expander_Active
              and then
                (Is_Controlled (Etype (F)) or else Has_Task (Etype (F)))
            then
               Establish_Transient_Scope (A, False);

            else
               if Nkind (A) = N_Type_Conversion
                 and then Is_Array_Type (Etype (F))
                 and then not Same_Ancestor (Etype (F), Etype (Expression (A)))
                 and then
                  (Is_Limited_Type (Etype (F))
                     or else Is_Limited_Type (Etype (Expression (A))))
               then
                  Error_Msg_N
                    ("conversion between unrelated limited array types " &
                     "not allowed (\A\I-00246)", A);

                  if Is_Limited_Type (Etype (F)) then
                     Explain_Limited_Type (Etype (F), A);
                  end if;

                  if Is_Limited_Type (Etype (Expression (A))) then
                     Explain_Limited_Type (Etype (Expression (A)), A);
                  end if;
               end if;

               --  (Ada 2005: AI-251): If the actual is an allocator whose
               --  directly designated type is a class-wide interface, we build
               --  an anonymous access type to use it as the type of the
               --  allocator. Later, when the subprogram call is expanded, if
               --  the interface has a secondary dispatch table the expander
               --  will add a type conversion to force the correct displacement
               --  of the pointer.

               if Nkind (A) = N_Allocator then
                  declare
                     DDT : constant Entity_Id :=
                             Directly_Designated_Type (Base_Type (Etype (F)));

                     New_Itype : Entity_Id;

                  begin
                     if Is_Class_Wide_Type (DDT)
                       and then Is_Interface (DDT)
                     then
                        New_Itype := Create_Itype (E_Anonymous_Access_Type, A);
                        Set_Etype (New_Itype, Etype (A));
                        Set_Directly_Designated_Type (New_Itype,
                          Directly_Designated_Type (Etype (A)));
                        Set_Etype (A, New_Itype);
                     end if;

                     --  Ada 2005, AI-162:If the actual is an allocator, the
                     --  innermost enclosing statement is the master of the
                     --  created object. This needs to be done with expansion
                     --  enabled only, otherwise the transient scope will not
                     --  be removed in the expansion of the wrapped construct.

                     if (Is_Controlled (DDT) or else Has_Task (DDT))
                       and then Expander_Active
                     then
                        Establish_Transient_Scope (A, False);
                     end if;
                  end;
               end if;

               --  (Ada 2005): The call may be to a primitive operation of
               --   a tagged synchronized type, declared outside of the type.
               --   In this case the controlling actual must be converted to
               --   its corresponding record type, which is the formal type.
               --   The actual may be a subtype, either because of a constraint
               --   or because it is a generic actual, so use base type to
               --   locate concurrent type.

               A_Typ := Base_Type (Etype (A));
               F_Typ := Base_Type (Etype (F));

               declare
                  Full_A_Typ : Entity_Id;

               begin
                  if Present (Full_View (A_Typ)) then
                     Full_A_Typ := Base_Type (Full_View (A_Typ));
                  else
                     Full_A_Typ := A_Typ;
                  end if;

                  --  Tagged synchronized type (case 1): the actual is a
                  --  concurrent type

                  if Is_Concurrent_Type (A_Typ)
                    and then Corresponding_Record_Type (A_Typ) = F_Typ
                  then
                     Rewrite (A,
                       Unchecked_Convert_To
                         (Corresponding_Record_Type (A_Typ), A));
                     Resolve (A, Etype (F));

                  --  Tagged synchronized type (case 2): the formal is a
                  --  concurrent type

                  elsif Ekind (Full_A_Typ) = E_Record_Type
                    and then Present
                               (Corresponding_Concurrent_Type (Full_A_Typ))
                    and then Is_Concurrent_Type (F_Typ)
                    and then Present (Corresponding_Record_Type (F_Typ))
                    and then Full_A_Typ = Corresponding_Record_Type (F_Typ)
                  then
                     Resolve (A, Corresponding_Record_Type (F_Typ));

                  --  Common case

                  else
                     Resolve (A, Etype (F));
                  end if;
               end;
            end if;

            A_Typ := Etype (A);
            F_Typ := Etype (F);

            --  For mode IN, if actual is an entity, and the type of the formal
            --  has warnings suppressed, then we reset Never_Set_In_Source for
            --  the calling entity. The reason for this is to catch cases like
            --  GNAT.Spitbol.Patterns.Vstring_Var where the called subprogram
            --  uses trickery to modify an IN parameter.

            if Ekind (F) = E_In_Parameter
              and then Is_Entity_Name (A)
              and then Present (Entity (A))
              and then Ekind (Entity (A)) = E_Variable
              and then Has_Warnings_Off (F_Typ)
            then
               Set_Never_Set_In_Source (Entity (A), False);
            end if;

            --  Perform error checks for IN and IN OUT parameters

            if Ekind (F) /= E_Out_Parameter then

               --  Check unset reference. For scalar parameters, it is clearly
               --  wrong to pass an uninitialized value as either an IN or
               --  IN-OUT parameter. For composites, it is also clearly an
               --  error to pass a completely uninitialized value as an IN
               --  parameter, but the case of IN OUT is trickier. We prefer
               --  not to give a warning here. For example, suppose there is
               --  a routine that sets some component of a record to False.
               --  It is perfectly reasonable to make this IN-OUT and allow
               --  either initialized or uninitialized records to be passed
               --  in this case.

               --  For partially initialized composite values, we also avoid
               --  warnings, since it is quite likely that we are passing a
               --  partially initialized value and only the initialized fields
               --  will in fact be read in the subprogram.

               if Is_Scalar_Type (A_Typ)
                 or else (Ekind (F) = E_In_Parameter
                            and then not Is_Partially_Initialized_Type (A_Typ))
               then
                  Check_Unset_Reference (A);
               end if;

               --  In Ada 83 we cannot pass an OUT parameter as an IN or IN OUT
               --  actual to a nested call, since this is case of reading an
               --  out parameter, which is not allowed.

               if Ada_Version = Ada_83
                 and then Is_Entity_Name (A)
                 and then Ekind (Entity (A)) = E_Out_Parameter
               then
                  Error_Msg_N ("(Ada 83) illegal reading of out parameter", A);
               end if;
            end if;

            --  Case of OUT or IN OUT parameter

            if Ekind (F) /= E_In_Parameter then

               --  For an Out parameter, check for useless assignment. Note
               --  that we can't set Last_Assignment this early, because we may
               --  kill current values in Resolve_Call, and that call would
               --  clobber the Last_Assignment field.

               --  Note: call Warn_On_Useless_Assignment before doing the check
               --  below for Is_OK_Variable_For_Out_Formal so that the setting
               --  of Referenced_As_LHS/Referenced_As_Out_Formal properly
               --  reflects the last assignment, not this one!

               if Ekind (F) = E_Out_Parameter then
                  if Warn_On_Modified_As_Out_Parameter (F)
                    and then Is_Entity_Name (A)
                    and then Present (Entity (A))
                    and then Comes_From_Source (N)
                  then
                     Warn_On_Useless_Assignment (Entity (A), A);
                  end if;
               end if;

               --  Validate the form of the actual. Note that the call to
               --  Is_OK_Variable_For_Out_Formal generates the required
               --  reference in this case.

               if not Is_OK_Variable_For_Out_Formal (A) then
                  Error_Msg_NE ("actual for& must be a variable", A, F);
               end if;

               --  What's the following about???

               if Is_Entity_Name (A) then
                  Kill_Checks (Entity (A));
               else
                  Kill_All_Checks;
               end if;
            end if;

            if Etype (A) = Any_Type then
               Set_Etype (N, Any_Type);
               return;
            end if;

            --  Apply appropriate range checks for in, out, and in-out
            --  parameters. Out and in-out parameters also need a separate
            --  check, if there is a type conversion, to make sure the return
            --  value meets the constraints of the variable before the
            --  conversion.

            --  Gigi looks at the check flag and uses the appropriate types.
            --  For now since one flag is used there is an optimization which
            --  might not be done in the In Out case since Gigi does not do
            --  any analysis. More thought required about this ???

            if Ekind (F) = E_In_Parameter
              or else Ekind (F) = E_In_Out_Parameter
            then
               if Is_Scalar_Type (Etype (A)) then
                  Apply_Scalar_Range_Check (A, F_Typ);

               elsif Is_Array_Type (Etype (A)) then
                  Apply_Length_Check (A, F_Typ);

               elsif Is_Record_Type (F_Typ)
                 and then Has_Discriminants (F_Typ)
                 and then Is_Constrained (F_Typ)
                 and then (not Is_Derived_Type (F_Typ)
                             or else Comes_From_Source (Nam))
               then
                  Apply_Discriminant_Check (A, F_Typ);

               elsif Is_Access_Type (F_Typ)
                 and then Is_Array_Type (Designated_Type (F_Typ))
                 and then Is_Constrained (Designated_Type (F_Typ))
               then
                  Apply_Length_Check (A, F_Typ);

               elsif Is_Access_Type (F_Typ)
                 and then Has_Discriminants (Designated_Type (F_Typ))
                 and then Is_Constrained (Designated_Type (F_Typ))
               then
                  Apply_Discriminant_Check (A, F_Typ);

               else
                  Apply_Range_Check (A, F_Typ);
               end if;

               --  Ada 2005 (AI-231)

               if Ada_Version >= Ada_05
                 and then Is_Access_Type (F_Typ)
                 and then Can_Never_Be_Null (F_Typ)
                 and then Known_Null (A)
               then
                  Apply_Compile_Time_Constraint_Error
                    (N      => A,
                     Msg    => "(Ada 2005) null not allowed in "
                               & "null-excluding formal?",
                     Reason => CE_Null_Not_Allowed);
               end if;
            end if;

            if Ekind (F) = E_Out_Parameter
              or else Ekind (F) = E_In_Out_Parameter
            then
               if Nkind (A) = N_Type_Conversion then
                  if Is_Scalar_Type (A_Typ) then
                     Apply_Scalar_Range_Check
                       (Expression (A), Etype (Expression (A)), A_Typ);
                  else
                     Apply_Range_Check
                       (Expression (A), Etype (Expression (A)), A_Typ);
                  end if;

               else
                  if Is_Scalar_Type (F_Typ) then
                     Apply_Scalar_Range_Check (A, A_Typ, F_Typ);

                  elsif Is_Array_Type (F_Typ)
                    and then Ekind (F) = E_Out_Parameter
                  then
                     Apply_Length_Check (A, F_Typ);

                  else
                     Apply_Range_Check (A, A_Typ, F_Typ);
                  end if;
               end if;
            end if;

            --  An actual associated with an access parameter is implicitly
            --  converted to the anonymous access type of the formal and must
            --  satisfy the legality checks for access conversions.

            if Ekind (F_Typ) = E_Anonymous_Access_Type then
               if not Valid_Conversion (A, F_Typ, A) then
                  Error_Msg_N
                    ("invalid implicit conversion for access parameter", A);
               end if;
            end if;

            --  Check bad case of atomic/volatile argument (RM C.6(12))

            if Is_By_Reference_Type (Etype (F))
              and then Comes_From_Source (N)
            then
               if Is_Atomic_Object (A)
                 and then not Is_Atomic (Etype (F))
               then
                  Error_Msg_N
                    ("cannot pass atomic argument to non-atomic formal",
                     N);

               elsif Is_Volatile_Object (A)
                 and then not Is_Volatile (Etype (F))
               then
                  Error_Msg_N
                    ("cannot pass volatile argument to non-volatile formal",
                     N);
               end if;
            end if;

            --  Check that subprograms don't have improper controlling
            --  arguments (RM 3.9.2 (9))

            --  A primitive operation may have an access parameter of an
            --  incomplete tagged type, but a dispatching call is illegal
            --  if the type is still incomplete.

            if Is_Controlling_Formal (F) then
               Set_Is_Controlling_Actual (A);

               if Ekind (Etype (F)) = E_Anonymous_Access_Type then
                  declare
                     Desig : constant Entity_Id := Designated_Type (Etype (F));
                  begin
                     if Ekind (Desig) = E_Incomplete_Type
                       and then No (Full_View (Desig))
                       and then No (Non_Limited_View (Desig))
                     then
                        Error_Msg_NE
                          ("premature use of incomplete type& " &
                           "in dispatching call", A, Desig);
                     end if;
                  end;
               end if;

            elsif Nkind (A) = N_Explicit_Dereference then
               Validate_Remote_Access_To_Class_Wide_Type (A);
            end if;

            if (Is_Class_Wide_Type (A_Typ) or else Is_Dynamically_Tagged (A))
              and then not Is_Class_Wide_Type (F_Typ)
              and then not Is_Controlling_Formal (F)
            then
               Error_Msg_N ("class-wide argument not allowed here!", A);

               if Is_Subprogram (Nam)
                 and then Comes_From_Source (Nam)
               then
                  Error_Msg_Node_2 := F_Typ;
                  Error_Msg_NE
                    ("& is not a dispatching operation of &!", A, Nam);
               end if;

            elsif Is_Access_Type (A_Typ)
              and then Is_Access_Type (F_Typ)
              and then Ekind (F_Typ) /= E_Access_Subprogram_Type
              and then Ekind (F_Typ) /= E_Anonymous_Access_Subprogram_Type
              and then (Is_Class_Wide_Type (Designated_Type (A_Typ))
                         or else (Nkind (A) = N_Attribute_Reference
                                   and then
                                  Is_Class_Wide_Type (Etype (Prefix (A)))))
              and then not Is_Class_Wide_Type (Designated_Type (F_Typ))
              and then not Is_Controlling_Formal (F)
            then
               Error_Msg_N
                 ("access to class-wide argument not allowed here!", A);

               if Is_Subprogram (Nam)
                 and then Comes_From_Source (Nam)
               then
                  Error_Msg_Node_2 := Designated_Type (F_Typ);
                  Error_Msg_NE
                    ("& is not a dispatching operation of &!", A, Nam);
               end if;
            end if;

            Eval_Actual (A);

            --  If it is a named association, treat the selector_name as
            --  a proper identifier, and mark the corresponding entity.

            if Nkind (Parent (A)) = N_Parameter_Association then
               Set_Entity (Selector_Name (Parent (A)), F);
               Generate_Reference (F, Selector_Name (Parent (A)));
               Set_Etype (Selector_Name (Parent (A)), F_Typ);
               Generate_Reference (F_Typ, N, ' ');
            end if;

            Prev := A;

            if Ekind (F) /= E_Out_Parameter then
               Check_Unset_Reference (A);
            end if;

            Next_Actual (A);

         --  Case where actual is not present

         else
            Insert_Default;
         end if;

         Next_Formal (F);
      end loop;
   end Resolve_Actuals;

   -----------------------
   -- Resolve_Allocator --
   -----------------------

   procedure Resolve_Allocator (N : Node_Id; Typ : Entity_Id) is
      E        : constant Node_Id := Expression (N);
      Subtyp   : Entity_Id;
      Discrim  : Entity_Id;
      Constr   : Node_Id;
      Aggr     : Node_Id;
      Assoc    : Node_Id := Empty;
      Disc_Exp : Node_Id;

      procedure Check_Allocator_Discrim_Accessibility
        (Disc_Exp  : Node_Id;
         Alloc_Typ : Entity_Id);
      --  Check that accessibility level associated with an access discriminant
      --  initialized in an allocator by the expression Disc_Exp is not deeper
      --  than the level of the allocator type Alloc_Typ. An error message is
      --  issued if this condition is violated. Specialized checks are done for
      --  the cases of a constraint expression which is an access attribute or
      --  an access discriminant.

      function In_Dispatching_Context return Boolean;
      --  If the allocator is an actual in a call, it is allowed to be class-
      --  wide when the context is not because it is a controlling actual.

      procedure Propagate_Coextensions (Root : Node_Id);
      --  Propagate all nested coextensions which are located one nesting
      --  level down the tree to the node Root. Example:
      --
      --    Top_Record
      --       Level_1_Coextension
      --          Level_2_Coextension
      --
      --  The algorithm is paired with delay actions done by the Expander. In
      --  the above example, assume all coextensions are controlled types.
      --  The cycle of analysis, resolution and expansion will yield:
      --
      --  1) Analyze Top_Record
      --  2) Analyze Level_1_Coextension
      --  3) Analyze Level_2_Coextension
      --  4) Resolve Level_2_Coextension. The allocator is marked as a
      --       coextension.
      --  5) Expand Level_2_Coextension. A temporary variable Temp_1 is
      --       generated to capture the allocated object. Temp_1 is attached
      --       to the coextension chain of Level_2_Coextension.
      --  6) Resolve Level_1_Coextension. The allocator is marked as a
      --       coextension. A forward tree traversal is performed which finds
      --       Level_2_Coextension's list and copies its contents into its
      --       own list.
      --  7) Expand Level_1_Coextension. A temporary variable Temp_2 is
      --       generated to capture the allocated object. Temp_2 is attached
      --       to the coextension chain of Level_1_Coextension. Currently, the
      --       contents of the list are [Temp_2, Temp_1].
      --  8) Resolve Top_Record. A forward tree traversal is performed which
      --       finds Level_1_Coextension's list and copies its contents into
      --       its own list.
      --  9) Expand Top_Record. Generate finalization calls for Temp_1 and
      --       Temp_2 and attach them to Top_Record's finalization list.

      -------------------------------------------
      -- Check_Allocator_Discrim_Accessibility --
      -------------------------------------------

      procedure Check_Allocator_Discrim_Accessibility
        (Disc_Exp  : Node_Id;
         Alloc_Typ : Entity_Id)
      is
      begin
         if Type_Access_Level (Etype (Disc_Exp)) >
            Type_Access_Level (Alloc_Typ)
         then
            Error_Msg_N
              ("operand type has deeper level than allocator type", Disc_Exp);

         --  When the expression is an Access attribute the level of the prefix
         --  object must not be deeper than that of the allocator's type.

         elsif Nkind (Disc_Exp) = N_Attribute_Reference
           and then Get_Attribute_Id (Attribute_Name (Disc_Exp))
                      = Attribute_Access
           and then Object_Access_Level (Prefix (Disc_Exp))
                      > Type_Access_Level (Alloc_Typ)
         then
            Error_Msg_N
              ("prefix of attribute has deeper level than allocator type",
               Disc_Exp);

         --  When the expression is an access discriminant the check is against
         --  the level of the prefix object.

         elsif Ekind (Etype (Disc_Exp)) = E_Anonymous_Access_Type
           and then Nkind (Disc_Exp) = N_Selected_Component
           and then Object_Access_Level (Prefix (Disc_Exp))
                      > Type_Access_Level (Alloc_Typ)
         then
            Error_Msg_N
              ("access discriminant has deeper level than allocator type",
               Disc_Exp);

         --  All other cases are legal

         else
            null;
         end if;
      end Check_Allocator_Discrim_Accessibility;

      ----------------------------
      -- In_Dispatching_Context --
      ----------------------------

      function In_Dispatching_Context return Boolean is
         Par : constant Node_Id := Parent (N);
      begin
         return Nkind_In (Par, N_Function_Call, N_Procedure_Call_Statement)
           and then Is_Entity_Name (Name (Par))
           and then Is_Dispatching_Operation (Entity (Name (Par)));
      end In_Dispatching_Context;

      ----------------------------
      -- Propagate_Coextensions --
      ----------------------------

      procedure Propagate_Coextensions (Root : Node_Id) is

         procedure Copy_List (From : Elist_Id; To : Elist_Id);
         --  Copy the contents of list From into list To, preserving the
         --  order of elements.

         function Process_Allocator (Nod : Node_Id) return Traverse_Result;
         --  Recognize an allocator or a rewritten allocator node and add it
         --  along with its nested coextensions to the list of Root.

         ---------------
         -- Copy_List --
         ---------------

         procedure Copy_List (From : Elist_Id; To : Elist_Id) is
            From_Elmt : Elmt_Id;
         begin
            From_Elmt := First_Elmt (From);
            while Present (From_Elmt) loop
               Append_Elmt (Node (From_Elmt), To);
               Next_Elmt (From_Elmt);
            end loop;
         end Copy_List;

         -----------------------
         -- Process_Allocator --
         -----------------------

         function Process_Allocator (Nod : Node_Id) return Traverse_Result is
            Orig_Nod : Node_Id := Nod;

         begin
            --  This is a possible rewritten subtype indication allocator. Any
            --  nested coextensions will appear as discriminant constraints.

            if Nkind (Nod) = N_Identifier
              and then Present (Original_Node (Nod))
              and then Nkind (Original_Node (Nod)) = N_Subtype_Indication
            then
               declare
                  Discr      : Node_Id;
                  Discr_Elmt : Elmt_Id;

               begin
                  if Is_Record_Type (Entity (Nod)) then
                     Discr_Elmt :=
                       First_Elmt (Discriminant_Constraint (Entity (Nod)));
                     while Present (Discr_Elmt) loop
                        Discr := Node (Discr_Elmt);

                        if Nkind (Discr) = N_Identifier
                          and then Present (Original_Node (Discr))
                          and then Nkind (Original_Node (Discr)) = N_Allocator
                          and then Present (Coextensions (
                                     Original_Node (Discr)))
                        then
                           if No (Coextensions (Root)) then
                              Set_Coextensions (Root, New_Elmt_List);
                           end if;

                           Copy_List
                             (From => Coextensions (Original_Node (Discr)),
                              To   => Coextensions (Root));
                        end if;

                        Next_Elmt (Discr_Elmt);
                     end loop;

                     --  There is no need to continue the traversal of this
                     --  subtree since all the information has already been
                     --  propagated.

                     return Skip;
                  end if;
               end;

            --  Case of either a stand alone allocator or a rewritten allocator
            --  with an aggregate.

            else
               if Present (Original_Node (Nod)) then
                  Orig_Nod := Original_Node (Nod);
               end if;

               if Nkind (Orig_Nod) = N_Allocator then

                  --  Propagate the list of nested coextensions to the Root
                  --  allocator. This is done through list copy since a single
                  --  allocator may have multiple coextensions. Do not touch
                  --  coextensions roots.

                  if not Is_Coextension_Root (Orig_Nod)
                    and then Present (Coextensions (Orig_Nod))
                  then
                     if No (Coextensions (Root)) then
                        Set_Coextensions (Root, New_Elmt_List);
                     end if;

                     Copy_List
                       (From => Coextensions (Orig_Nod),
                        To   => Coextensions (Root));
                  end if;

                  --  There is no need to continue the traversal of this
                  --  subtree since all the information has already been
                  --  propagated.

                  return Skip;
               end if;
            end if;

            --  Keep on traversing, looking for the next allocator

            return OK;
         end Process_Allocator;

         procedure Process_Allocators is
           new Traverse_Proc (Process_Allocator);

      --  Start of processing for Propagate_Coextensions

      begin
         Process_Allocators (Expression (Root));
      end Propagate_Coextensions;

   --  Start of processing for Resolve_Allocator

   begin
      --  Replace general access with specific type

      if Ekind (Etype (N)) = E_Allocator_Type then
         Set_Etype (N, Base_Type (Typ));
      end if;

      if Is_Abstract_Type (Typ) then
         Error_Msg_N ("type of allocator cannot be abstract",  N);
      end if;

      --  For qualified expression, resolve the expression using the
      --  given subtype (nothing to do for type mark, subtype indication)

      if Nkind (E) = N_Qualified_Expression then
         if Is_Class_Wide_Type (Etype (E))
           and then not Is_Class_Wide_Type (Designated_Type (Typ))
           and then not In_Dispatching_Context
         then
            Error_Msg_N
              ("class-wide allocator not allowed for this access type", N);
         end if;

         Resolve (Expression (E), Etype (E));
         Check_Unset_Reference (Expression (E));

         --  A qualified expression requires an exact match of the type,
         --  class-wide matching is not allowed.

         if (Is_Class_Wide_Type (Etype (Expression (E)))
              or else Is_Class_Wide_Type (Etype (E)))
           and then Base_Type (Etype (Expression (E))) /= Base_Type (Etype (E))
         then
            Wrong_Type (Expression (E), Etype (E));
         end if;

         --  A special accessibility check is needed for allocators that
         --  constrain access discriminants. The level of the type of the
         --  expression used to constrain an access discriminant cannot be
         --  deeper than the type of the allocator (in contrast to access
         --  parameters, where the level of the actual can be arbitrary).

         --  We can't use Valid_Conversion to perform this check because
         --  in general the type of the allocator is unrelated to the type
         --  of the access discriminant.

         if Ekind (Typ) /= E_Anonymous_Access_Type
           or else Is_Local_Anonymous_Access (Typ)
         then
            Subtyp := Entity (Subtype_Mark (E));

            Aggr := Original_Node (Expression (E));

            if Has_Discriminants (Subtyp)
              and then Nkind_In (Aggr, N_Aggregate, N_Extension_Aggregate)
            then
               Discrim := First_Discriminant (Base_Type (Subtyp));

               --  Get the first component expression of the aggregate

               if Present (Expressions (Aggr)) then
                  Disc_Exp := First (Expressions (Aggr));

               elsif Present (Component_Associations (Aggr)) then
                  Assoc := First (Component_Associations (Aggr));

                  if Present (Assoc) then
                     Disc_Exp := Expression (Assoc);
                  else
                     Disc_Exp := Empty;
                  end if;

               else
                  Disc_Exp := Empty;
               end if;

               while Present (Discrim) and then Present (Disc_Exp) loop
                  if Ekind (Etype (Discrim)) = E_Anonymous_Access_Type then
                     Check_Allocator_Discrim_Accessibility (Disc_Exp, Typ);
                  end if;

                  Next_Discriminant (Discrim);

                  if Present (Discrim) then
                     if Present (Assoc) then
                        Next (Assoc);
                        Disc_Exp := Expression (Assoc);

                     elsif Present (Next (Disc_Exp)) then
                        Next (Disc_Exp);

                     else
                        Assoc := First (Component_Associations (Aggr));

                        if Present (Assoc) then
                           Disc_Exp := Expression (Assoc);
                        else
                           Disc_Exp := Empty;
                        end if;
                     end if;
                  end if;
               end loop;
            end if;
         end if;

      --  For a subtype mark or subtype indication, freeze the subtype

      else
         Freeze_Expression (E);

         if Is_Access_Constant (Typ) and then not No_Initialization (N) then
            Error_Msg_N
              ("initialization required for access-to-constant allocator", N);
         end if;

         --  A special accessibility check is needed for allocators that
         --  constrain access discriminants. The level of the type of the
         --  expression used to constrain an access discriminant cannot be
         --  deeper than the type of the allocator (in contrast to access
         --  parameters, where the level of the actual can be arbitrary).
         --  We can't use Valid_Conversion to perform this check because
         --  in general the type of the allocator is unrelated to the type
         --  of the access discriminant.

         if Nkind (Original_Node (E)) = N_Subtype_Indication
           and then (Ekind (Typ) /= E_Anonymous_Access_Type
                      or else Is_Local_Anonymous_Access (Typ))
         then
            Subtyp := Entity (Subtype_Mark (Original_Node (E)));

            if Has_Discriminants (Subtyp) then
               Discrim := First_Discriminant (Base_Type (Subtyp));
               Constr := First (Constraints (Constraint (Original_Node (E))));
               while Present (Discrim) and then Present (Constr) loop
                  if Ekind (Etype (Discrim)) = E_Anonymous_Access_Type then
                     if Nkind (Constr) = N_Discriminant_Association then
                        Disc_Exp := Original_Node (Expression (Constr));
                     else
                        Disc_Exp := Original_Node (Constr);
                     end if;

                     Check_Allocator_Discrim_Accessibility (Disc_Exp, Typ);
                  end if;

                  Next_Discriminant (Discrim);
                  Next (Constr);
               end loop;
            end if;
         end if;
      end if;

      --  Ada 2005 (AI-344): A class-wide allocator requires an accessibility
      --  check that the level of the type of the created object is not deeper
      --  than the level of the allocator's access type, since extensions can
      --  now occur at deeper levels than their ancestor types. This is a
      --  static accessibility level check; a run-time check is also needed in
      --  the case of an initialized allocator with a class-wide argument (see
      --  Expand_Allocator_Expression).

      if Ada_Version >= Ada_05
        and then Is_Class_Wide_Type (Designated_Type (Typ))
      then
         declare
            Exp_Typ : Entity_Id;

         begin
            if Nkind (E) = N_Qualified_Expression then
               Exp_Typ := Etype (E);
            elsif Nkind (E) = N_Subtype_Indication then
               Exp_Typ := Entity (Subtype_Mark (Original_Node (E)));
            else
               Exp_Typ := Entity (E);
            end if;

            if Type_Access_Level (Exp_Typ) > Type_Access_Level (Typ) then
               if In_Instance_Body then
                  Error_Msg_N ("?type in allocator has deeper level than" &
                               " designated class-wide type", E);
                  Error_Msg_N ("\?Program_Error will be raised at run time",
                               E);
                  Rewrite (N,
                    Make_Raise_Program_Error (Sloc (N),
                      Reason => PE_Accessibility_Check_Failed));
                  Set_Etype (N, Typ);

               --  Do not apply Ada 2005 accessibility checks on a class-wide
               --  allocator if the type given in the allocator is a formal
               --  type. A run-time check will be performed in the instance.

               elsif not Is_Generic_Type (Exp_Typ) then
                  Error_Msg_N ("type in allocator has deeper level than" &
                               " designated class-wide type", E);
               end if;
            end if;
         end;
      end if;

      --  Check for allocation from an empty storage pool

      if No_Pool_Assigned (Typ) then
         declare
            Loc : constant Source_Ptr := Sloc (N);
         begin
            Error_Msg_N ("?allocation from empty storage pool!", N);
            Error_Msg_N ("\?Storage_Error will be raised at run time!", N);
            Insert_Action (N,
              Make_Raise_Storage_Error (Loc,
                Reason => SE_Empty_Storage_Pool));
         end;

      --  If the context is an unchecked conversion, as may happen within
      --  an inlined subprogram, the allocator is being resolved with its
      --  own anonymous type. In that case, if the target type has a specific
      --  storage pool, it must be inherited explicitly by the allocator type.

      elsif Nkind (Parent (N)) = N_Unchecked_Type_Conversion
        and then No (Associated_Storage_Pool (Typ))
      then
         Set_Associated_Storage_Pool
           (Typ, Associated_Storage_Pool (Etype (Parent (N))));
      end if;

      --  An erroneous allocator may be rewritten as a raise Program_Error
      --  statement.

      if Nkind (N) = N_Allocator then

         --  An anonymous access discriminant is the definition of a
         --  coextension.

         if Ekind (Typ) = E_Anonymous_Access_Type
           and then Nkind (Associated_Node_For_Itype (Typ)) =
                      N_Discriminant_Specification
         then
            --  Avoid marking an allocator as a dynamic coextension if it is
            --  within a static construct.

            if not Is_Static_Coextension (N) then
               Set_Is_Dynamic_Coextension (N);
            end if;

         --  Cleanup for potential static coextensions

         else
            Set_Is_Dynamic_Coextension (N, False);
            Set_Is_Static_Coextension  (N, False);
         end if;

         --  There is no need to propagate any nested coextensions if they
         --  are marked as static since they will be rewritten on the spot.

         if not Is_Static_Coextension (N) then
            Propagate_Coextensions (N);
         end if;
      end if;
   end Resolve_Allocator;

   ---------------------------
   -- Resolve_Arithmetic_Op --
   ---------------------------

   --  Used for resolving all arithmetic operators except exponentiation

   procedure Resolve_Arithmetic_Op (N : Node_Id; Typ : Entity_Id) is
      L   : constant Node_Id := Left_Opnd (N);
      R   : constant Node_Id := Right_Opnd (N);
      TL  : constant Entity_Id := Base_Type (Etype (L));
      TR  : constant Entity_Id := Base_Type (Etype (R));
      T   : Entity_Id;
      Rop : Node_Id;

      B_Typ : constant Entity_Id := Base_Type (Typ);
      --  We do the resolution using the base type, because intermediate values
      --  in expressions always are of the base type, not a subtype of it.

      function Expected_Type_Is_Any_Real (N : Node_Id) return Boolean;
      --  Returns True if N is in a context that expects "any real type"

      function Is_Integer_Or_Universal (N : Node_Id) return Boolean;
      --  Return True iff given type is Integer or universal real/integer

      procedure Set_Mixed_Mode_Operand (N : Node_Id; T : Entity_Id);
      --  Choose type of integer literal in fixed-point operation to conform
      --  to available fixed-point type. T is the type of the other operand,
      --  which is needed to determine the expected type of N.

      procedure Set_Operand_Type (N : Node_Id);
      --  Set operand type to T if universal

      -------------------------------
      -- Expected_Type_Is_Any_Real --
      -------------------------------

      function Expected_Type_Is_Any_Real (N : Node_Id) return Boolean is
      begin
         --  N is the expression after "delta" in a fixed_point_definition;
         --  see RM-3.5.9(6):

         return Nkind_In (Parent (N), N_Ordinary_Fixed_Point_Definition,
                                      N_Decimal_Fixed_Point_Definition,

         --  N is one of the bounds in a real_range_specification;
         --  see RM-3.5.7(5):

                                      N_Real_Range_Specification,

         --  N is the expression of a delta_constraint;
         --  see RM-J.3(3):

                                      N_Delta_Constraint);
      end Expected_Type_Is_Any_Real;

      -----------------------------
      -- Is_Integer_Or_Universal --
      -----------------------------

      function Is_Integer_Or_Universal (N : Node_Id) return Boolean is
         T     : Entity_Id;
         Index : Interp_Index;
         It    : Interp;

      begin
         if not Is_Overloaded (N) then
            T := Etype (N);
            return Base_Type (T) = Base_Type (Standard_Integer)
              or else T = Universal_Integer
              or else T = Universal_Real;
         else
            Get_First_Interp (N, Index, It);
            while Present (It.Typ) loop
               if Base_Type (It.Typ) = Base_Type (Standard_Integer)
                 or else It.Typ = Universal_Integer
                 or else It.Typ = Universal_Real
               then
                  return True;
               end if;

               Get_Next_Interp (Index, It);
            end loop;
         end if;

         return False;
      end Is_Integer_Or_Universal;

      ----------------------------
      -- Set_Mixed_Mode_Operand --
      ----------------------------

      procedure Set_Mixed_Mode_Operand (N : Node_Id; T : Entity_Id) is
         Index : Interp_Index;
         It    : Interp;

      begin
         if Universal_Interpretation (N) = Universal_Integer then

            --  A universal integer literal is resolved as standard integer
            --  except in the case of a fixed-point result, where we leave it
            --  as universal (to be handled by Exp_Fixd later on)

            if Is_Fixed_Point_Type (T) then
               Resolve (N, Universal_Integer);
            else
               Resolve (N, Standard_Integer);
            end if;

         elsif Universal_Interpretation (N) = Universal_Real
           and then (T = Base_Type (Standard_Integer)
                      or else T = Universal_Integer
                      or else T = Universal_Real)
         then
            --  A universal real can appear in a fixed-type context. We resolve
            --  the literal with that context, even though this might raise an
            --  exception prematurely (the other operand may be zero).

            Resolve (N, B_Typ);

         elsif Etype (N) = Base_Type (Standard_Integer)
           and then T = Universal_Real
           and then Is_Overloaded (N)
         then
            --  Integer arg in mixed-mode operation. Resolve with universal
            --  type, in case preference rule must be applied.

            Resolve (N, Universal_Integer);

         elsif Etype (N) = T
           and then B_Typ /= Universal_Fixed
         then
            --  Not a mixed-mode operation, resolve with context

            Resolve (N, B_Typ);

         elsif Etype (N) = Any_Fixed then

            --  N may itself be a mixed-mode operation, so use context type

            Resolve (N, B_Typ);

         elsif Is_Fixed_Point_Type (T)
           and then B_Typ = Universal_Fixed
           and then Is_Overloaded (N)
         then
            --  Must be (fixed * fixed) operation, operand must have one
            --  compatible interpretation.

            Resolve (N, Any_Fixed);

         elsif Is_Fixed_Point_Type (B_Typ)
           and then (T = Universal_Real
                      or else Is_Fixed_Point_Type (T))
           and then Is_Overloaded (N)
         then
            --  C * F(X) in a fixed context, where C is a real literal or a
            --  fixed-point expression. F must have either a fixed type
            --  interpretation or an integer interpretation, but not both.

            Get_First_Interp (N, Index, It);
            while Present (It.Typ) loop
               if Base_Type (It.Typ) = Base_Type (Standard_Integer) then

                  if Analyzed (N) then
                     Error_Msg_N ("ambiguous operand in fixed operation", N);
                  else
                     Resolve (N, Standard_Integer);
                  end if;

               elsif Is_Fixed_Point_Type (It.Typ) then

                  if Analyzed (N) then
                     Error_Msg_N ("ambiguous operand in fixed operation", N);
                  else
                     Resolve (N, It.Typ);
                  end if;
               end if;

               Get_Next_Interp (Index, It);
            end loop;

            --  Reanalyze the literal with the fixed type of the context. If
            --  context is Universal_Fixed, we are within a conversion, leave
            --  the literal as a universal real because there is no usable
            --  fixed type, and the target of the conversion plays no role in
            --  the resolution.

            declare
               Op2 : Node_Id;
               T2  : Entity_Id;

            begin
               if N = L then
                  Op2 := R;
               else
                  Op2 := L;
               end if;

               if B_Typ = Universal_Fixed
                  and then Nkind (Op2) = N_Real_Literal
               then
                  T2 := Universal_Real;
               else
                  T2 := B_Typ;
               end if;

               Set_Analyzed (Op2, False);
               Resolve (Op2, T2);
            end;

         else
            Resolve (N);
         end if;
      end Set_Mixed_Mode_Operand;

      ----------------------
      -- Set_Operand_Type --
      ----------------------

      procedure Set_Operand_Type (N : Node_Id) is
      begin
         if Etype (N) = Universal_Integer
           or else Etype (N) = Universal_Real
         then
            Set_Etype (N, T);
         end if;
      end Set_Operand_Type;

   --  Start of processing for Resolve_Arithmetic_Op

   begin
      if Comes_From_Source (N)
        and then Ekind (Entity (N)) = E_Function
        and then Is_Imported (Entity (N))
        and then Is_Intrinsic_Subprogram (Entity (N))
      then
         Resolve_Intrinsic_Operator (N, Typ);
         return;

      --  Special-case for mixed-mode universal expressions or fixed point
      --  type operation: each argument is resolved separately. The same
      --  treatment is required if one of the operands of a fixed point
      --  operation is universal real, since in this case we don't do a
      --  conversion to a specific fixed-point type (instead the expander
      --  takes care of the case).

      elsif (B_Typ = Universal_Integer or else B_Typ = Universal_Real)
        and then Present (Universal_Interpretation (L))
        and then Present (Universal_Interpretation (R))
      then
         Resolve (L, Universal_Interpretation (L));
         Resolve (R, Universal_Interpretation (R));
         Set_Etype (N, B_Typ);

      elsif (B_Typ = Universal_Real
              or else Etype (N) = Universal_Fixed
              or else (Etype (N) = Any_Fixed
                        and then Is_Fixed_Point_Type (B_Typ))
              or else (Is_Fixed_Point_Type (B_Typ)
                        and then (Is_Integer_Or_Universal (L)
                                   or else
                                  Is_Integer_Or_Universal (R))))
        and then Nkind_In (N, N_Op_Multiply, N_Op_Divide)
      then
         if TL = Universal_Integer or else TR = Universal_Integer then
            Check_For_Visible_Operator (N, B_Typ);
         end if;

         --  If context is a fixed type and one operand is integer, the
         --  other is resolved with the type of the context.

         if Is_Fixed_Point_Type (B_Typ)
           and then (Base_Type (TL) = Base_Type (Standard_Integer)
                      or else TL = Universal_Integer)
         then
            Resolve (R, B_Typ);
            Resolve (L, TL);

         elsif Is_Fixed_Point_Type (B_Typ)
           and then (Base_Type (TR) = Base_Type (Standard_Integer)
                      or else TR = Universal_Integer)
         then
            Resolve (L, B_Typ);
            Resolve (R, TR);

         else
            Set_Mixed_Mode_Operand (L, TR);
            Set_Mixed_Mode_Operand (R, TL);
         end if;

         --  Check the rule in RM05-4.5.5(19.1/2) disallowing universal_fixed
         --  multiplying operators from being used when the expected type is
         --  also universal_fixed. Note that B_Typ will be Universal_Fixed in
         --  some cases where the expected type is actually Any_Real;
         --  Expected_Type_Is_Any_Real takes care of that case.

         if Etype (N) = Universal_Fixed
           or else Etype (N) = Any_Fixed
         then
            if B_Typ = Universal_Fixed
              and then not Expected_Type_Is_Any_Real (N)
              and then not Nkind_In (Parent (N), N_Type_Conversion,
                                                 N_Unchecked_Type_Conversion)
            then
               Error_Msg_N ("type cannot be determined from context!", N);
               Error_Msg_N ("\explicit conversion to result type required", N);

               Set_Etype (L, Any_Type);
               Set_Etype (R, Any_Type);

            else
               if Ada_Version = Ada_83
                 and then Etype (N) = Universal_Fixed
                 and then not
                   Nkind_In (Parent (N), N_Type_Conversion,
                                         N_Unchecked_Type_Conversion)
               then
                  Error_Msg_N
                    ("(Ada 83) fixed-point operation "
                     & "needs explicit conversion", N);
               end if;

               --  The expected type is "any real type" in contexts like
               --    type T is delta <universal_fixed-expression> ...
               --  in which case we need to set the type to Universal_Real
               --  so that static expression evaluation will work properly.

               if Expected_Type_Is_Any_Real (N) then
                  Set_Etype (N, Universal_Real);
               else
                  Set_Etype (N, B_Typ);
               end if;
            end if;

         elsif Is_Fixed_Point_Type (B_Typ)
           and then (Is_Integer_Or_Universal (L)
                       or else Nkind (L) = N_Real_Literal
                       or else Nkind (R) = N_Real_Literal
                       or else Is_Integer_Or_Universal (R))
         then
            Set_Etype (N, B_Typ);

         elsif Etype (N) = Any_Fixed then

            --  If no previous errors, this is only possible if one operand
            --  is overloaded and the context is universal. Resolve as such.

            Set_Etype (N, B_Typ);
         end if;

      else
         if (TL = Universal_Integer or else TL = Universal_Real)
              and then
            (TR = Universal_Integer or else TR = Universal_Real)
         then
            Check_For_Visible_Operator (N, B_Typ);
         end if;

         --  If the context is Universal_Fixed and the operands are also
         --  universal fixed, this is an error, unless there is only one
         --  applicable fixed_point type (usually duration).

         if B_Typ = Universal_Fixed and then Etype (L) = Universal_Fixed then
            T := Unique_Fixed_Point_Type (N);

            if T  = Any_Type then
               Set_Etype (N, T);
               return;
            else
               Resolve (L, T);
               Resolve (R, T);
            end if;

         else
            Resolve (L, B_Typ);
            Resolve (R, B_Typ);
         end if;

         --  If one of the arguments was resolved to a non-universal type.
         --  label the result of the operation itself with the same type.
         --  Do the same for the universal argument, if any.

         T := Intersect_Types (L, R);
         Set_Etype (N, Base_Type (T));
         Set_Operand_Type (L);
         Set_Operand_Type (R);
      end if;

      Generate_Operator_Reference (N, Typ);
      Eval_Arithmetic_Op (N);

      --  Set overflow and division checking bit. Much cleverer code needed
      --  here eventually and perhaps the Resolve routines should be separated
      --  for the various arithmetic operations, since they will need
      --  different processing. ???

      if Nkind (N) in N_Op then
         if not Overflow_Checks_Suppressed (Etype (N)) then
            Enable_Overflow_Check (N);
         end if;

         --  Give warning if explicit division by zero

         if Nkind_In (N, N_Op_Divide, N_Op_Rem, N_Op_Mod)
           and then not Division_Checks_Suppressed (Etype (N))
         then
            Rop := Right_Opnd (N);

            if Compile_Time_Known_Value (Rop)
              and then ((Is_Integer_Type (Etype (Rop))
                           and then Expr_Value (Rop) = Uint_0)
                          or else
                        (Is_Real_Type (Etype (Rop))
                           and then Expr_Value_R (Rop) = Ureal_0))
            then
               --  Specialize the warning message according to the operation

               case Nkind (N) is
                  when N_Op_Divide =>
                     Apply_Compile_Time_Constraint_Error
                       (N, "division by zero?", CE_Divide_By_Zero,
                        Loc => Sloc (Right_Opnd (N)));

                  when N_Op_Rem =>
                     Apply_Compile_Time_Constraint_Error
                       (N, "rem with zero divisor?", CE_Divide_By_Zero,
                        Loc => Sloc (Right_Opnd (N)));

                  when N_Op_Mod =>
                     Apply_Compile_Time_Constraint_Error
                       (N, "mod with zero divisor?", CE_Divide_By_Zero,
                        Loc => Sloc (Right_Opnd (N)));

                  --  Division by zero can only happen with division, rem,
                  --  and mod operations.

                  when others =>
                     raise Program_Error;
               end case;

            --  Otherwise just set the flag to check at run time

            else
               Activate_Division_Check (N);
            end if;
         end if;

         --  If Restriction No_Implicit_Conditionals is active, then it is
         --  violated if either operand can be negative for mod, or for rem
         --  if both operands can be negative.

         if Restrictions.Set (No_Implicit_Conditionals)
           and then Nkind_In (N, N_Op_Rem, N_Op_Mod)
         then
            declare
               Lo : Uint;
               Hi : Uint;
               OK : Boolean;

               LNeg : Boolean;
               RNeg : Boolean;
               --  Set if corresponding operand might be negative

            begin
               Determine_Range (Left_Opnd (N), OK, Lo, Hi);
               LNeg := (not OK) or else Lo < 0;

               Determine_Range (Right_Opnd (N), OK, Lo, Hi);
               RNeg := (not OK) or else Lo < 0;

               if (Nkind (N) = N_Op_Rem and then (LNeg and RNeg))
                    or else
                  (Nkind (N) = N_Op_Mod and then (LNeg or RNeg))
               then
                  Check_Restriction (No_Implicit_Conditionals, N);
               end if;
            end;
         end if;
      end if;

      Check_Unset_Reference (L);
      Check_Unset_Reference (R);
   end Resolve_Arithmetic_Op;

   ------------------
   -- Resolve_Call --
   ------------------

   procedure Resolve_Call (N : Node_Id; Typ : Entity_Id) is
      Loc     : constant Source_Ptr := Sloc (N);
      Subp    : constant Node_Id    := Name (N);
      Nam     : Entity_Id;
      I       : Interp_Index;
      It      : Interp;
      Norm_OK : Boolean;
      Scop    : Entity_Id;
      Rtype   : Entity_Id;

   begin
      --  The context imposes a unique interpretation with type Typ on a
      --  procedure or function call. Find the entity of the subprogram that
      --  yields the expected type, and propagate the corresponding formal
      --  constraints on the actuals. The caller has established that an
      --  interpretation exists, and emitted an error if not unique.

      --  First deal with the case of a call to an access-to-subprogram,
      --  dereference made explicit in Analyze_Call.

      if Ekind (Etype (Subp)) = E_Subprogram_Type then
         if not Is_Overloaded (Subp) then
            Nam := Etype (Subp);

         else
            --  Find the interpretation whose type (a subprogram type) has a
            --  return type that is compatible with the context. Analysis of
            --  the node has established that one exists.

            Nam := Empty;

            Get_First_Interp (Subp,  I, It);
            while Present (It.Typ) loop
               if Covers (Typ, Etype (It.Typ)) then
                  Nam := It.Typ;
                  exit;
               end if;

               Get_Next_Interp (I, It);
            end loop;

            if No (Nam) then
               raise Program_Error;
            end if;
         end if;

         --  If the prefix is not an entity, then resolve it

         if not Is_Entity_Name (Subp) then
            Resolve (Subp, Nam);
         end if;

         --  For an indirect call, we always invalidate checks, since we do not
         --  know whether the subprogram is local or global. Yes we could do
         --  better here, e.g. by knowing that there are no local subprograms,
         --  but it does not seem worth the effort. Similarly, we kill all
         --  knowledge of current constant values.

         Kill_Current_Values;

      --  If this is a procedure call which is really an entry call, do
      --  the conversion of the procedure call to an entry call. Protected
      --  operations use the same circuitry because the name in the call
      --  can be an arbitrary expression with special resolution rules.

      elsif Nkind_In (Subp, N_Selected_Component, N_Indexed_Component)
        or else (Is_Entity_Name (Subp)
                  and then Ekind (Entity (Subp)) = E_Entry)
      then
         Resolve_Entry_Call (N, Typ);
         Check_Elab_Call (N);

         --  Kill checks and constant values, as above for indirect case
         --  Who knows what happens when another task is activated?

         Kill_Current_Values;
         return;

      --  Normal subprogram call with name established in Resolve

      elsif not (Is_Type (Entity (Subp))) then
         Nam := Entity (Subp);
         Set_Entity_With_Style_Check (Subp, Nam);

      --  Otherwise we must have the case of an overloaded call

      else
         pragma Assert (Is_Overloaded (Subp));
         Nam := Empty;  --  We know that it will be assigned in loop below

         Get_First_Interp (Subp,  I, It);
         while Present (It.Typ) loop
            if Covers (Typ, It.Typ) then
               Nam := It.Nam;
               Set_Entity_With_Style_Check (Subp, Nam);
               exit;
            end if;

            Get_Next_Interp (I, It);
         end loop;
      end if;

      --  Check that a call to Current_Task does not occur in an entry body

      if Is_RTE (Nam, RE_Current_Task) then
         declare
            P : Node_Id;

         begin
            P := N;
            loop
               P := Parent (P);

               --  Exclude calls that occur within the default of a formal
               --  parameter of the entry, since those are evaluated outside
               --  of the body.

               exit when No (P) or else Nkind (P) = N_Parameter_Specification;

               if Nkind (P) = N_Entry_Body
                 or else (Nkind (P) = N_Subprogram_Body
                           and then Is_Entry_Barrier_Function (P))
               then
                  Rtype := Etype (N);
                  Error_Msg_NE
                    ("?& should not be used in entry body (RM C.7(17))",
                     N, Nam);
                  Error_Msg_NE
                    ("\Program_Error will be raised at run time?", N, Nam);
                  Rewrite (N,
                    Make_Raise_Program_Error (Loc,
                      Reason => PE_Current_Task_In_Entry_Body));
                  Set_Etype (N, Rtype);
                  return;
               end if;
            end loop;
         end;
      end if;

      --  Check that a procedure call does not occur in the context of the
      --  entry call statement of a conditional or timed entry call. Note that
      --  the case of a call to a subprogram renaming of an entry will also be
      --  rejected. The test for N not being an N_Entry_Call_Statement is
      --  defensive, covering the possibility that the processing of entry
      --  calls might reach this point due to later modifications of the code
      --  above.

      if Nkind (Parent (N)) = N_Entry_Call_Alternative
        and then Nkind (N) /= N_Entry_Call_Statement
        and then Entry_Call_Statement (Parent (N)) = N
      then
         if Ada_Version < Ada_05 then
            Error_Msg_N ("entry call required in select statement", N);

         --  Ada 2005 (AI-345): If a procedure_call_statement is used
         --  for a procedure_or_entry_call, the procedure_name or pro-
         --  cedure_prefix of the procedure_call_statement shall denote
         --  an entry renamed by a procedure, or (a view of) a primitive
         --  subprogram of a limited interface whose first parameter is
         --  a controlling parameter.

         elsif Nkind (N) = N_Procedure_Call_Statement
           and then not Is_Renamed_Entry (Nam)
           and then not Is_Controlling_Limited_Procedure (Nam)
         then
            Error_Msg_N
             ("entry call or dispatching primitive of interface required", N);
         end if;
      end if;

      --  Check that this is not a call to a protected procedure or
      --  entry from within a protected function.

      if Ekind (Current_Scope) = E_Function
        and then Ekind (Scope (Current_Scope)) = E_Protected_Type
        and then Ekind (Nam) /= E_Function
        and then Scope (Nam) = Scope (Current_Scope)
      then
         Error_Msg_N ("within protected function, protected " &
           "object is constant", N);
         Error_Msg_N ("\cannot call operation that may modify it", N);
      end if;

      --  Freeze the subprogram name if not in a spec-expression. Note that we
      --  freeze procedure calls as well as function calls. Procedure calls are
      --  not frozen according to the rules (RM 13.14(14)) because it is
      --  impossible to have a procedure call to a non-frozen procedure in pure
      --  Ada, but in the code that we generate in the expander, this rule
      --  needs extending because we can generate procedure calls that need
      --  freezing.

      if Is_Entity_Name (Subp) and then not In_Spec_Expression then
         Freeze_Expression (Subp);
      end if;

      --  For a predefined operator, the type of the result is the type imposed
      --  by context, except for a predefined operation on universal fixed.
      --  Otherwise The type of the call is the type returned by the subprogram
      --  being called.

      if Is_Predefined_Op (Nam) then
         if Etype (N) /= Universal_Fixed then
            Set_Etype (N, Typ);
         end if;

      --  If the subprogram returns an array type, and the context requires the
      --  component type of that array type, the node is really an indexing of
      --  the parameterless call. Resolve as such. A pathological case occurs
      --  when the type of the component is an access to the array type. In
      --  this case the call is truly ambiguous.

      elsif (Needs_No_Actuals (Nam) or else Needs_One_Actual (Nam))
        and then
          ((Is_Array_Type (Etype (Nam))
                   and then Covers (Typ, Component_Type (Etype (Nam))))
             or else (Is_Access_Type (Etype (Nam))
                        and then Is_Array_Type (Designated_Type (Etype (Nam)))
                        and then
                          Covers (Typ,
                            Component_Type (Designated_Type (Etype (Nam))))))
      then
         declare
            Index_Node : Node_Id;
            New_Subp   : Node_Id;
            Ret_Type   : constant Entity_Id := Etype (Nam);

         begin
            if Is_Access_Type (Ret_Type)
              and then Ret_Type = Component_Type (Designated_Type (Ret_Type))
            then
               Error_Msg_N
                 ("cannot disambiguate function call and indexing", N);
            else
               New_Subp := Relocate_Node (Subp);
               Set_Entity (Subp, Nam);

               if Component_Type (Ret_Type) /= Any_Type then
                  if Needs_No_Actuals (Nam) then

                     --  Indexed call to a parameterless function

                     Index_Node :=
                       Make_Indexed_Component (Loc,
                         Prefix =>
                           Make_Function_Call (Loc,
                             Name => New_Subp),
                         Expressions => Parameter_Associations (N));
                  else
                     --  An Ada 2005 prefixed call to a primitive operation
                     --  whose first parameter is the prefix. This prefix was
                     --  prepended to the parameter list, which is actually a
                     --  list of indices. Remove the prefix in order to build
                     --  the proper indexed component.

                     Index_Node :=
                        Make_Indexed_Component (Loc,
                          Prefix =>
                            Make_Function_Call (Loc,
                               Name => New_Subp,
                               Parameter_Associations =>
                                 New_List
                                   (Remove_Head (Parameter_Associations (N)))),
                           Expressions => Parameter_Associations (N));
                  end if;

                  --  Since we are correcting a node classification error made
                  --  by the parser, we call Replace rather than Rewrite.

                  Replace (N, Index_Node);
                  Set_Etype (Prefix (N), Ret_Type);
                  Set_Etype (N, Typ);
                  Resolve_Indexed_Component (N, Typ);
                  Check_Elab_Call (Prefix (N));
               end if;
            end if;

            return;
         end;

      else
         Set_Etype (N, Etype (Nam));
      end if;

      --  In the case where the call is to an overloaded subprogram, Analyze
      --  calls Normalize_Actuals once per overloaded subprogram. Therefore in
      --  such a case Normalize_Actuals needs to be called once more to order
      --  the actuals correctly. Otherwise the call will have the ordering
      --  given by the last overloaded subprogram whether this is the correct
      --  one being called or not.

      if Is_Overloaded (Subp) then
         Normalize_Actuals (N, Nam, False, Norm_OK);
         pragma Assert (Norm_OK);
      end if;

      --  In any case, call is fully resolved now. Reset Overload flag, to
      --  prevent subsequent overload resolution if node is analyzed again

      Set_Is_Overloaded (Subp, False);
      Set_Is_Overloaded (N, False);

      --  If we are calling the current subprogram from immediately within its
      --  body, then that is the case where we can sometimes detect cases of
      --  infinite recursion statically. Do not try this in case restriction
      --  No_Recursion is in effect anyway, and do it only for source calls.

      if Comes_From_Source (N) then
         Scop := Current_Scope;

         --  Issue warning for possible infinite recursion in the absence
         --  of the No_Recursion restriction.

         if Nam = Scop
           and then not Restriction_Active (No_Recursion)
           and then Check_Infinite_Recursion (N)
         then
            --  Here we detected and flagged an infinite recursion, so we do
            --  not need to test the case below for further warnings. Also if
            --  we now have a raise SE node, we are all done.

            if Nkind (N) = N_Raise_Storage_Error then
               return;
            end if;

         --  If call is to immediately containing subprogram, then check for
         --  the case of a possible run-time detectable infinite recursion.

         else
            Scope_Loop : while Scop /= Standard_Standard loop
               if Nam = Scop then

                  --  Although in general case, recursion is not statically
                  --  checkable, the case of calling an immediately containing
                  --  subprogram is easy to catch.

                  Check_Restriction (No_Recursion, N);

                  --  If the recursive call is to a parameterless subprogram,
                  --  then even if we can't statically detect infinite
                  --  recursion, this is pretty suspicious, and we output a
                  --  warning. Furthermore, we will try later to detect some
                  --  cases here at run time by expanding checking code (see
                  --  Detect_Infinite_Recursion in package Exp_Ch6).

                  --  If the recursive call is within a handler, do not emit a
                  --  warning, because this is a common idiom: loop until input
                  --  is correct, catch illegal input in handler and restart.

                  if No (First_Formal (Nam))
                    and then Etype (Nam) = Standard_Void_Type
                    and then not Error_Posted (N)
                    and then Nkind (Parent (N)) /= N_Exception_Handler
                  then
                     --  For the case of a procedure call. We give the message
                     --  only if the call is the first statement in a sequence
                     --  of statements, or if all previous statements are
                     --  simple assignments. This is simply a heuristic to
                     --  decrease false positives, without losing too many good
                     --  warnings. The idea is that these previous statements
                     --  may affect global variables the procedure depends on.

                     if Nkind (N) = N_Procedure_Call_Statement
                       and then Is_List_Member (N)
                     then
                        declare
                           P : Node_Id;
                        begin
                           P := Prev (N);
                           while Present (P) loop
                              if Nkind (P) /= N_Assignment_Statement then
                                 exit Scope_Loop;
                              end if;

                              Prev (P);
                           end loop;
                        end;
                     end if;

                     --  Do not give warning if we are in a conditional context

                     declare
                        K : constant Node_Kind := Nkind (Parent (N));
                     begin
                        if (K = N_Loop_Statement
                            and then Present (Iteration_Scheme (Parent (N))))
                          or else K = N_If_Statement
                          or else K = N_Elsif_Part
                          or else K = N_Case_Statement_Alternative
                        then
                           exit Scope_Loop;
                        end if;
                     end;

                     --  Here warning is to be issued

                     Set_Has_Recursive_Call (Nam);
                     Error_Msg_N
                       ("?possible infinite recursion!", N);
                     Error_Msg_N
                       ("\?Storage_Error may be raised at run time!", N);
                  end if;

                  exit Scope_Loop;
               end if;

               Scop := Scope (Scop);
            end loop Scope_Loop;
         end if;
      end if;

      --  If subprogram name is a predefined operator, it was given in
      --  functional notation. Replace call node with operator node, so
      --  that actuals can be resolved appropriately.

      if Is_Predefined_Op (Nam) or else Ekind (Nam) = E_Operator then
         Make_Call_Into_Operator (N, Typ, Entity (Name (N)));
         return;

      elsif Present (Alias (Nam))
        and then Is_Predefined_Op (Alias (Nam))
      then
         Resolve_Actuals (N, Nam);
         Make_Call_Into_Operator (N, Typ, Alias (Nam));
         return;
      end if;

      --  Create a transient scope if the resulting type requires it

      --  There are 4 notable exceptions: in init procs, the transient scope
      --  overhead is not needed and even incorrect due to the actual expansion
      --  of adjust calls; the second case is enumeration literal pseudo calls;
      --  the third case is intrinsic subprograms (Unchecked_Conversion and
      --  source information functions) that do not use the secondary stack
      --  even though the return type is unconstrained; the fourth case is a
      --  call to a build-in-place function, since such functions may allocate
      --  their result directly in a target object, and cases where the result
      --  does get allocated in the secondary stack are checked for within the
      --  specialized Exp_Ch6 procedures for expanding build-in-place calls.

      --  If this is an initialization call for a type whose initialization
      --  uses the secondary stack, we also need to create a transient scope
      --  for it, precisely because we will not do it within the init proc
      --  itself.

      --  If the subprogram is marked Inline_Always, then even if it returns
      --  an unconstrained type the call does not require use of the secondary
      --  stack. However, inlining will only take place if the body to inline
      --  is already present. It may not be available if e.g. the subprogram is
      --  declared in a child instance.

      if Is_Inlined (Nam)
        and then Has_Pragma_Inline_Always (Nam)
        and then Nkind (Unit_Declaration_Node (Nam)) = N_Subprogram_Declaration
        and then Present (Body_To_Inline (Unit_Declaration_Node (Nam)))
      then
         null;

      elsif Expander_Active
        and then Is_Type (Etype (Nam))
        and then Requires_Transient_Scope (Etype (Nam))
        and then not Is_Build_In_Place_Function (Nam)
        and then Ekind (Nam) /= E_Enumeration_Literal
        and then not Within_Init_Proc
        and then not Is_Intrinsic_Subprogram (Nam)
      then
         Establish_Transient_Scope (N, Sec_Stack => True);

         --  If the call appears within the bounds of a loop, it will
         --  be rewritten and reanalyzed, nothing left to do here.

         if Nkind (N) /= N_Function_Call then
            return;
         end if;

      elsif Is_Init_Proc (Nam)
        and then not Within_Init_Proc
      then
         Check_Initialization_Call (N, Nam);
      end if;

      --  A protected function cannot be called within the definition of the
      --  enclosing protected type.

      if Is_Protected_Type (Scope (Nam))
        and then In_Open_Scopes (Scope (Nam))
        and then not Has_Completion (Scope (Nam))
      then
         Error_Msg_NE
           ("& cannot be called before end of protected definition", N, Nam);
      end if;

      --  Propagate interpretation to actuals, and add default expressions
      --  where needed.

      if Present (First_Formal (Nam)) then
         Resolve_Actuals (N, Nam);

         --  Overloaded literals are rewritten as function calls, for
         --  purpose of resolution. After resolution, we can replace
         --  the call with the literal itself.

      elsif Ekind (Nam) = E_Enumeration_Literal then
         Copy_Node (Subp, N);
         Resolve_Entity_Name (N, Typ);

         --  Avoid validation, since it is a static function call

         Generate_Reference (Nam, Subp);
         return;
      end if;

      --  If the subprogram is not global, then kill all saved values and
      --  checks. This is a bit conservative, since in many cases we could do
      --  better, but it is not worth the effort. Similarly, we kill constant
      --  values. However we do not need to do this for internal entities
      --  (unless they are inherited user-defined subprograms), since they
      --  are not in the business of molesting local values.

      --  If the flag Suppress_Value_Tracking_On_Calls is set, then we also
      --  kill all checks and values for calls to global subprograms. This
      --  takes care of the case where an access to a local subprogram is
      --  taken, and could be passed directly or indirectly and then called
      --  from almost any context.

      --  Note: we do not do this step till after resolving the actuals. That
      --  way we still take advantage of the current value information while
      --  scanning the actuals.

      --  We suppress killing values if we are processing the nodes associated
      --  with N_Freeze_Entity nodes. Otherwise the declaration of a tagged
      --  type kills all the values as part of analyzing the code that
      --  initializes the dispatch tables.

      if Inside_Freezing_Actions = 0
        and then (not Is_Library_Level_Entity (Nam)
                   or else Suppress_Value_Tracking_On_Call (Current_Scope))
        and then (Comes_From_Source (Nam)
                   or else (Present (Alias (Nam))
                             and then Comes_From_Source (Alias (Nam))))
      then
         Kill_Current_Values;
      end if;

      --  If we are warning about unread OUT parameters, this is the place to
      --  set Last_Assignment for OUT and IN OUT parameters. We have to do this
      --  after the above call to Kill_Current_Values (since that call clears
      --  the Last_Assignment field of all local variables).

      if (Warn_On_Modified_Unread or Warn_On_All_Unread_Out_Parameters)
        and then Comes_From_Source (N)
        and then In_Extended_Main_Source_Unit (N)
      then
         declare
            F : Entity_Id;
            A : Node_Id;

         begin
            F := First_Formal (Nam);
            A := First_Actual (N);
            while Present (F) and then Present (A) loop
               if (Ekind (F) = E_Out_Parameter
                     or else Ekind (F) = E_In_Out_Parameter)
                 and then Warn_On_Modified_As_Out_Parameter (F)
                 and then Is_Entity_Name (A)
                 and then Present (Entity (A))
                 and then Comes_From_Source (N)
                 and then Safe_To_Capture_Value (N, Entity (A))
               then
                  Set_Last_Assignment (Entity (A), A);
               end if;

               Next_Formal (F);
               Next_Actual (A);
            end loop;
         end;
      end if;

      --  If the subprogram is a primitive operation, check whether or not
      --  it is a correct dispatching call.

      if Is_Overloadable (Nam)
        and then Is_Dispatching_Operation (Nam)
      then
         Check_Dispatching_Call (N);

      elsif Ekind (Nam) /= E_Subprogram_Type
        and then Is_Abstract_Subprogram (Nam)
        and then not In_Instance
      then
         Error_Msg_NE ("cannot call abstract subprogram &!", N, Nam);
      end if;

      --  If this is a dispatching call, generate the appropriate reference,
      --  for better source navigation in GPS.

      if Is_Overloadable (Nam)
        and then Present (Controlling_Argument (N))
      then
         Generate_Reference (Nam, Subp, 'R');
      else
         Generate_Reference (Nam, Subp);
      end if;

      if Is_Intrinsic_Subprogram (Nam) then
         Check_Intrinsic_Call (N);
      end if;

      --  Check for violation of restriction No_Specific_Termination_Handlers

      if Is_RTE (Nam, RE_Set_Specific_Handler)
           or else
         Is_RTE (Nam, RE_Specific_Handler)
      then
         Check_Restriction (No_Specific_Termination_Handlers, N);
      end if;

      --  All done, evaluate call and deal with elaboration issues

      Eval_Call (N);
      Check_Elab_Call (N);
   end Resolve_Call;

   -------------------------------
   -- Resolve_Character_Literal --
   -------------------------------

   procedure Resolve_Character_Literal (N : Node_Id; Typ : Entity_Id) is
      B_Typ : constant Entity_Id := Base_Type (Typ);
      C     : Entity_Id;

   begin
      --  Verify that the character does belong to the type of the context

      Set_Etype (N, B_Typ);
      Eval_Character_Literal (N);

      --  Wide_Wide_Character literals must always be defined, since the set
      --  of wide wide character literals is complete, i.e. if a character
      --  literal is accepted by the parser, then it is OK for wide wide
      --  character (out of range character literals are rejected).

      if Root_Type (B_Typ) = Standard_Wide_Wide_Character then
         return;

      --  Always accept character literal for type Any_Character, which
      --  occurs in error situations and in comparisons of literals, both
      --  of which should accept all literals.

      elsif B_Typ = Any_Character then
         return;

      --  For Standard.Character or a type derived from it, check that
      --  the literal is in range

      elsif Root_Type (B_Typ) = Standard_Character then
         if In_Character_Range (UI_To_CC (Char_Literal_Value (N))) then
            return;
         end if;

      --  For Standard.Wide_Character or a type derived from it, check
      --  that the literal is in range

      elsif Root_Type (B_Typ) = Standard_Wide_Character then
         if In_Wide_Character_Range (UI_To_CC (Char_Literal_Value (N))) then
            return;
         end if;

      --  For Standard.Wide_Wide_Character or a type derived from it, we
      --  know the literal is in range, since the parser checked!

      elsif Root_Type (B_Typ) = Standard_Wide_Wide_Character then
         return;

      --  If the entity is already set, this has already been resolved in
      --  a generic context, or comes from expansion. Nothing else to do.

      elsif Present (Entity (N)) then
         return;

      --  Otherwise we have a user defined character type, and we can use
      --  the standard visibility mechanisms to locate the referenced entity

      else
         C := Current_Entity (N);
         while Present (C) loop
            if Etype (C) = B_Typ then
               Set_Entity_With_Style_Check (N, C);
               Generate_Reference (C, N);
               return;
            end if;

            C := Homonym (C);
         end loop;
      end if;

      --  If we fall through, then the literal does not match any of the
      --  entries of the enumeration type. This isn't just a constraint
      --  error situation, it is an illegality (see RM 4.2).

      Error_Msg_NE
        ("character not defined for }", N, First_Subtype (B_Typ));
   end Resolve_Character_Literal;

   ---------------------------
   -- Resolve_Comparison_Op --
   ---------------------------

   --  Context requires a boolean type, and plays no role in resolution.
   --  Processing identical to that for equality operators. The result
   --  type is the base type, which matters when pathological subtypes of
   --  booleans with limited ranges are used.

   procedure Resolve_Comparison_Op (N : Node_Id; Typ : Entity_Id) is
      L : constant Node_Id := Left_Opnd (N);
      R : constant Node_Id := Right_Opnd (N);
      T : Entity_Id;

   begin
      --  If this is an intrinsic operation which is not predefined, use
      --  the types of its declared arguments to resolve the possibly
      --  overloaded operands. Otherwise the operands are unambiguous and
      --  specify the expected type.

      if Scope (Entity (N)) /= Standard_Standard then
         T := Etype (First_Entity (Entity (N)));

      else
         T := Find_Unique_Type (L, R);

         if T = Any_Fixed then
            T := Unique_Fixed_Point_Type (L);
         end if;
      end if;

      Set_Etype (N, Base_Type (Typ));
      Generate_Reference (T, N, ' ');

      if T /= Any_Type then
         if T = Any_String
           or else T = Any_Composite
           or else T = Any_Character
         then
            if T = Any_Character then
               Ambiguous_Character (L);
            else
               Error_Msg_N ("ambiguous operands for comparison", N);
            end if;

            Set_Etype (N, Any_Type);
            return;

         else
            Resolve (L, T);
            Resolve (R, T);
            Check_Unset_Reference (L);
            Check_Unset_Reference (R);
            Generate_Operator_Reference (N, T);
            Eval_Relational_Op (N);
         end if;
      end if;
   end Resolve_Comparison_Op;

   ------------------------------------
   -- Resolve_Conditional_Expression --
   ------------------------------------

   procedure Resolve_Conditional_Expression (N : Node_Id; Typ : Entity_Id) is
      Condition : constant Node_Id := First (Expressions (N));
      Then_Expr : constant Node_Id := Next (Condition);
      Else_Expr : constant Node_Id := Next (Then_Expr);

   begin
      Resolve (Condition, Standard_Boolean);
      Resolve (Then_Expr, Typ);
      Resolve (Else_Expr, Typ);

      Set_Etype (N, Typ);
      Eval_Conditional_Expression (N);
   end Resolve_Conditional_Expression;

   -----------------------------------------
   -- Resolve_Discrete_Subtype_Indication --
   -----------------------------------------

   procedure Resolve_Discrete_Subtype_Indication
     (N   : Node_Id;
      Typ : Entity_Id)
   is
      R : Node_Id;
      S : Entity_Id;

   begin
      Analyze (Subtype_Mark (N));
      S := Entity (Subtype_Mark (N));

      if Nkind (Constraint (N)) /= N_Range_Constraint then
         Error_Msg_N ("expect range constraint for discrete type", N);
         Set_Etype (N, Any_Type);

      else
         R := Range_Expression (Constraint (N));

         if R = Error then
            return;
         end if;

         Analyze (R);

         if Base_Type (S) /= Base_Type (Typ) then
            Error_Msg_NE
              ("expect subtype of }", N, First_Subtype (Typ));

            --  Rewrite the constraint as a range of Typ
            --  to allow compilation to proceed further.

            Set_Etype (N, Typ);
            Rewrite (Low_Bound (R),
              Make_Attribute_Reference (Sloc (Low_Bound (R)),
                Prefix =>         New_Occurrence_Of (Typ, Sloc (R)),
                Attribute_Name => Name_First));
            Rewrite (High_Bound (R),
              Make_Attribute_Reference (Sloc (High_Bound (R)),
                Prefix =>         New_Occurrence_Of (Typ, Sloc (R)),
                Attribute_Name => Name_First));

         else
            Resolve (R, Typ);
            Set_Etype (N, Etype (R));

            --  Additionally, we must check that the bounds are compatible
            --  with the given subtype, which might be different from the
            --  type of the context.

            Apply_Range_Check (R, S);

            --  ??? If the above check statically detects a Constraint_Error
            --  it replaces the offending bound(s) of the range R with a
            --  Constraint_Error node. When the itype which uses these bounds
            --  is frozen the resulting call to Duplicate_Subexpr generates
            --  a new temporary for the bounds.

            --  Unfortunately there are other itypes that are also made depend
            --  on these bounds, so when Duplicate_Subexpr is called they get
            --  a forward reference to the newly created temporaries and Gigi
            --  aborts on such forward references. This is probably sign of a
            --  more fundamental problem somewhere else in either the order of
            --  itype freezing or the way certain itypes are constructed.

            --  To get around this problem we call Remove_Side_Effects right
            --  away if either bounds of R are a Constraint_Error.

            declare
               L : constant Node_Id := Low_Bound (R);
               H : constant Node_Id := High_Bound (R);

            begin
               if Nkind (L) = N_Raise_Constraint_Error then
                  Remove_Side_Effects (L);
               end if;

               if Nkind (H) = N_Raise_Constraint_Error then
                  Remove_Side_Effects (H);
               end if;
            end;

            Check_Unset_Reference (Low_Bound  (R));
            Check_Unset_Reference (High_Bound (R));
         end if;
      end if;
   end Resolve_Discrete_Subtype_Indication;

   -------------------------
   -- Resolve_Entity_Name --
   -------------------------

   --  Used to resolve identifiers and expanded names

   procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id) is
      E : constant Entity_Id := Entity (N);

   begin
      --  If garbage from errors, set to Any_Type and return

      if No (E) and then Total_Errors_Detected /= 0 then
         Set_Etype (N, Any_Type);
         return;
      end if;

      --  Replace named numbers by corresponding literals. Note that this is
      --  the one case where Resolve_Entity_Name must reset the Etype, since
      --  it is currently marked as universal.

      if Ekind (E) = E_Named_Integer then
         Set_Etype (N, Typ);
         Eval_Named_Integer (N);

      elsif Ekind (E) = E_Named_Real then
         Set_Etype (N, Typ);
         Eval_Named_Real (N);

      --  Allow use of subtype only if it is a concurrent type where we are
      --  currently inside the body. This will eventually be expanded
      --  into a call to Self (for tasks) or _object (for protected
      --  objects). Any other use of a subtype is invalid.

      elsif Is_Type (E) then
         if Is_Concurrent_Type (E)
           and then In_Open_Scopes (E)
         then
            null;
         else
            Error_Msg_N
               ("invalid use of subtype mark in expression or call", N);
         end if;

      --  Check discriminant use if entity is discriminant in current scope,
      --  i.e. discriminant of record or concurrent type currently being
      --  analyzed. Uses in corresponding body are unrestricted.

      elsif Ekind (E) = E_Discriminant
        and then Scope (E) = Current_Scope
        and then not Has_Completion (Current_Scope)
      then
         Check_Discriminant_Use (N);

      --  A parameterless generic function cannot appear in a context that
      --  requires resolution.

      elsif Ekind (E) = E_Generic_Function then
         Error_Msg_N ("illegal use of generic function", N);

      elsif Ekind (E) = E_Out_Parameter
        and then Ada_Version = Ada_83
        and then (Nkind (Parent (N)) in N_Op
                    or else (Nkind (Parent (N)) = N_Assignment_Statement
                              and then N = Expression (Parent (N)))
                    or else Nkind (Parent (N)) = N_Explicit_Dereference)
      then
         Error_Msg_N ("(Ada 83) illegal reading of out parameter", N);

      --  In all other cases, just do the possible static evaluation

      else
         --  A deferred constant that appears in an expression must have
         --  a completion, unless it has been removed by in-place expansion
         --  of an aggregate.

         if Ekind (E) = E_Constant
           and then Comes_From_Source (E)
           and then No (Constant_Value (E))
           and then Is_Frozen (Etype (E))
           and then not In_Spec_Expression
           and then not Is_Imported (E)
         then

            if No_Initialization (Parent (E))
              or else (Present (Full_View (E))
                        and then No_Initialization (Parent (Full_View (E))))
            then
               null;
            else
               Error_Msg_N (
                 "deferred constant is frozen before completion", N);
            end if;
         end if;

         Eval_Entity_Name (N);
      end if;
   end Resolve_Entity_Name;

   -------------------
   -- Resolve_Entry --
   -------------------

   procedure Resolve_Entry (Entry_Name : Node_Id) is
      Loc    : constant Source_Ptr := Sloc (Entry_Name);
      Nam    : Entity_Id;
      New_N  : Node_Id;
      S      : Entity_Id;
      Tsk    : Entity_Id;
      E_Name : Node_Id;
      Index  : Node_Id;

      function Actual_Index_Type (E : Entity_Id) return Entity_Id;
      --  If the bounds of the entry family being called depend on task
      --  discriminants, build a new index subtype where a discriminant is
      --  replaced with the value of the discriminant of the target task.
      --  The target task is the prefix of the entry name in the call.

      -----------------------
      -- Actual_Index_Type --
      -----------------------

      function Actual_Index_Type (E : Entity_Id) return Entity_Id is
         Typ   : constant Entity_Id := Entry_Index_Type (E);
         Tsk   : constant Entity_Id := Scope (E);
         Lo    : constant Node_Id   := Type_Low_Bound  (Typ);
         Hi    : constant Node_Id   := Type_High_Bound (Typ);
         New_T : Entity_Id;

         function Actual_Discriminant_Ref (Bound : Node_Id) return Node_Id;
         --  If the bound is given by a discriminant, replace with a reference
         --  to the discriminant of the same name in the target task.
         --  If the entry name is the target of a requeue statement and the
         --  entry is in the current protected object, the bound to be used
         --  is the discriminal of the object (see apply_range_checks for
         --  details of the transformation).

         -----------------------------
         -- Actual_Discriminant_Ref --
         -----------------------------

         function Actual_Discriminant_Ref (Bound : Node_Id) return Node_Id is
            Typ : constant Entity_Id := Etype (Bound);
            Ref : Node_Id;

         begin
            Remove_Side_Effects (Bound);

            if not Is_Entity_Name (Bound)
              or else Ekind (Entity (Bound)) /= E_Discriminant
            then
               return Bound;

            elsif Is_Protected_Type (Tsk)
              and then In_Open_Scopes (Tsk)
              and then Nkind (Parent (Entry_Name)) = N_Requeue_Statement
            then
               return New_Occurrence_Of (Discriminal (Entity (Bound)), Loc);

            else
               Ref :=
                 Make_Selected_Component (Loc,
                   Prefix => New_Copy_Tree (Prefix (Prefix (Entry_Name))),
                   Selector_Name => New_Occurrence_Of (Entity (Bound), Loc));
               Analyze (Ref);
               Resolve (Ref, Typ);
               return Ref;
            end if;
         end Actual_Discriminant_Ref;

      --  Start of processing for Actual_Index_Type

      begin
         if not Has_Discriminants (Tsk)
           or else (not Is_Entity_Name (Lo)
                     and then not Is_Entity_Name (Hi))
         then
            return Entry_Index_Type (E);

         else
            New_T := Create_Itype (Ekind (Typ), Parent (Entry_Name));
            Set_Etype        (New_T, Base_Type (Typ));
            Set_Size_Info    (New_T, Typ);
            Set_RM_Size      (New_T, RM_Size (Typ));
            Set_Scalar_Range (New_T,
              Make_Range (Sloc (Entry_Name),
                Low_Bound  => Actual_Discriminant_Ref (Lo),
                High_Bound => Actual_Discriminant_Ref (Hi)));

            return New_T;
         end if;
      end Actual_Index_Type;

   --  Start of processing of Resolve_Entry

   begin
      --  Find name of entry being called, and resolve prefix of name
      --  with its own type. The prefix can be overloaded, and the name
      --  and signature of the entry must be taken into account.

      if Nkind (Entry_Name) = N_Indexed_Component then

         --  Case of dealing with entry family within the current tasks

         E_Name := Prefix (Entry_Name);

      else
         E_Name := Entry_Name;
      end if;

      if Is_Entity_Name (E_Name) then
         --  Entry call to an entry (or entry family) in the current task.
         --  This is legal even though the task will deadlock. Rewrite as
         --  call to current task.

         --  This can also be a call to an entry in  an enclosing task.
         --  If this is a single task, we have to retrieve its name,
         --  because the scope of the entry is the task type, not the
         --  object. If the enclosing task is a task type, the identity
         --  of the task is given by its own self variable.

         --  Finally this can be a requeue on an entry of the same task
         --  or protected object.

         S := Scope (Entity (E_Name));

         for J in reverse 0 .. Scope_Stack.Last loop

            if Is_Task_Type (Scope_Stack.Table (J).Entity)
              and then not Comes_From_Source (S)
            then
               --  S is an enclosing task or protected object. The concurrent
               --  declaration has been converted into a type declaration, and
               --  the object itself has an object declaration that follows
               --  the type in the same declarative part.

               Tsk := Next_Entity (S);
               while Etype (Tsk) /= S loop
                  Next_Entity (Tsk);
               end loop;

               S := Tsk;
               exit;

            elsif S = Scope_Stack.Table (J).Entity then

               --  Call to current task. Will be transformed into call to Self

               exit;

            end if;
         end loop;

         New_N :=
           Make_Selected_Component (Loc,
             Prefix => New_Occurrence_Of (S, Loc),
             Selector_Name =>
               New_Occurrence_Of (Entity (E_Name), Loc));
         Rewrite (E_Name, New_N);
         Analyze (E_Name);

      elsif Nkind (Entry_Name) = N_Selected_Component
        and then Is_Overloaded (Prefix (Entry_Name))
      then
         --  Use the entry name (which must be unique at this point) to
         --  find the prefix that returns the corresponding task type or
         --  protected type.

         declare
            Pref : constant Node_Id := Prefix (Entry_Name);
            Ent  : constant Entity_Id :=  Entity (Selector_Name (Entry_Name));
            I    : Interp_Index;
            It   : Interp;

         begin
            Get_First_Interp (Pref, I, It);
            while Present (It.Typ) loop
               if Scope (Ent) = It.Typ then
                  Set_Etype (Pref, It.Typ);
                  exit;
               end if;

               Get_Next_Interp (I, It);
            end loop;
         end;
      end if;

      if Nkind (Entry_Name) = N_Selected_Component then
         Resolve (Prefix (Entry_Name));

      else pragma Assert (Nkind (Entry_Name) = N_Indexed_Component);
         Nam := Entity (Selector_Name (Prefix (Entry_Name)));
         Resolve (Prefix (Prefix (Entry_Name)));
         Index :=  First (Expressions (Entry_Name));
         Resolve (Index, Entry_Index_Type (Nam));

         --  Up to this point the expression could have been the actual
         --  in a simple entry call, and be given by a named association.

         if Nkind (Index) = N_Parameter_Association then
            Error_Msg_N ("expect expression for entry index", Index);
         else
            Apply_Range_Check (Index, Actual_Index_Type (Nam));
         end if;
      end if;
   end Resolve_Entry;

   ------------------------
   -- Resolve_Entry_Call --
   ------------------------

   procedure Resolve_Entry_Call (N : Node_Id; Typ : Entity_Id) is
      Entry_Name  : constant Node_Id    := Name (N);
      Loc         : constant Source_Ptr := Sloc (Entry_Name);
      Actuals     : List_Id;
      First_Named : Node_Id;
      Nam         : Entity_Id;
      Norm_OK     : Boolean;
      Obj         : Node_Id;
      Was_Over    : Boolean;

   begin
      --  We kill all checks here, because it does not seem worth the
      --  effort to do anything better, an entry call is a big operation.

      Kill_All_Checks;

      --  Processing of the name is similar for entry calls and protected
      --  operation calls. Once the entity is determined, we can complete
      --  the resolution of the actuals.

      --  The selector may be overloaded, in the case of a protected object
      --  with overloaded functions. The type of the context is used for
      --  resolution.

      if Nkind (Entry_Name) = N_Selected_Component
        and then Is_Overloaded (Selector_Name (Entry_Name))
        and then Typ /= Standard_Void_Type
      then
         declare
            I  : Interp_Index;
            It : Interp;

         begin
            Get_First_Interp (Selector_Name (Entry_Name), I, It);
            while Present (It.Typ) loop
               if Covers (Typ, It.Typ) then
                  Set_Entity (Selector_Name (Entry_Name), It.Nam);
                  Set_Etype  (Entry_Name, It.Typ);

                  Generate_Reference (It.Typ, N, ' ');
               end if;

               Get_Next_Interp (I, It);
            end loop;
         end;
      end if;

      Resolve_Entry (Entry_Name);

      if Nkind (Entry_Name) = N_Selected_Component then

         --  Simple entry call

         Nam := Entity (Selector_Name (Entry_Name));
         Obj := Prefix (Entry_Name);
         Was_Over := Is_Overloaded (Selector_Name (Entry_Name));

      else pragma Assert (Nkind (Entry_Name) = N_Indexed_Component);

         --  Call to member of entry family

         Nam := Entity (Selector_Name (Prefix (Entry_Name)));
         Obj := Prefix (Prefix (Entry_Name));
         Was_Over := Is_Overloaded (Selector_Name (Prefix (Entry_Name)));
      end if;

      --  We cannot in general check the maximum depth of protected entry
      --  calls at compile time. But we can tell that any protected entry
      --  call at all violates a specified nesting depth of zero.

      if Is_Protected_Type (Scope (Nam)) then
         Check_Restriction (Max_Entry_Queue_Length, N);
      end if;

      --  Use context type to disambiguate a protected function that can be
      --  called without actuals and that returns an array type, and where
      --  the argument list may be an indexing of the returned value.

      if Ekind (Nam) = E_Function
        and then Needs_No_Actuals (Nam)
        and then Present (Parameter_Associations (N))
        and then
          ((Is_Array_Type (Etype (Nam))
             and then Covers (Typ, Component_Type (Etype (Nam))))

            or else (Is_Access_Type (Etype (Nam))
                      and then Is_Array_Type (Designated_Type (Etype (Nam)))
                      and then Covers (Typ,
                        Component_Type (Designated_Type (Etype (Nam))))))
      then
         declare
            Index_Node : Node_Id;

         begin
            Index_Node :=
              Make_Indexed_Component (Loc,
                Prefix =>
                  Make_Function_Call (Loc,
                    Name => Relocate_Node (Entry_Name)),
                Expressions => Parameter_Associations (N));

            --  Since we are correcting a node classification error made by
            --  the parser, we call Replace rather than Rewrite.

            Replace (N, Index_Node);
            Set_Etype (Prefix (N), Etype (Nam));
            Set_Etype (N, Typ);
            Resolve_Indexed_Component (N, Typ);
            return;
         end;
      end if;

      --  The operation name may have been overloaded. Order the actuals
      --  according to the formals of the resolved entity, and set the
      --  return type to that of the operation.

      if Was_Over then
         Normalize_Actuals (N, Nam, False, Norm_OK);
         pragma Assert (Norm_OK);
         Set_Etype (N, Etype (Nam));
      end if;

      Resolve_Actuals (N, Nam);
      Generate_Reference (Nam, Entry_Name);

      if Ekind (Nam) = E_Entry
        or else Ekind (Nam) = E_Entry_Family
      then
         Check_Potentially_Blocking_Operation (N);
      end if;

      --  Verify that a procedure call cannot masquerade as an entry
      --  call where an entry call is expected.

      if Ekind (Nam) = E_Procedure then
         if Nkind (Parent (N)) = N_Entry_Call_Alternative
           and then N = Entry_Call_Statement (Parent (N))
         then
            Error_Msg_N ("entry call required in select statement", N);

         elsif Nkind (Parent (N)) = N_Triggering_Alternative
           and then N = Triggering_Statement (Parent (N))
         then
            Error_Msg_N ("triggering statement cannot be procedure call", N);

         elsif Ekind (Scope (Nam)) = E_Task_Type
           and then not In_Open_Scopes (Scope (Nam))
         then
            Error_Msg_N ("task has no entry with this name", Entry_Name);
         end if;
      end if;

      --  After resolution, entry calls and protected procedure calls
      --  are changed into entry calls, for expansion. The structure
      --  of the node does not change, so it can safely be done in place.
      --  Protected function calls must keep their structure because they
      --  are subexpressions.

      if Ekind (Nam) /= E_Function then

         --  A protected operation that is not a function may modify the
         --  corresponding object, and cannot apply to a constant.
         --  If this is an internal call, the prefix is the type itself.

         if Is_Protected_Type (Scope (Nam))
           and then not Is_Variable (Obj)
           and then (not Is_Entity_Name (Obj)
                       or else not Is_Type (Entity (Obj)))
         then
            Error_Msg_N
              ("prefix of protected procedure or entry call must be variable",
               Entry_Name);
         end if;

         Actuals := Parameter_Associations (N);
         First_Named := First_Named_Actual (N);

         Rewrite (N,
           Make_Entry_Call_Statement (Loc,
             Name                   => Entry_Name,
             Parameter_Associations => Actuals));

         Set_First_Named_Actual (N, First_Named);
         Set_Analyzed (N, True);

      --  Protected functions can return on the secondary stack, in which
      --  case we must trigger the transient scope mechanism.

      elsif Expander_Active
        and then Requires_Transient_Scope (Etype (Nam))
      then
         Establish_Transient_Scope (N, Sec_Stack => True);
      end if;
   end Resolve_Entry_Call;

   -------------------------
   -- Resolve_Equality_Op --
   -------------------------

   --  Both arguments must have the same type, and the boolean context
   --  does not participate in the resolution. The first pass verifies
   --  that the interpretation is not ambiguous, and the type of the left
   --  argument is correctly set, or is Any_Type in case of ambiguity.
   --  If both arguments are strings or aggregates, allocators, or Null,
   --  they are ambiguous even though they carry a single (universal) type.
   --  Diagnose this case here.

   procedure Resolve_Equality_Op (N : Node_Id; Typ : Entity_Id) is
      L : constant Node_Id   := Left_Opnd (N);
      R : constant Node_Id   := Right_Opnd (N);
      T : Entity_Id := Find_Unique_Type (L, R);

      function Find_Unique_Access_Type return Entity_Id;
      --  In the case of allocators, make a last-ditch attempt to find a single
      --  access type with the right designated type. This is semantically
      --  dubious, and of no interest to any real code, but c48008a makes it
      --  all worthwhile.

      -----------------------------
      -- Find_Unique_Access_Type --
      -----------------------------

      function Find_Unique_Access_Type return Entity_Id is
         Acc : Entity_Id;
         E   : Entity_Id;
         S   : Entity_Id;

      begin
         if Ekind (Etype (R)) =  E_Allocator_Type then
            Acc := Designated_Type (Etype (R));
         elsif Ekind (Etype (L)) =  E_Allocator_Type then
            Acc := Designated_Type (Etype (L));
         else
            return Empty;
         end if;

         S := Current_Scope;
         while S /= Standard_Standard loop
            E := First_Entity (S);
            while Present (E) loop
               if Is_Type (E)
                 and then Is_Access_Type (E)
                 and then Ekind (E) /= E_Allocator_Type
                 and then Designated_Type (E) = Base_Type (Acc)
               then
                  return E;
               end if;

               Next_Entity (E);
            end loop;

            S := Scope (S);
         end loop;

         return Empty;
      end Find_Unique_Access_Type;

   --  Start of processing for Resolve_Equality_Op

   begin
      Set_Etype (N, Base_Type (Typ));
      Generate_Reference (T, N, ' ');

      if T = Any_Fixed then
         T := Unique_Fixed_Point_Type (L);
      end if;

      if T /= Any_Type then
         if T = Any_String
           or else T = Any_Composite
           or else T = Any_Character
         then
            if T = Any_Character then
               Ambiguous_Character (L);
            else
               Error_Msg_N ("ambiguous operands for equality", N);
            end if;

            Set_Etype (N, Any_Type);
            return;

         elsif T = Any_Access
           or else Ekind (T) = E_Allocator_Type
           or else Ekind (T) = E_Access_Attribute_Type
         then
            T := Find_Unique_Access_Type;

            if No (T) then
               Error_Msg_N ("ambiguous operands for equality", N);
               Set_Etype (N, Any_Type);
               return;
            end if;
         end if;

         Resolve (L, T);
         Resolve (R, T);

         --  If the unique type is a class-wide type then it will be expanded
         --  into a dispatching call to the predefined primitive. Therefore we
         --  check here for potential violation of such restriction.

         if Is_Class_Wide_Type (T) then
            Check_Restriction (No_Dispatching_Calls, N);
         end if;

         if Warn_On_Redundant_Constructs
           and then Comes_From_Source (N)
           and then Is_Entity_Name (R)
           and then Entity (R) = Standard_True
           and then Comes_From_Source (R)
         then
            Error_Msg_N ("?comparison with True is redundant!", R);
         end if;

         Check_Unset_Reference (L);
         Check_Unset_Reference (R);
         Generate_Operator_Reference (N, T);

         --  If this is an inequality, it may be the implicit inequality
         --  created for a user-defined operation, in which case the corres-
         --  ponding equality operation is not intrinsic, and the operation
         --  cannot be constant-folded. Else fold.

         if Nkind (N) = N_Op_Eq
           or else Comes_From_Source (Entity (N))
           or else Ekind (Entity (N)) = E_Operator
           or else Is_Intrinsic_Subprogram
             (Corresponding_Equality (Entity (N)))
         then
            Eval_Relational_Op (N);

         elsif Nkind (N) = N_Op_Ne
           and then Is_Abstract_Subprogram (Entity (N))
         then
            Error_Msg_NE ("cannot call abstract subprogram &!", N, Entity (N));
         end if;

         --  Ada 2005:  If one operand is an anonymous access type, convert
         --  the other operand to it, to ensure that the underlying types
         --  match in the back-end. Same for access_to_subprogram, and the
         --  conversion verifies that the types are subtype conformant.

         --  We apply the same conversion in the case one of the operands is
         --  a private subtype of the type of the other.

         --  Why the Expander_Active test here ???

         if Expander_Active
           and then
             (Ekind (T) =  E_Anonymous_Access_Type
               or else Ekind (T) = E_Anonymous_Access_Subprogram_Type
               or else Is_Private_Type (T))
         then
            if Etype (L) /= T then
               Rewrite (L,
                 Make_Unchecked_Type_Conversion (Sloc (L),
                   Subtype_Mark => New_Occurrence_Of (T, Sloc (L)),
                   Expression   => Relocate_Node (L)));
               Analyze_And_Resolve (L, T);
            end if;

            if (Etype (R)) /= T then
               Rewrite (R,
                  Make_Unchecked_Type_Conversion (Sloc (R),
                    Subtype_Mark => New_Occurrence_Of (Etype (L), Sloc (R)),
                    Expression   => Relocate_Node (R)));
               Analyze_And_Resolve (R, T);
            end if;
         end if;
      end if;
   end Resolve_Equality_Op;

   ----------------------------------
   -- Resolve_Explicit_Dereference --
   ----------------------------------

   procedure Resolve_Explicit_Dereference (N : Node_Id; Typ : Entity_Id) is
      Loc   : constant Source_Ptr := Sloc (N);
      New_N : Node_Id;
      P     : constant Node_Id := Prefix (N);
      I     : Interp_Index;
      It    : Interp;

   begin
      Check_Fully_Declared_Prefix (Typ, P);

      if Is_Overloaded (P) then

         --  Use the context type to select the prefix that has the correct
         --  designated type.

         Get_First_Interp (P, I, It);
         while Present (It.Typ) loop
            exit when Is_Access_Type (It.Typ)
              and then Covers (Typ, Designated_Type (It.Typ));
            Get_Next_Interp (I, It);
         end loop;

         if Present (It.Typ) then
            Resolve (P, It.Typ);
         else
            --  If no interpretation covers the designated type of the prefix,
            --  this is the pathological case where not all implementations of
            --  the prefix allow the interpretation of the node as a call. Now
            --  that the expected type is known, Remove other interpretations
            --  from prefix, rewrite it as a call, and resolve again, so that
            --  the proper call node is generated.

            Get_First_Interp (P, I, It);
            while Present (It.Typ) loop
               if Ekind (It.Typ) /= E_Access_Subprogram_Type then
                  Remove_Interp (I);
               end if;

               Get_Next_Interp (I, It);
            end loop;

            New_N :=
              Make_Function_Call (Loc,
                Name =>
                  Make_Explicit_Dereference (Loc,
                    Prefix => P),
                Parameter_Associations => New_List);

            Save_Interps (N, New_N);
            Rewrite (N, New_N);
            Analyze_And_Resolve (N, Typ);
            return;
         end if;

         Set_Etype (N, Designated_Type (It.Typ));

      else
         Resolve (P);
      end if;

      if Is_Access_Type (Etype (P)) then
         Apply_Access_Check (N);
      end if;

      --  If the designated type is a packed unconstrained array type, and the
      --  explicit dereference is not in the context of an attribute reference,
      --  then we must compute and set the actual subtype, since it is needed
      --  by Gigi. The reason we exclude the attribute case is that this is
      --  handled fine by Gigi, and in fact we use such attributes to build the
      --  actual subtype. We also exclude generated code (which builds actual
      --  subtypes directly if they are needed).

      if Is_Array_Type (Etype (N))
        and then Is_Packed (Etype (N))
        and then not Is_Constrained (Etype (N))
        and then Nkind (Parent (N)) /= N_Attribute_Reference
        and then Comes_From_Source (N)
      then
         Set_Etype (N, Get_Actual_Subtype (N));
      end if;

      --  Note: there is no Eval processing required for an explicit deference,
      --  because the type is known to be an allocators, and allocator
      --  expressions can never be static.

   end Resolve_Explicit_Dereference;

   -------------------------------
   -- Resolve_Indexed_Component --
   -------------------------------

   procedure Resolve_Indexed_Component (N : Node_Id; Typ : Entity_Id) is
      Name       : constant Node_Id := Prefix  (N);
      Expr       : Node_Id;
      Array_Type : Entity_Id := Empty; -- to prevent junk warning
      Index      : Node_Id;

   begin
      if Is_Overloaded (Name) then

         --  Use the context type to select the prefix that yields the correct
         --  component type.

         declare
            I     : Interp_Index;
            It    : Interp;
            I1    : Interp_Index := 0;
            P     : constant Node_Id := Prefix (N);
            Found : Boolean := False;

         begin
            Get_First_Interp (P, I, It);
            while Present (It.Typ) loop
               if (Is_Array_Type (It.Typ)
                     and then Covers (Typ, Component_Type (It.Typ)))
                 or else (Is_Access_Type (It.Typ)
                            and then Is_Array_Type (Designated_Type (It.Typ))
                            and then Covers
                              (Typ, Component_Type (Designated_Type (It.Typ))))
               then
                  if Found then
                     It := Disambiguate (P, I1, I, Any_Type);

                     if It = No_Interp then
                        Error_Msg_N ("ambiguous prefix for indexing",  N);
                        Set_Etype (N, Typ);
                        return;

                     else
                        Found := True;
                        Array_Type := It.Typ;
                        I1 := I;
                     end if;

                  else
                     Found := True;
                     Array_Type := It.Typ;
                     I1 := I;
                  end if;
               end if;

               Get_Next_Interp (I, It);
            end loop;
         end;

      else
         Array_Type := Etype (Name);
      end if;

      Resolve (Name, Array_Type);
      Array_Type := Get_Actual_Subtype_If_Available (Name);

      --  If prefix is access type, dereference to get real array type.
      --  Note: we do not apply an access check because the expander always
      --  introduces an explicit dereference, and the check will happen there.

      if Is_Access_Type (Array_Type) then
         Array_Type := Designated_Type (Array_Type);
      end if;

      --  If name was overloaded, set component type correctly now
      --  If a misplaced call to an entry family (which has no index types)
      --  return. Error will be diagnosed from calling context.

      if Is_Array_Type (Array_Type) then
         Set_Etype (N, Component_Type (Array_Type));
      else
         return;
      end if;

      Index := First_Index (Array_Type);
      Expr  := First (Expressions (N));

      --  The prefix may have resolved to a string literal, in which case its
      --  etype has a special representation. This is only possible currently
      --  if the prefix is a static concatenation, written in functional
      --  notation.

      if Ekind (Array_Type) = E_String_Literal_Subtype then
         Resolve (Expr, Standard_Positive);

      else
         while Present (Index) and Present (Expr) loop
            Resolve (Expr, Etype (Index));
            Check_Unset_Reference (Expr);

            if Is_Scalar_Type (Etype (Expr)) then
               Apply_Scalar_Range_Check (Expr, Etype (Index));
            else
               Apply_Range_Check (Expr, Get_Actual_Subtype (Index));
            end if;

            Next_Index (Index);
            Next (Expr);
         end loop;
      end if;

      --  Do not generate the warning on suspicious index if we are analyzing
      --  package Ada.Tags; otherwise we will report the warning with the
      --  Prims_Ptr field of the dispatch table.

      if Scope (Etype (Prefix (N))) = Standard_Standard
        or else not
          Is_RTU (Cunit_Entity (Get_Source_Unit (Etype (Prefix (N)))),
                  Ada_Tags)
      then
         Warn_On_Suspicious_Index (Name, First (Expressions (N)));
         Eval_Indexed_Component (N);
      end if;
   end Resolve_Indexed_Component;

   -----------------------------
   -- Resolve_Integer_Literal --
   -----------------------------

   procedure Resolve_Integer_Literal (N : Node_Id; Typ : Entity_Id) is
   begin
      Set_Etype (N, Typ);
      Eval_Integer_Literal (N);
   end Resolve_Integer_Literal;

   --------------------------------
   -- Resolve_Intrinsic_Operator --
   --------------------------------

   procedure Resolve_Intrinsic_Operator  (N : Node_Id; Typ : Entity_Id) is
      Btyp : constant Entity_Id := Base_Type (Underlying_Type (Typ));
      Op   : Entity_Id;
      Arg1 : Node_Id;
      Arg2 : Node_Id;

   begin
      Op := Entity (N);
      while Scope (Op) /= Standard_Standard loop
         Op := Homonym (Op);
         pragma Assert (Present (Op));
      end loop;

      Set_Entity (N, Op);
      Set_Is_Overloaded (N, False);

      --  If the operand type is private, rewrite with suitable conversions on
      --  the operands and the result, to expose the proper underlying numeric
      --  type.

      if Is_Private_Type (Typ) then
         Arg1 := Unchecked_Convert_To (Btyp, Left_Opnd  (N));

         if Nkind (N) = N_Op_Expon then
            Arg2 := Unchecked_Convert_To (Standard_Integer, Right_Opnd (N));
         else
            Arg2 := Unchecked_Convert_To (Btyp, Right_Opnd (N));
         end if;

         Save_Interps (Left_Opnd (N),  Expression (Arg1));
         Save_Interps (Right_Opnd (N), Expression (Arg2));

         Set_Left_Opnd  (N, Arg1);
         Set_Right_Opnd (N, Arg2);

         Set_Etype (N, Btyp);
         Rewrite (N, Unchecked_Convert_To (Typ, N));
         Resolve (N, Typ);

      elsif Typ /= Etype (Left_Opnd (N))
        or else Typ /= Etype (Right_Opnd (N))
      then
         --  Add explicit conversion where needed, and save interpretations
         --  in case operands are overloaded.

         Arg1 := Convert_To (Typ, Left_Opnd  (N));
         Arg2 := Convert_To (Typ, Right_Opnd (N));

         if Nkind (Arg1) = N_Type_Conversion then
            Save_Interps (Left_Opnd (N), Expression (Arg1));
         else
            Save_Interps (Left_Opnd (N), Arg1);
         end if;

         if Nkind (Arg2) = N_Type_Conversion then
            Save_Interps (Right_Opnd (N), Expression (Arg2));
         else
            Save_Interps (Right_Opnd (N), Arg2);
         end if;

         Rewrite (Left_Opnd  (N), Arg1);
         Rewrite (Right_Opnd (N), Arg2);
         Analyze (Arg1);
         Analyze (Arg2);
         Resolve_Arithmetic_Op (N, Typ);

      else
         Resolve_Arithmetic_Op (N, Typ);
      end if;
   end Resolve_Intrinsic_Operator;

   --------------------------------------
   -- Resolve_Intrinsic_Unary_Operator --
   --------------------------------------

   procedure Resolve_Intrinsic_Unary_Operator
     (N   : Node_Id;
      Typ : Entity_Id)
   is
      Btyp : constant Entity_Id := Base_Type (Underlying_Type (Typ));
      Op   : Entity_Id;
      Arg2 : Node_Id;

   begin
      Op := Entity (N);
      while Scope (Op) /= Standard_Standard loop
         Op := Homonym (Op);
         pragma Assert (Present (Op));
      end loop;

      Set_Entity (N, Op);

      if Is_Private_Type (Typ) then
         Arg2 := Unchecked_Convert_To (Btyp, Right_Opnd (N));
         Save_Interps (Right_Opnd (N), Expression (Arg2));

         Set_Right_Opnd (N, Arg2);

         Set_Etype (N, Btyp);
         Rewrite (N, Unchecked_Convert_To (Typ, N));
         Resolve (N, Typ);

      else
         Resolve_Unary_Op (N, Typ);
      end if;
   end Resolve_Intrinsic_Unary_Operator;

   ------------------------
   -- Resolve_Logical_Op --
   ------------------------

   procedure Resolve_Logical_Op (N : Node_Id; Typ : Entity_Id) is
      B_Typ : Entity_Id;
      N_Opr : constant Node_Kind := Nkind (N);

   begin
      --  Predefined operations on scalar types yield the base type. On the
      --  other hand, logical operations on arrays yield the type of the
      --  arguments (and the context).

      if Is_Array_Type (Typ) then
         B_Typ := Typ;
      else
         B_Typ := Base_Type (Typ);
      end if;

      --  The following test is required because the operands of the operation
      --  may be literals, in which case the resulting type appears to be
      --  compatible with a signed integer type, when in fact it is compatible
      --  only with modular types. If the context itself is universal, the
      --  operation is illegal.

      if not Valid_Boolean_Arg (Typ) then
         Error_Msg_N ("invalid context for logical operation", N);
         Set_Etype (N, Any_Type);
         return;

      elsif Typ = Any_Modular then
         Error_Msg_N
           ("no modular type available in this context", N);
         Set_Etype (N, Any_Type);
         return;
      elsif Is_Modular_Integer_Type (Typ)
        and then Etype (Left_Opnd (N)) = Universal_Integer
        and then Etype (Right_Opnd (N)) = Universal_Integer
      then
         Check_For_Visible_Operator (N, B_Typ);
      end if;

      Resolve (Left_Opnd (N), B_Typ);
      Resolve (Right_Opnd (N), B_Typ);

      Check_Unset_Reference (Left_Opnd  (N));
      Check_Unset_Reference (Right_Opnd (N));

      Set_Etype (N, B_Typ);
      Generate_Operator_Reference (N, B_Typ);
      Eval_Logical_Op (N);

      --  Check for violation of restriction No_Direct_Boolean_Operators
      --  if the operator was not eliminated by the Eval_Logical_Op call.

      if Nkind (N) = N_Opr
        and then Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean
      then
         Check_Restriction (No_Direct_Boolean_Operators, N);
      end if;
   end Resolve_Logical_Op;

   ---------------------------
   -- Resolve_Membership_Op --
   ---------------------------

   --  The context can only be a boolean type, and does not determine
   --  the arguments. Arguments should be unambiguous, but the preference
   --  rule for universal types applies.

   procedure Resolve_Membership_Op (N : Node_Id; Typ : Entity_Id) is
      pragma Warnings (Off, Typ);

      L : constant Node_Id   := Left_Opnd (N);
      R : constant Node_Id   := Right_Opnd (N);
      T : Entity_Id;

   begin
      if L = Error or else R = Error then
         return;
      end if;

      if not Is_Overloaded (R)
        and then
          (Etype (R) = Universal_Integer or else
           Etype (R) = Universal_Real)
        and then Is_Overloaded (L)
      then
         T := Etype (R);

      --  Ada 2005 (AI-251): Give support to the following case:

      --      type I is interface;
      --      type T is tagged ...

      --      function Test (O : I'Class) is
      --      begin
      --         return O in T'Class.
      --      end Test;

      --  In this case we have nothing else to do; the membership test will be
      --  done at run-time.

      elsif Ada_Version >= Ada_05
        and then Is_Class_Wide_Type (Etype (L))
        and then Is_Interface (Etype (L))
        and then Is_Class_Wide_Type (Etype (R))
        and then not Is_Interface (Etype (R))
      then
         return;

      else
         T := Intersect_Types (L, R);
      end if;

      Resolve (L, T);
      Check_Unset_Reference (L);

      if Nkind (R) = N_Range
        and then not Is_Scalar_Type (T)
      then
         Error_Msg_N ("scalar type required for range", R);
      end if;

      if Is_Entity_Name (R) then
         Freeze_Expression (R);
      else
         Resolve (R, T);
         Check_Unset_Reference (R);
      end if;

      Eval_Membership_Op (N);
   end Resolve_Membership_Op;

   ------------------
   -- Resolve_Null --
   ------------------

   procedure Resolve_Null (N : Node_Id; Typ : Entity_Id) is
   begin
      --  Handle restriction against anonymous null access values This
      --  restriction can be turned off using -gnatdj.

      --  Ada 2005 (AI-231): Remove restriction

      if Ada_Version < Ada_05
        and then not Debug_Flag_J
        and then Ekind (Typ) = E_Anonymous_Access_Type
        and then Comes_From_Source (N)
      then
         --  In the common case of a call which uses an explicitly null
         --  value for an access parameter, give specialized error message.

         if Nkind_In (Parent (N), N_Procedure_Call_Statement,
                                  N_Function_Call)
         then
            Error_Msg_N
              ("null is not allowed as argument for an access parameter", N);

         --  Standard message for all other cases (are there any?)

         else
            Error_Msg_N
              ("null cannot be of an anonymous access type", N);
         end if;
      end if;

      --  In a distributed context, null for a remote access to subprogram
      --  may need to be replaced with a special record aggregate. In this
      --  case, return after having done the transformation.

      if (Ekind (Typ) = E_Record_Type
           or else Is_Remote_Access_To_Subprogram_Type (Typ))
        and then Remote_AST_Null_Value (N, Typ)
      then
         return;
      end if;

      --  The null literal takes its type from the context

      Set_Etype (N, Typ);
   end Resolve_Null;

   -----------------------
   -- Resolve_Op_Concat --
   -----------------------

   procedure Resolve_Op_Concat (N : Node_Id; Typ : Entity_Id) is

      --  We wish to avoid deep recursion, because concatenations are often
      --  deeply nested, as in A&B&...&Z. Therefore, we walk down the left
      --  operands nonrecursively until we find something that is not a simple
      --  concatenation (A in this case). We resolve that, and then walk back
      --  up the tree following Parent pointers, calling Resolve_Op_Concat_Rest
      --  to do the rest of the work at each level. The Parent pointers allow
      --  us to avoid recursion, and thus avoid running out of memory. See also
      --  Sem_Ch4.Analyze_Concatenation, where a similar hack is used.

      NN  : Node_Id := N;
      Op1 : Node_Id;

   begin
      --  The following code is equivalent to:

      --    Resolve_Op_Concat_First (NN, Typ);
      --    Resolve_Op_Concat_Arg (N, ...);
      --    Resolve_Op_Concat_Rest (N, Typ);

      --  where the Resolve_Op_Concat_Arg call recurses back here if the left
      --  operand is a concatenation.

      --  Walk down left operands

      loop
         Resolve_Op_Concat_First (NN, Typ);
         Op1 := Left_Opnd (NN);
         exit when not (Nkind (Op1) = N_Op_Concat
                         and then not Is_Array_Type (Component_Type (Typ))
                         and then Entity (Op1) = Entity (NN));
         NN := Op1;
      end loop;

      --  Now (given the above example) NN is A&B and Op1 is A

      --  First resolve Op1 ...

      Resolve_Op_Concat_Arg (NN, Op1, Typ, Is_Component_Left_Opnd  (NN));

      --  ... then walk NN back up until we reach N (where we started), calling
      --  Resolve_Op_Concat_Rest along the way.

      loop
         Resolve_Op_Concat_Rest (NN, Typ);
         exit when NN = N;
         NN := Parent (NN);
      end loop;
   end Resolve_Op_Concat;

   ---------------------------
   -- Resolve_Op_Concat_Arg --
   ---------------------------

   procedure Resolve_Op_Concat_Arg
     (N       : Node_Id;
      Arg     : Node_Id;
      Typ     : Entity_Id;
      Is_Comp : Boolean)
   is
      Btyp : constant Entity_Id := Base_Type (Typ);

   begin
      if In_Instance then
         if Is_Comp
           or else (not Is_Overloaded (Arg)
                     and then Etype (Arg) /= Any_Composite
                     and then Covers (Component_Type (Typ), Etype (Arg)))
         then
            Resolve (Arg, Component_Type (Typ));
         else
            Resolve (Arg, Btyp);
         end if;

      elsif Has_Compatible_Type (Arg, Component_Type (Typ)) then
         if Nkind (Arg) = N_Aggregate
           and then Is_Composite_Type (Component_Type (Typ))
         then
            if Is_Private_Type (Component_Type (Typ)) then
               Resolve (Arg, Btyp);
            else
               Error_Msg_N ("ambiguous aggregate must be qualified", Arg);
               Set_Etype (Arg, Any_Type);
            end if;

         else
            if Is_Overloaded (Arg)
              and then Has_Compatible_Type (Arg, Typ)
              and then Etype (Arg) /= Any_Type
            then
               declare
                  I    : Interp_Index;
                  It   : Interp;
                  Func : Entity_Id;

               begin
                  Get_First_Interp (Arg, I, It);
                  Func := It.Nam;
                  Get_Next_Interp (I, It);

                  --  Special-case the error message when the overloading is
                  --  caused by a function that yields an array and can be
                  --  called without parameters.

                  if It.Nam = Func then
                     Error_Msg_Sloc := Sloc (Func);
                     Error_Msg_N ("ambiguous call to function#", Arg);
                     Error_Msg_NE
                       ("\\interpretation as call yields&", Arg, Typ);
                     Error_Msg_NE
                       ("\\interpretation as indexing of call yields&",
                         Arg, Component_Type (Typ));

                  else
                     Error_Msg_N
                       ("ambiguous operand for concatenation!", Arg);
                     Get_First_Interp (Arg, I, It);
                     while Present (It.Nam) loop
                        Error_Msg_Sloc := Sloc (It.Nam);

                        if Base_Type (It.Typ) = Base_Type (Typ)
                          or else Base_Type (It.Typ) =
                            Base_Type (Component_Type (Typ))
                        then
                           Error_Msg_N ("\\possible interpretation#", Arg);
                        end if;

                        Get_Next_Interp (I, It);
                     end loop;
                  end if;
               end;
            end if;

            Resolve (Arg, Component_Type (Typ));

            if Nkind (Arg) = N_String_Literal then
               Set_Etype (Arg, Component_Type (Typ));
            end if;

            if Arg = Left_Opnd (N) then
               Set_Is_Component_Left_Opnd (N);
            else
               Set_Is_Component_Right_Opnd (N);
            end if;
         end if;

      else
         Resolve (Arg, Btyp);
      end if;

      Check_Unset_Reference (Arg);
   end Resolve_Op_Concat_Arg;

   -----------------------------
   -- Resolve_Op_Concat_First --
   -----------------------------

   procedure Resolve_Op_Concat_First (N : Node_Id; Typ : Entity_Id) is
      Btyp : constant Entity_Id := Base_Type (Typ);
      Op1  : constant Node_Id := Left_Opnd (N);
      Op2  : constant Node_Id := Right_Opnd (N);

   begin
      --  The parser folds an enormous sequence of concatenations of string
      --  literals into "" & "...", where the Is_Folded_In_Parser flag is set
      --  in the right. If the expression resolves to a predefined "&"
      --  operator, all is well. Otherwise, the parser's folding is wrong, so
      --  we give an error. See P_Simple_Expression in Par.Ch4.

      if Nkind (Op2) = N_String_Literal
        and then Is_Folded_In_Parser (Op2)
        and then Ekind (Entity (N)) = E_Function
      then
         pragma Assert (Nkind (Op1) = N_String_Literal  --  should be ""
               and then String_Length (Strval (Op1)) = 0);
         Error_Msg_N ("too many user-defined concatenations", N);
         return;
      end if;

      Set_Etype (N, Btyp);

      if Is_Limited_Composite (Btyp) then
         Error_Msg_N ("concatenation not available for limited array", N);
         Explain_Limited_Type (Btyp, N);
      end if;
   end Resolve_Op_Concat_First;

   ----------------------------
   -- Resolve_Op_Concat_Rest --
   ----------------------------

   procedure Resolve_Op_Concat_Rest (N : Node_Id; Typ : Entity_Id) is
      Op1  : constant Node_Id := Left_Opnd (N);
      Op2  : constant Node_Id := Right_Opnd (N);

   begin
      Resolve_Op_Concat_Arg (N, Op2, Typ, Is_Component_Right_Opnd  (N));

      Generate_Operator_Reference (N, Typ);

      if Is_String_Type (Typ) then
         Eval_Concatenation (N);
      end if;

      --  If this is not a static concatenation, but the result is a
      --  string type (and not an array of strings) ensure that static
      --  string operands have their subtypes properly constructed.

      if Nkind (N) /= N_String_Literal
        and then Is_Character_Type (Component_Type (Typ))
      then
         Set_String_Literal_Subtype (Op1, Typ);
         Set_String_Literal_Subtype (Op2, Typ);
      end if;
   end Resolve_Op_Concat_Rest;

   ----------------------
   -- Resolve_Op_Expon --
   ----------------------

   procedure Resolve_Op_Expon (N : Node_Id; Typ : Entity_Id) is
      B_Typ : constant Entity_Id := Base_Type (Typ);

   begin
      --  Catch attempts to do fixed-point exponentiation with universal
      --  operands, which is a case where the illegality is not caught during
      --  normal operator analysis.

      if Is_Fixed_Point_Type (Typ) and then Comes_From_Source (N) then
         Error_Msg_N ("exponentiation not available for fixed point", N);
         return;
      end if;

      if Comes_From_Source (N)
        and then Ekind (Entity (N)) = E_Function
        and then Is_Imported (Entity (N))
        and then Is_Intrinsic_Subprogram (Entity (N))
      then
         Resolve_Intrinsic_Operator (N, Typ);
         return;
      end if;

      if Etype (Left_Opnd (N)) = Universal_Integer
        or else Etype (Left_Opnd (N)) = Universal_Real
      then
         Check_For_Visible_Operator (N, B_Typ);
      end if;

      --  We do the resolution using the base type, because intermediate values
      --  in expressions always are of the base type, not a subtype of it.

      Resolve (Left_Opnd (N), B_Typ);
      Resolve (Right_Opnd (N), Standard_Integer);

      Check_Unset_Reference (Left_Opnd  (N));
      Check_Unset_Reference (Right_Opnd (N));

      Set_Etype (N, B_Typ);
      Generate_Operator_Reference (N, B_Typ);
      Eval_Op_Expon (N);

      --  Set overflow checking bit. Much cleverer code needed here eventually
      --  and perhaps the Resolve routines should be separated for the various
      --  arithmetic operations, since they will need different processing. ???

      if Nkind (N) in N_Op then
         if not Overflow_Checks_Suppressed (Etype (N)) then
            Enable_Overflow_Check (N);
         end if;
      end if;
   end Resolve_Op_Expon;

   --------------------
   -- Resolve_Op_Not --
   --------------------

   procedure Resolve_Op_Not (N : Node_Id; Typ : Entity_Id) is
      B_Typ : Entity_Id;

      function Parent_Is_Boolean return Boolean;
      --  This function determines if the parent node is a boolean operator
      --  or operation (comparison op, membership test, or short circuit form)
      --  and the not in question is the left operand of this operation.
      --  Note that if the not is in parens, then false is returned.

      -----------------------
      -- Parent_Is_Boolean --
      -----------------------

      function Parent_Is_Boolean return Boolean is
      begin
         if Paren_Count (N) /= 0 then
            return False;

         else
            case Nkind (Parent (N)) is
               when N_Op_And   |
                    N_Op_Eq    |
                    N_Op_Ge    |
                    N_Op_Gt    |
                    N_Op_Le    |
                    N_Op_Lt    |
                    N_Op_Ne    |
                    N_Op_Or    |
                    N_Op_Xor   |
                    N_In       |
                    N_Not_In   |
                    N_And_Then |
                    N_Or_Else  =>

                  return Left_Opnd (Parent (N)) = N;

               when others =>
                  return False;
            end case;
         end if;
      end Parent_Is_Boolean;

   --  Start of processing for Resolve_Op_Not

   begin
      --  Predefined operations on scalar types yield the base type. On the
      --  other hand, logical operations on arrays yield the type of the
      --  arguments (and the context).

      if Is_Array_Type (Typ) then
         B_Typ := Typ;
      else
         B_Typ := Base_Type (Typ);
      end if;

      --  Straightforward case of incorrect arguments

      if not Valid_Boolean_Arg (Typ) then
         Error_Msg_N ("invalid operand type for operator&", N);
         Set_Etype (N, Any_Type);
         return;

      --  Special case of probable missing parens

      elsif Typ = Universal_Integer or else Typ = Any_Modular then
         if Parent_Is_Boolean then
            Error_Msg_N
              ("operand of not must be enclosed in parentheses",
               Right_Opnd (N));
         else
            Error_Msg_N
              ("no modular type available in this context", N);
         end if;

         Set_Etype (N, Any_Type);
         return;

      --  OK resolution of not

      else
         --  Warn if non-boolean types involved. This is a case like not a < b
         --  where a and b are modular, where we will get (not a) < b and most
         --  likely not (a < b) was intended.

         if Warn_On_Questionable_Missing_Parens
           and then not Is_Boolean_Type (Typ)
           and then Parent_Is_Boolean
         then
            Error_Msg_N ("?not expression should be parenthesized here!", N);
         end if;

         --  Warn on double negation if checking redundant constructs

         if Warn_On_Redundant_Constructs
           and then Comes_From_Source (N)
           and then Comes_From_Source (Right_Opnd (N))
           and then Root_Type (Typ) = Standard_Boolean
           and then Nkind (Right_Opnd (N)) = N_Op_Not
         then
            Error_Msg_N ("redundant double negation?", N);
         end if;

         --  Complete resolution and evaluation of NOT

         Resolve (Right_Opnd (N), B_Typ);
         Check_Unset_Reference (Right_Opnd (N));
         Set_Etype (N, B_Typ);
         Generate_Operator_Reference (N, B_Typ);
         Eval_Op_Not (N);
      end if;
   end Resolve_Op_Not;

   -----------------------------
   -- Resolve_Operator_Symbol --
   -----------------------------

   --  Nothing to be done, all resolved already

   procedure Resolve_Operator_Symbol (N : Node_Id; Typ : Entity_Id) is
      pragma Warnings (Off, N);
      pragma Warnings (Off, Typ);

   begin
      null;
   end Resolve_Operator_Symbol;

   ----------------------------------
   -- Resolve_Qualified_Expression --
   ----------------------------------

   procedure Resolve_Qualified_Expression (N : Node_Id; Typ : Entity_Id) is
      pragma Warnings (Off, Typ);

      Target_Typ : constant Entity_Id := Entity (Subtype_Mark (N));
      Expr       : constant Node_Id   := Expression (N);

   begin
      Resolve (Expr, Target_Typ);

      --  A qualified expression requires an exact match of the type,
      --  class-wide matching is not allowed. However, if the qualifying
      --  type is specific and the expression has a class-wide type, it
      --  may still be okay, since it can be the result of the expansion
      --  of a call to a dispatching function, so we also have to check
      --  class-wideness of the type of the expression's original node.

      if (Is_Class_Wide_Type (Target_Typ)
           or else
             (Is_Class_Wide_Type (Etype (Expr))
               and then Is_Class_Wide_Type (Etype (Original_Node (Expr)))))
        and then Base_Type (Etype (Expr)) /= Base_Type (Target_Typ)
      then
         Wrong_Type (Expr, Target_Typ);
      end if;

      --  If the target type is unconstrained, then we reset the type of
      --  the result from the type of the expression. For other cases, the
      --  actual subtype of the expression is the target type.

      if Is_Composite_Type (Target_Typ)
        and then not Is_Constrained (Target_Typ)
      then
         Set_Etype (N, Etype (Expr));
      end if;

      Eval_Qualified_Expression (N);
   end Resolve_Qualified_Expression;

   -------------------
   -- Resolve_Range --
   -------------------

   procedure Resolve_Range (N : Node_Id; Typ : Entity_Id) is
      L : constant Node_Id := Low_Bound (N);
      H : constant Node_Id := High_Bound (N);

   begin
      Set_Etype (N, Typ);
      Resolve (L, Typ);
      Resolve (H, Typ);

      Check_Unset_Reference (L);
      Check_Unset_Reference (H);

      --  We have to check the bounds for being within the base range as
      --  required for a non-static context. Normally this is automatic and
      --  done as part of evaluating expressions, but the N_Range node is an
      --  exception, since in GNAT we consider this node to be a subexpression,
      --  even though in Ada it is not. The circuit in Sem_Eval could check for
      --  this, but that would put the test on the main evaluation path for
      --  expressions.

      Check_Non_Static_Context (L);
      Check_Non_Static_Context (H);

      --  Check for an ambiguous range over character literals. This will
      --  happen with a membership test involving only literals.

      if Typ = Any_Character then
         Ambiguous_Character (L);
         Set_Etype (N, Any_Type);
         return;
      end if;

      --  If bounds are static, constant-fold them, so size computations
      --  are identical between front-end and back-end. Do not perform this
      --  transformation while analyzing generic units, as type information
      --  would then be lost when reanalyzing the constant node in the
      --  instance.

      if Is_Discrete_Type (Typ) and then Expander_Active then
         if Is_OK_Static_Expression (L) then
            Fold_Uint  (L, Expr_Value (L), Is_Static_Expression (L));
         end if;

         if Is_OK_Static_Expression (H) then
            Fold_Uint  (H, Expr_Value (H), Is_Static_Expression (H));
         end if;
      end if;
   end Resolve_Range;

   --------------------------
   -- Resolve_Real_Literal --
   --------------------------

   procedure Resolve_Real_Literal (N : Node_Id; Typ : Entity_Id) is
      Actual_Typ : constant Entity_Id := Etype (N);

   begin
      --  Special processing for fixed-point literals to make sure that the
      --  value is an exact multiple of small where this is required. We
      --  skip this for the universal real case, and also for generic types.

      if Is_Fixed_Point_Type (Typ)
        and then Typ /= Universal_Fixed
        and then Typ /= Any_Fixed
        and then not Is_Generic_Type (Typ)
      then
         declare
            Val   : constant Ureal := Realval (N);
            Cintr : constant Ureal := Val / Small_Value (Typ);
            Cint  : constant Uint  := UR_Trunc (Cintr);
            Den   : constant Uint  := Norm_Den (Cintr);
            Stat  : Boolean;

         begin
            --  Case of literal is not an exact multiple of the Small

            if Den /= 1 then

               --  For a source program literal for a decimal fixed-point
               --  type, this is statically illegal (RM 4.9(36)).

               if Is_Decimal_Fixed_Point_Type (Typ)
                 and then Actual_Typ = Universal_Real
                 and then Comes_From_Source (N)
               then
                  Error_Msg_N ("value has extraneous low order digits", N);
               end if;

               --  Generate a warning if literal from source

               if Is_Static_Expression (N)
                 and then Warn_On_Bad_Fixed_Value
               then
                  Error_Msg_N
                    ("?static fixed-point value is not a multiple of Small!",
                     N);
               end if;

               --  Replace literal by a value that is the exact representation
               --  of a value of the type, i.e. a multiple of the small value,
               --  by truncation, since Machine_Rounds is false for all GNAT
               --  fixed-point types (RM 4.9(38)).

               Stat := Is_Static_Expression (N);
               Rewrite (N,
                 Make_Real_Literal (Sloc (N),
                   Realval => Small_Value (Typ) * Cint));

               Set_Is_Static_Expression (N, Stat);
            end if;

            --  In all cases, set the corresponding integer field

            Set_Corresponding_Integer_Value (N, Cint);
         end;
      end if;

      --  Now replace the actual type by the expected type as usual

      Set_Etype (N, Typ);
      Eval_Real_Literal (N);
   end Resolve_Real_Literal;

   -----------------------
   -- Resolve_Reference --
   -----------------------

   procedure Resolve_Reference (N : Node_Id; Typ : Entity_Id) is
      P : constant Node_Id := Prefix (N);

   begin
      --  Replace general access with specific type

      if Ekind (Etype (N)) = E_Allocator_Type then
         Set_Etype (N, Base_Type (Typ));
      end if;

      Resolve (P, Designated_Type (Etype (N)));

      --  If we are taking the reference of a volatile entity, then treat
      --  it as a potential modification of this entity. This is much too
      --  conservative, but is necessary because remove side effects can
      --  result in transformations of normal assignments into reference
      --  sequences that otherwise fail to notice the modification.

      if Is_Entity_Name (P) and then Treat_As_Volatile (Entity (P)) then
         Note_Possible_Modification (P, Sure => False);
      end if;
   end Resolve_Reference;

   --------------------------------
   -- Resolve_Selected_Component --
   --------------------------------

   procedure Resolve_Selected_Component (N : Node_Id; Typ : Entity_Id) is
      Comp  : Entity_Id;
      Comp1 : Entity_Id        := Empty; -- prevent junk warning
      P     : constant Node_Id := Prefix  (N);
      S     : constant Node_Id := Selector_Name (N);
      T     : Entity_Id        := Etype (P);
      I     : Interp_Index;
      I1    : Interp_Index := 0; -- prevent junk warning
      It    : Interp;
      It1   : Interp;
      Found : Boolean;

      function Init_Component return Boolean;
      --  Check whether this is the initialization of a component within an
      --  init proc (by assignment or call to another init proc). If true,
      --  there is no need for a discriminant check.

      --------------------
      -- Init_Component --
      --------------------

      function Init_Component return Boolean is
      begin
         return Inside_Init_Proc
           and then Nkind (Prefix (N)) = N_Identifier
           and then Chars (Prefix (N)) = Name_uInit
           and then Nkind (Parent (Parent (N))) = N_Case_Statement_Alternative;
      end Init_Component;

   --  Start of processing for Resolve_Selected_Component

   begin
      if Is_Overloaded (P) then

         --  Use the context type to select the prefix that has a selector
         --  of the correct name and type.

         Found := False;
         Get_First_Interp (P, I, It);

         Search : while Present (It.Typ) loop
            if Is_Access_Type (It.Typ) then
               T := Designated_Type (It.Typ);
            else
               T := It.Typ;
            end if;

            if Is_Record_Type (T) then

               --  The visible components of a class-wide type are those of
               --  the root type.

               if Is_Class_Wide_Type (T) then
                  T := Etype (T);
               end if;

               Comp := First_Entity (T);
               while Present (Comp) loop
                  if Chars (Comp) = Chars (S)
                    and then Covers (Etype (Comp), Typ)
                  then
                     if not Found then
                        Found := True;
                        I1  := I;
                        It1 := It;
                        Comp1 := Comp;

                     else
                        It := Disambiguate (P, I1, I, Any_Type);

                        if It = No_Interp then
                           Error_Msg_N
                             ("ambiguous prefix for selected component",  N);
                           Set_Etype (N, Typ);
                           return;

                        else
                           It1 := It;

                           --  There may be an implicit dereference. Retrieve
                           --  designated record type.

                           if Is_Access_Type (It1.Typ) then
                              T := Designated_Type (It1.Typ);
                           else
                              T := It1.Typ;
                           end if;

                           if Scope (Comp1) /= T then

                              --  Resolution chooses the new interpretation.
                              --  Find the component with the right name.

                              Comp1 := First_Entity (T);
                              while Present (Comp1)
                                and then Chars (Comp1) /= Chars (S)
                              loop
                                 Comp1 := Next_Entity (Comp1);
                              end loop;
                           end if;

                           exit Search;
                        end if;
                     end if;
                  end if;

                  Comp := Next_Entity (Comp);
               end loop;

            end if;

            Get_Next_Interp (I, It);
         end loop Search;

         Resolve (P, It1.Typ);
         Set_Etype (N, Typ);
         Set_Entity_With_Style_Check (S, Comp1);

      else
         --  Resolve prefix with its type

         Resolve (P, T);
      end if;

      --  Generate cross-reference. We needed to wait until full overloading
      --  resolution was complete to do this, since otherwise we can't tell if
      --  we are an Lvalue of not.

      if May_Be_Lvalue (N) then
         Generate_Reference (Entity (S), S, 'm');
      else
         Generate_Reference (Entity (S), S, 'r');
      end if;

      --  If prefix is an access type, the node will be transformed into an
      --  explicit dereference during expansion. The type of the node is the
      --  designated type of that of the prefix.

      if Is_Access_Type (Etype (P)) then
         T := Designated_Type (Etype (P));
         Check_Fully_Declared_Prefix (T, P);
      else
         T := Etype (P);
      end if;

      if Has_Discriminants (T)
        and then (Ekind (Entity (S)) = E_Component
                   or else
                  Ekind (Entity (S)) = E_Discriminant)
        and then Present (Original_Record_Component (Entity (S)))
        and then Ekind (Original_Record_Component (Entity (S))) = E_Component
        and then Present (Discriminant_Checking_Func
                           (Original_Record_Component (Entity (S))))
        and then not Discriminant_Checks_Suppressed (T)
        and then not Init_Component
      then
         Set_Do_Discriminant_Check (N);
      end if;

      if Ekind (Entity (S)) = E_Void then
         Error_Msg_N ("premature use of component", S);
      end if;

      --  If the prefix is a record conversion, this may be a renamed
      --  discriminant whose bounds differ from those of the original
      --  one, so we must ensure that a range check is performed.

      if Nkind (P) = N_Type_Conversion
        and then Ekind (Entity (S)) = E_Discriminant
        and then Is_Discrete_Type (Typ)
      then
         Set_Etype (N, Base_Type (Typ));
      end if;

      --  Note: No Eval processing is required, because the prefix is of a
      --  record type, or protected type, and neither can possibly be static.

   end Resolve_Selected_Component;

   -------------------
   -- Resolve_Shift --
   -------------------

   procedure Resolve_Shift (N : Node_Id; Typ : Entity_Id) is
      B_Typ : constant Entity_Id := Base_Type (Typ);
      L     : constant Node_Id   := Left_Opnd  (N);
      R     : constant Node_Id   := Right_Opnd (N);

   begin
      --  We do the resolution using the base type, because intermediate values
      --  in expressions always are of the base type, not a subtype of it.

      Resolve (L, B_Typ);
      Resolve (R, Standard_Natural);

      Check_Unset_Reference (L);
      Check_Unset_Reference (R);

      Set_Etype (N, B_Typ);
      Generate_Operator_Reference (N, B_Typ);
      Eval_Shift (N);
   end Resolve_Shift;

   ---------------------------
   -- Resolve_Short_Circuit --
   ---------------------------

   procedure Resolve_Short_Circuit (N : Node_Id; Typ : Entity_Id) is
      B_Typ : constant Entity_Id := Base_Type (Typ);
      L     : constant Node_Id   := Left_Opnd  (N);
      R     : constant Node_Id   := Right_Opnd (N);

   begin
      Resolve (L, B_Typ);
      Resolve (R, B_Typ);

      --  Check for issuing warning for always False assert/check, this happens
      --  when assertions are turned off, in which case the pragma Assert/Check
      --  was transformed into:

      --     if False and then <condition> then ...

      --  and we detect this pattern

      if Warn_On_Assertion_Failure
        and then Is_Entity_Name (R)
        and then Entity (R) = Standard_False
        and then Nkind (Parent (N)) = N_If_Statement
        and then Nkind (N) = N_And_Then
        and then Is_Entity_Name (L)
        and then Entity (L) = Standard_False
      then
         declare
            Orig : constant Node_Id := Original_Node (Parent (N));

         begin
            if Nkind (Orig) = N_Pragma
              and then Pragma_Name (Orig) = Name_Assert
            then
               --  Don't want to warn if original condition is explicit False

               declare
                  Expr : constant Node_Id :=
                           Original_Node
                             (Expression
                               (First (Pragma_Argument_Associations (Orig))));
               begin
                  if Is_Entity_Name (Expr)
                    and then Entity (Expr) = Standard_False
                  then
                     null;
                  else
                     --  Issue warning. Note that we don't want to make this
                     --  an unconditional warning, because if the assert is
                     --  within deleted code we do not want the warning. But
                     --  we do not want the deletion of the IF/AND-THEN to
                     --  take this message with it. We achieve this by making
                     --  sure that the expanded code points to the Sloc of
                     --  the expression, not the original pragma.

                     Error_Msg_N ("?assertion would fail at run-time", Orig);
                  end if;
               end;

            --  Similar processing for Check pragma

            elsif Nkind (Orig) = N_Pragma
              and then Pragma_Name (Orig) = Name_Check
            then
               --  Don't want to warn if original condition is explicit False

               declare
                  Expr : constant Node_Id :=
                           Original_Node
                             (Expression
                                (Next (First
                                  (Pragma_Argument_Associations (Orig)))));
               begin
                  if Is_Entity_Name (Expr)
                    and then Entity (Expr) = Standard_False
                  then
                     null;
                  else
                     Error_Msg_N ("?check would fail at run-time", Orig);
                  end if;
               end;
            end if;
         end;
      end if;

      --  Continue with processing of short circuit

      Check_Unset_Reference (L);
      Check_Unset_Reference (R);

      Set_Etype (N, B_Typ);
      Eval_Short_Circuit (N);
   end Resolve_Short_Circuit;

   -------------------
   -- Resolve_Slice --
   -------------------

   procedure Resolve_Slice (N : Node_Id; Typ : Entity_Id) is
      Name       : constant Node_Id := Prefix (N);
      Drange     : constant Node_Id := Discrete_Range (N);
      Array_Type : Entity_Id        := Empty;
      Index      : Node_Id;

   begin
      if Is_Overloaded (Name) then

         --  Use the context type to select the prefix that yields the
         --  correct array type.

         declare
            I      : Interp_Index;
            I1     : Interp_Index := 0;
            It     : Interp;
            P      : constant Node_Id := Prefix (N);
            Found  : Boolean := False;

         begin
            Get_First_Interp (P, I,  It);
            while Present (It.Typ) loop
               if (Is_Array_Type (It.Typ)
                    and then Covers (Typ,  It.Typ))
                 or else (Is_Access_Type (It.Typ)
                           and then Is_Array_Type (Designated_Type (It.Typ))
                           and then Covers (Typ, Designated_Type (It.Typ)))
               then
                  if Found then
                     It := Disambiguate (P, I1, I, Any_Type);

                     if It = No_Interp then
                        Error_Msg_N ("ambiguous prefix for slicing",  N);
                        Set_Etype (N, Typ);
                        return;
                     else
                        Found := True;
                        Array_Type := It.Typ;
                        I1 := I;
                     end if;
                  else
                     Found := True;
                     Array_Type := It.Typ;
                     I1 := I;
                  end if;
               end if;

               Get_Next_Interp (I, It);
            end loop;
         end;

      else
         Array_Type := Etype (Name);
      end if;

      Resolve (Name, Array_Type);

      if Is_Access_Type (Array_Type) then
         Apply_Access_Check (N);
         Array_Type := Designated_Type (Array_Type);

         --  If the prefix is an access to an unconstrained array, we must use
         --  the actual subtype of the object to perform the index checks. The
         --  object denoted by the prefix is implicit in the node, so we build
         --  an explicit representation for it in order to compute the actual
         --  subtype.

         if not Is_Constrained (Array_Type) then
            Remove_Side_Effects (Prefix (N));

            declare
               Obj : constant Node_Id :=
                       Make_Explicit_Dereference (Sloc (N),
                         Prefix => New_Copy_Tree (Prefix (N)));
            begin
               Set_Etype (Obj, Array_Type);
               Set_Parent (Obj, Parent (N));
               Array_Type := Get_Actual_Subtype (Obj);
            end;
         end if;

      elsif Is_Entity_Name (Name)
        or else (Nkind (Name) = N_Function_Call
                  and then not Is_Constrained (Etype (Name)))
      then
         Array_Type := Get_Actual_Subtype (Name);

      --  If the name is a selected component that depends on discriminants,
      --  build an actual subtype for it. This can happen only when the name
      --  itself is overloaded; otherwise the actual subtype is created when
      --  the selected component is analyzed.

      elsif Nkind (Name) = N_Selected_Component
        and then Full_Analysis
        and then Depends_On_Discriminant (First_Index (Array_Type))
      then
         declare
            Act_Decl : constant Node_Id :=
                         Build_Actual_Subtype_Of_Component (Array_Type, Name);
         begin
            Insert_Action (N, Act_Decl);
            Array_Type := Defining_Identifier (Act_Decl);
         end;
      end if;

      --  If name was overloaded, set slice type correctly now

      Set_Etype (N, Array_Type);

      --  If the range is specified by a subtype mark, no resolution is
      --  necessary. Else resolve the bounds, and apply needed checks.

      if not Is_Entity_Name (Drange) then
         Index := First_Index (Array_Type);
         Resolve (Drange, Base_Type (Etype (Index)));

         if Nkind (Drange) = N_Range

            --  Do not apply the range check to nodes associated with the
            --  frontend expansion of the dispatch table. We first check
            --  if Ada.Tags is already loaded to void the addition of an
            --  undesired dependence on such run-time unit.

           and then
             (VM_Target /= No_VM
              or else not
                (RTU_Loaded (Ada_Tags)
                  and then Nkind (Prefix (N)) = N_Selected_Component
                  and then Present (Entity (Selector_Name (Prefix (N))))
                  and then Entity (Selector_Name (Prefix (N))) =
                                        RTE_Record_Component (RE_Prims_Ptr)))
         then
            Apply_Range_Check (Drange, Etype (Index));
         end if;
      end if;

      Set_Slice_Subtype (N);

      if Nkind (Drange) = N_Range then
         Warn_On_Suspicious_Index (Name, Low_Bound  (Drange));
         Warn_On_Suspicious_Index (Name, High_Bound (Drange));
      end if;

      Eval_Slice (N);
   end Resolve_Slice;

   ----------------------------
   -- Resolve_String_Literal --
   ----------------------------

   procedure Resolve_String_Literal (N : Node_Id; Typ : Entity_Id) is
      C_Typ      : constant Entity_Id  := Component_Type (Typ);
      R_Typ      : constant Entity_Id  := Root_Type (C_Typ);
      Loc        : constant Source_Ptr := Sloc (N);
      Str        : constant String_Id  := Strval (N);
      Strlen     : constant Nat        := String_Length (Str);
      Subtype_Id : Entity_Id;
      Need_Check : Boolean;

   begin
      --  For a string appearing in a concatenation, defer creation of the
      --  string_literal_subtype until the end of the resolution of the
      --  concatenation, because the literal may be constant-folded away. This
      --  is a useful optimization for long concatenation expressions.

      --  If the string is an aggregate built for a single character (which
      --  happens in a non-static context) or a is null string to which special
      --  checks may apply, we build the subtype. Wide strings must also get a
      --  string subtype if they come from a one character aggregate. Strings
      --  generated by attributes might be static, but it is often hard to
      --  determine whether the enclosing context is static, so we generate
      --  subtypes for them as well, thus losing some rarer optimizations ???
      --  Same for strings that come from a static conversion.

      Need_Check :=
        (Strlen = 0 and then Typ /= Standard_String)
          or else Nkind (Parent (N)) /= N_Op_Concat
          or else (N /= Left_Opnd (Parent (N))
                    and then N /= Right_Opnd (Parent (N)))
          or else ((Typ = Standard_Wide_String
                      or else Typ = Standard_Wide_Wide_String)
                    and then Nkind (Original_Node (N)) /= N_String_Literal);

      --  If the resolving type is itself a string literal subtype, we
      --  can just reuse it, since there is no point in creating another.

      if Ekind (Typ) = E_String_Literal_Subtype then
         Subtype_Id := Typ;

      elsif Nkind (Parent (N)) = N_Op_Concat
        and then not Need_Check
        and then not Nkind_In (Original_Node (N), N_Character_Literal,
                                                  N_Attribute_Reference,
                                                  N_Qualified_Expression,
                                                  N_Type_Conversion)
      then
         Subtype_Id := Typ;

      --  Otherwise we must create a string literal subtype. Note that the
      --  whole idea of string literal subtypes is simply to avoid the need
      --  for building a full fledged array subtype for each literal.

      else
         Set_String_Literal_Subtype (N, Typ);
         Subtype_Id := Etype (N);
      end if;

      if Nkind (Parent (N)) /= N_Op_Concat
        or else Need_Check
      then
         Set_Etype (N, Subtype_Id);
         Eval_String_Literal (N);
      end if;

      if Is_Limited_Composite (Typ)
        or else Is_Private_Composite (Typ)
      then
         Error_Msg_N ("string literal not available for private array", N);
         Set_Etype (N, Any_Type);
         return;
      end if;

      --  The validity of a null string has been checked in the
      --  call to  Eval_String_Literal.

      if Strlen = 0 then
         return;

      --  Always accept string literal with component type Any_Character, which
      --  occurs in error situations and in comparisons of literals, both of
      --  which should accept all literals.

      elsif R_Typ = Any_Character then
         return;

      --  If the type is bit-packed, then we always transform the string
      --  literal into a full fledged aggregate.

      elsif Is_Bit_Packed_Array (Typ) then
         null;

      --  Deal with cases of Wide_Wide_String, Wide_String, and String

      else
         --  For Standard.Wide_Wide_String, or any other type whose component
         --  type is Standard.Wide_Wide_Character, we know that all the
         --  characters in the string must be acceptable, since the parser
         --  accepted the characters as valid character literals.

         if R_Typ = Standard_Wide_Wide_Character then
            null;

         --  For the case of Standard.String, or any other type whose component
         --  type is Standard.Character, we must make sure that there are no
         --  wide characters in the string, i.e. that it is entirely composed
         --  of characters in range of type Character.

         --  If the string literal is the result of a static concatenation, the
         --  test has already been performed on the components, and need not be
         --  repeated.

         elsif R_Typ = Standard_Character
           and then Nkind (Original_Node (N)) /= N_Op_Concat
         then
            for J in 1 .. Strlen loop
               if not In_Character_Range (Get_String_Char (Str, J)) then

                  --  If we are out of range, post error. This is one of the
                  --  very few places that we place the flag in the middle of
                  --  a token, right under the offending wide character.

                  Error_Msg
                    ("literal out of range of type Standard.Character",
                     Source_Ptr (Int (Loc) + J));
                  return;
               end if;
            end loop;

         --  For the case of Standard.Wide_String, or any other type whose
         --  component type is Standard.Wide_Character, we must make sure that
         --  there are no wide characters in the string, i.e. that it is
         --  entirely composed of characters in range of type Wide_Character.

         --  If the string literal is the result of a static concatenation,
         --  the test has already been performed on the components, and need
         --  not be repeated.

         elsif R_Typ = Standard_Wide_Character
           and then Nkind (Original_Node (N)) /= N_Op_Concat
         then
            for J in 1 .. Strlen loop
               if not In_Wide_Character_Range (Get_String_Char (Str, J)) then

                  --  If we are out of range, post error. This is one of the
                  --  very few places that we place the flag in the middle of
                  --  a token, right under the offending wide character.

                  --  This is not quite right, because characters in general
                  --  will take more than one character position ???

                  Error_Msg
                    ("literal out of range of type Standard.Wide_Character",
                     Source_Ptr (Int (Loc) + J));
                  return;
               end if;
            end loop;

         --  If the root type is not a standard character, then we will convert
         --  the string into an aggregate and will let the aggregate code do
         --  the checking. Standard Wide_Wide_Character is also OK here.

         else
            null;
         end if;

         --  See if the component type of the array corresponding to the string
         --  has compile time known bounds. If yes we can directly check
         --  whether the evaluation of the string will raise constraint error.
         --  Otherwise we need to transform the string literal into the
         --  corresponding character aggregate and let the aggregate
         --  code do the checking.

         if Is_Standard_Character_Type (R_Typ) then

            --  Check for the case of full range, where we are definitely OK

            if Component_Type (Typ) = Base_Type (Component_Type (Typ)) then
               return;
            end if;

            --  Here the range is not the complete base type range, so check

            declare
               Comp_Typ_Lo : constant Node_Id :=
                               Type_Low_Bound (Component_Type (Typ));
               Comp_Typ_Hi : constant Node_Id :=
                               Type_High_Bound (Component_Type (Typ));

               Char_Val : Uint;

            begin
               if Compile_Time_Known_Value (Comp_Typ_Lo)
                 and then Compile_Time_Known_Value (Comp_Typ_Hi)
               then
                  for J in 1 .. Strlen loop
                     Char_Val := UI_From_Int (Int (Get_String_Char (Str, J)));

                     if Char_Val < Expr_Value (Comp_Typ_Lo)
                       or else Char_Val > Expr_Value (Comp_Typ_Hi)
                     then
                        Apply_Compile_Time_Constraint_Error
                          (N, "character out of range?", CE_Range_Check_Failed,
                           Loc => Source_Ptr (Int (Loc) + J));
                     end if;
                  end loop;

                  return;
               end if;
            end;
         end if;
      end if;

      --  If we got here we meed to transform the string literal into the
      --  equivalent qualified positional array aggregate. This is rather
      --  heavy artillery for this situation, but it is hard work to avoid.

      declare
         Lits : constant List_Id    := New_List;
         P    : Source_Ptr := Loc + 1;
         C    : Char_Code;

      begin
         --  Build the character literals, we give them source locations that
         --  correspond to the string positions, which is a bit tricky given
         --  the possible presence of wide character escape sequences.

         for J in 1 .. Strlen loop
            C := Get_String_Char (Str, J);
            Set_Character_Literal_Name (C);

            Append_To (Lits,
              Make_Character_Literal (P,
                Chars              => Name_Find,
                Char_Literal_Value => UI_From_CC (C)));

            if In_Character_Range (C) then
               P := P + 1;

            --  Should we have a call to Skip_Wide here ???
            --  ???     else
            --             Skip_Wide (P);

            end if;
         end loop;

         Rewrite (N,
           Make_Qualified_Expression (Loc,
             Subtype_Mark => New_Reference_To (Typ, Loc),
             Expression   =>
               Make_Aggregate (Loc, Expressions => Lits)));

         Analyze_And_Resolve (N, Typ);
      end;
   end Resolve_String_Literal;

   -----------------------------
   -- Resolve_Subprogram_Info --
   -----------------------------

   procedure Resolve_Subprogram_Info (N : Node_Id; Typ : Entity_Id) is
   begin
      Set_Etype (N, Typ);
   end Resolve_Subprogram_Info;

   -----------------------------
   -- Resolve_Type_Conversion --
   -----------------------------

   procedure Resolve_Type_Conversion (N : Node_Id; Typ : Entity_Id) is
      Conv_OK     : constant Boolean := Conversion_OK (N);
      Operand     : constant Node_Id := Expression (N);
      Operand_Typ : constant Entity_Id := Etype (Operand);
      Target_Typ  : constant Entity_Id := Etype (N);
      Rop         : Node_Id;
      Orig_N      : Node_Id;
      Orig_T      : Node_Id;

   begin
      if not Conv_OK
        and then not Valid_Conversion (N, Target_Typ, Operand)
      then
         return;
      end if;

      if Etype (Operand) = Any_Fixed then

         --  Mixed-mode operation involving a literal. Context must be a fixed
         --  type which is applied to the literal subsequently.

         if Is_Fixed_Point_Type (Typ) then
            Set_Etype (Operand, Universal_Real);

         elsif Is_Numeric_Type (Typ)
           and then Nkind_In (Operand, N_Op_Multiply, N_Op_Divide)
           and then (Etype (Right_Opnd (Operand)) = Universal_Real
                       or else
                     Etype (Left_Opnd  (Operand)) = Universal_Real)
         then
            --  Return if expression is ambiguous

            if Unique_Fixed_Point_Type (N) = Any_Type then
               return;

            --  If nothing else, the available fixed type is Duration

            else
               Set_Etype (Operand, Standard_Duration);
            end if;

            --  Resolve the real operand with largest available precision

            if Etype (Right_Opnd (Operand)) = Universal_Real then
               Rop := New_Copy_Tree (Right_Opnd (Operand));
            else
               Rop := New_Copy_Tree (Left_Opnd (Operand));
            end if;

            Resolve (Rop, Universal_Real);

            --  If the operand is a literal (it could be a non-static and
            --  illegal exponentiation) check whether the use of Duration
            --  is potentially inaccurate.

            if Nkind (Rop) = N_Real_Literal
              and then Realval (Rop) /= Ureal_0
              and then abs (Realval (Rop)) < Delta_Value (Standard_Duration)
            then
               Error_Msg_N
                 ("?universal real operand can only " &
                  "be interpreted as Duration!",
                  Rop);
               Error_Msg_N
                 ("\?precision will be lost in the conversion!", Rop);
            end if;

         elsif Is_Numeric_Type (Typ)
           and then Nkind (Operand) in N_Op
           and then Unique_Fixed_Point_Type (N) /= Any_Type
         then
            Set_Etype (Operand, Standard_Duration);

         else
            Error_Msg_N ("invalid context for mixed mode operation", N);
            Set_Etype (Operand, Any_Type);
            return;
         end if;
      end if;

      Resolve (Operand);

      --  Note: we do the Eval_Type_Conversion call before applying the
      --  required checks for a subtype conversion. This is important,
      --  since both are prepared under certain circumstances to change
      --  the type conversion to a constraint error node, but in the case
      --  of Eval_Type_Conversion this may reflect an illegality in the
      --  static case, and we would miss the illegality (getting only a
      --  warning message), if we applied the type conversion checks first.

      Eval_Type_Conversion (N);

      --  Even when evaluation is not possible, we may be able to simplify
      --  the conversion or its expression. This needs to be done before
      --  applying checks, since otherwise the checks may use the original
      --  expression and defeat the simplifications. This is specifically
      --  the case for elimination of the floating-point Truncation
      --  attribute in float-to-int conversions.

      Simplify_Type_Conversion (N);

      --  If after evaluation we still have a type conversion, then we
      --  may need to apply checks required for a subtype conversion.

      --  Skip these type conversion checks if universal fixed operands
      --  operands involved, since range checks are handled separately for
      --  these cases (in the appropriate Expand routines in unit Exp_Fixd).

      if Nkind (N) = N_Type_Conversion
        and then not Is_Generic_Type (Root_Type (Target_Typ))
        and then Target_Typ  /= Universal_Fixed
        and then Operand_Typ /= Universal_Fixed
      then
         Apply_Type_Conversion_Checks (N);
      end if;

      --  Issue warning for conversion of simple object to its own type
      --  We have to test the original nodes, since they may have been
      --  rewritten by various optimizations.

      Orig_N := Original_Node (N);

      if Warn_On_Redundant_Constructs
        and then Comes_From_Source (Orig_N)
        and then Nkind (Orig_N) = N_Type_Conversion
        and then not In_Instance
      then
         Orig_N := Original_Node (Expression (Orig_N));
         Orig_T := Target_Typ;

         --  If the node is part of a larger expression, the Target_Type
         --  may not be the original type of the node if the context is a
         --  condition. Recover original type to see if conversion is needed.

         if Is_Boolean_Type (Orig_T)
          and then Nkind (Parent (N)) in N_Op
         then
            Orig_T := Etype (Parent (N));
         end if;

         if Is_Entity_Name (Orig_N)
           and then
             (Etype (Entity (Orig_N)) = Orig_T
                or else
                  (Ekind (Entity (Orig_N)) = E_Loop_Parameter
                     and then Covers (Orig_T, Etype (Entity (Orig_N)))))
         then
            Error_Msg_Node_2 := Orig_T;
            Error_Msg_NE
              ("?redundant conversion, & is of type &!", N, Entity (Orig_N));
         end if;
      end if;

      --  Ada 2005 (AI-251): Handle class-wide interface type conversions.
      --  No need to perform any interface conversion if the type of the
      --  expression coincides with the target type.

      if Ada_Version >= Ada_05
        and then Expander_Active
        and then Operand_Typ /= Target_Typ
      then
         declare
            Opnd   : Entity_Id := Operand_Typ;
            Target : Entity_Id := Target_Typ;

         begin
            if Is_Access_Type (Opnd) then
               Opnd := Directly_Designated_Type (Opnd);
            end if;

            if Is_Access_Type (Target_Typ) then
               Target := Directly_Designated_Type (Target);
            end if;

            if Opnd = Target then
               null;

            --  Conversion from interface type

            elsif Is_Interface (Opnd) then

               --  Ada 2005 (AI-217): Handle entities from limited views

               if From_With_Type (Opnd) then
                  Error_Msg_Qual_Level := 99;
                  Error_Msg_NE ("missing with-clause on package &", N,
                    Cunit_Entity (Get_Source_Unit (Base_Type (Opnd))));
                  Error_Msg_N
                    ("type conversions require visibility of the full view",
                     N);

               elsif From_With_Type (Target)
                 and then not
                   (Is_Access_Type (Target_Typ)
                      and then Present (Non_Limited_View (Etype (Target))))
               then
                  Error_Msg_Qual_Level := 99;
                  Error_Msg_NE ("missing with-clause on package &", N,
                    Cunit_Entity (Get_Source_Unit (Base_Type (Target))));
                  Error_Msg_N
                    ("type conversions require visibility of the full view",
                     N);

               else
                  Expand_Interface_Conversion (N, Is_Static => False);
               end if;

            --  Conversion to interface type

            elsif Is_Interface (Target) then

               --  Handle subtypes

               if Ekind (Opnd) = E_Protected_Subtype
                 or else Ekind (Opnd) = E_Task_Subtype
               then
                  Opnd := Etype (Opnd);
               end if;

               if not Interface_Present_In_Ancestor
                        (Typ   => Opnd,
                         Iface => Target)
               then
                  if Is_Class_Wide_Type (Opnd) then

                     --  The static analysis is not enough to know if the
                     --  interface is implemented or not. Hence we must pass
                     --  the work to the expander to generate code to evaluate
                     --  the conversion at run-time.

                     Expand_Interface_Conversion (N, Is_Static => False);

                  else
                     Error_Msg_Name_1 := Chars (Etype (Target));
                     Error_Msg_Name_2 := Chars (Opnd);
                     Error_Msg_N
                       ("wrong interface conversion (% is not a progenitor " &
                        "of %)", N);
                  end if;

               else
                  Expand_Interface_Conversion (N);
               end if;
            end if;
         end;
      end if;
   end Resolve_Type_Conversion;

   ----------------------
   -- Resolve_Unary_Op --
   ----------------------

   procedure Resolve_Unary_Op (N : Node_Id; Typ : Entity_Id) is
      B_Typ : constant Entity_Id := Base_Type (Typ);
      R     : constant Node_Id   := Right_Opnd (N);
      OK    : Boolean;
      Lo    : Uint;
      Hi    : Uint;

   begin
      --  Deal with intrinsic unary operators

      if Comes_From_Source (N)
        and then Ekind (Entity (N)) = E_Function
        and then Is_Imported (Entity (N))
        and then Is_Intrinsic_Subprogram (Entity (N))
      then
         Resolve_Intrinsic_Unary_Operator (N, Typ);
         return;
      end if;

      --  Deal with universal cases

      if Etype (R) = Universal_Integer
           or else
         Etype (R) = Universal_Real
      then
         Check_For_Visible_Operator (N, B_Typ);
      end if;

      Set_Etype (N, B_Typ);
      Resolve (R, B_Typ);

      --  Generate warning for expressions like abs (x mod 2)

      if Warn_On_Redundant_Constructs
        and then Nkind (N) = N_Op_Abs
      then
         Determine_Range (Right_Opnd (N), OK, Lo, Hi);

         if OK and then Hi >= Lo and then Lo >= 0 then
            Error_Msg_N
             ("?abs applied to known non-negative value has no effect", N);
         end if;
      end if;

      --  Deal with reference generation

      Check_Unset_Reference (R);
      Generate_Operator_Reference (N, B_Typ);
      Eval_Unary_Op (N);

      --  Set overflow checking bit. Much cleverer code needed here eventually
      --  and perhaps the Resolve routines should be separated for the various
      --  arithmetic operations, since they will need different processing ???

      if Nkind (N) in N_Op then
         if not Overflow_Checks_Suppressed (Etype (N)) then
            Enable_Overflow_Check (N);
         end if;
      end if;

      --  Generate warning for expressions like -5 mod 3 for integers. No
      --  need to worry in the floating-point case, since parens do not affect
      --  the result so there is no point in giving in a warning.

      declare
         Norig : constant Node_Id := Original_Node (N);
         Rorig : Node_Id;
         Val   : Uint;
         HB    : Uint;
         LB    : Uint;
         Lval  : Uint;
         Opnd  : Node_Id;

      begin
         if Warn_On_Questionable_Missing_Parens
           and then Comes_From_Source (Norig)
           and then Is_Integer_Type (Typ)
           and then Nkind (Norig) = N_Op_Minus
         then
            Rorig := Original_Node (Right_Opnd (Norig));

            --  We are looking for cases where the right operand is not
            --  parenthesized, and is a binary operator, multiply, divide, or
            --  mod. These are the cases where the grouping can affect results.

            if Paren_Count (Rorig) = 0
              and then Nkind_In (Rorig, N_Op_Mod, N_Op_Multiply, N_Op_Divide)
            then
               --  For mod, we always give the warning, since the value is
               --  affected by the parenthesization (e.g. (-5) mod 315 /=
               --  (5 mod 315)). But for the other cases, the only concern is
               --  overflow, e.g. for the case of 8 big signed (-(2 * 64)
               --  overflows, but (-2) * 64 does not). So we try to give the
               --  message only when overflow is possible.

               if Nkind (Rorig) /= N_Op_Mod
                 and then Compile_Time_Known_Value (R)
               then
                  Val := Expr_Value (R);

                  if Compile_Time_Known_Value (Type_High_Bound (Typ)) then
                     HB := Expr_Value (Type_High_Bound (Typ));
                  else
                     HB := Expr_Value (Type_High_Bound (Base_Type (Typ)));
                  end if;

                  if Compile_Time_Known_Value (Type_Low_Bound (Typ)) then
                     LB := Expr_Value (Type_Low_Bound (Typ));
                  else
                     LB := Expr_Value (Type_Low_Bound (Base_Type (Typ)));
                  end if;

                  --  Note that the test below is deliberately excluding
                  --  the largest negative number, since that is a potentially
                  --  troublesome case (e.g. -2 * x, where the result is the
                  --  largest negative integer has an overflow with 2 * x).

                  if Val > LB and then Val <= HB then
                     return;
                  end if;
               end if;

               --  For the multiplication case, the only case we have to worry
               --  about is when (-a)*b is exactly the largest negative number
               --  so that -(a*b) can cause overflow. This can only happen if
               --  a is a power of 2, and more generally if any operand is a
               --  constant that is not a power of 2, then the parentheses
               --  cannot affect whether overflow occurs. We only bother to
               --  test the left most operand

               --  Loop looking at left operands for one that has known value

               Opnd := Rorig;
               Opnd_Loop : while Nkind (Opnd) = N_Op_Multiply loop
                  if Compile_Time_Known_Value (Left_Opnd (Opnd)) then
                     Lval := UI_Abs (Expr_Value (Left_Opnd (Opnd)));

                     --  Operand value of 0 or 1 skips warning

                     if Lval <= 1 then
                        return;

                     --  Otherwise check power of 2, if power of 2, warn, if
                     --  anything else, skip warning.

                     else
                        while Lval /= 2 loop
                           if Lval mod 2 = 1 then
                              return;
                           else
                              Lval := Lval / 2;
                           end if;
                        end loop;

                        exit Opnd_Loop;
                     end if;
                  end if;

                  --  Keep looking at left operands

                  Opnd := Left_Opnd (Opnd);
               end loop Opnd_Loop;

               --  For rem or "/" we can only have a problematic situation
               --  if the divisor has a value of minus one or one. Otherwise
               --  overflow is impossible (divisor > 1) or we have a case of
               --  division by zero in any case.

               if Nkind_In (Rorig, N_Op_Divide, N_Op_Rem)
                 and then Compile_Time_Known_Value (Right_Opnd (Rorig))
                 and then UI_Abs (Expr_Value (Right_Opnd (Rorig))) /= 1
               then
                  return;
               end if;

               --  If we fall through warning should be issued

               Error_Msg_N
                 ("?unary minus expression should be parenthesized here!", N);
            end if;
         end if;
      end;
   end Resolve_Unary_Op;

   ----------------------------------
   -- Resolve_Unchecked_Expression --
   ----------------------------------

   procedure Resolve_Unchecked_Expression
     (N   : Node_Id;
      Typ : Entity_Id)
   is
   begin
      Resolve (Expression (N), Typ, Suppress => All_Checks);
      Set_Etype (N, Typ);
   end Resolve_Unchecked_Expression;

   ---------------------------------------
   -- Resolve_Unchecked_Type_Conversion --
   ---------------------------------------

   procedure Resolve_Unchecked_Type_Conversion
     (N   : Node_Id;
      Typ : Entity_Id)
   is
      pragma Warnings (Off, Typ);

      Operand   : constant Node_Id   := Expression (N);
      Opnd_Type : constant Entity_Id := Etype (Operand);

   begin
      --  Resolve operand using its own type

      Resolve (Operand, Opnd_Type);
      Eval_Unchecked_Conversion (N);

   end Resolve_Unchecked_Type_Conversion;

   ------------------------------
   -- Rewrite_Operator_As_Call --
   ------------------------------

   procedure Rewrite_Operator_As_Call (N : Node_Id; Nam : Entity_Id) is
      Loc     : constant Source_Ptr := Sloc (N);
      Actuals : constant List_Id    := New_List;
      New_N   : Node_Id;

   begin
      if Nkind (N) in  N_Binary_Op then
         Append (Left_Opnd (N), Actuals);
      end if;

      Append (Right_Opnd (N), Actuals);

      New_N :=
        Make_Function_Call (Sloc => Loc,
          Name => New_Occurrence_Of (Nam, Loc),
          Parameter_Associations => Actuals);

      Preserve_Comes_From_Source (New_N, N);
      Preserve_Comes_From_Source (Name (New_N), N);
      Rewrite (N, New_N);
      Set_Etype (N, Etype (Nam));
   end Rewrite_Operator_As_Call;

   ------------------------------
   -- Rewrite_Renamed_Operator --
   ------------------------------

   procedure Rewrite_Renamed_Operator
     (N   : Node_Id;
      Op  : Entity_Id;
      Typ : Entity_Id)
   is
      Nam       : constant Name_Id := Chars (Op);
      Is_Binary : constant Boolean := Nkind (N) in N_Binary_Op;
      Op_Node   : Node_Id;

   begin
      --  Rewrite the operator node using the real operator, not its
      --  renaming. Exclude user-defined intrinsic operations of the same
      --  name, which are treated separately and rewritten as calls.

      if Ekind (Op) /= E_Function
        or else Chars (N) /= Nam
      then
         Op_Node := New_Node (Operator_Kind (Nam, Is_Binary), Sloc (N));
         Set_Chars      (Op_Node, Nam);
         Set_Etype      (Op_Node, Etype (N));
         Set_Entity     (Op_Node, Op);
         Set_Right_Opnd (Op_Node, Right_Opnd (N));

         --  Indicate that both the original entity and its renaming are
         --  referenced at this point.

         Generate_Reference (Entity (N), N);
         Generate_Reference (Op, N);

         if Is_Binary then
            Set_Left_Opnd  (Op_Node, Left_Opnd  (N));
         end if;

         Rewrite (N, Op_Node);

         --  If the context type is private, add the appropriate conversions
         --  so that the operator is applied to the full view. This is done
         --  in the routines that resolve intrinsic operators,

         if Is_Intrinsic_Subprogram (Op)
           and then Is_Private_Type (Typ)
         then
            case Nkind (N) is
               when N_Op_Add   | N_Op_Subtract | N_Op_Multiply | N_Op_Divide |
                    N_Op_Expon | N_Op_Mod      | N_Op_Rem      =>
                  Resolve_Intrinsic_Operator (N, Typ);

               when N_Op_Plus | N_Op_Minus    | N_Op_Abs      =>
                  Resolve_Intrinsic_Unary_Operator (N, Typ);

               when others =>
                  Resolve (N, Typ);
            end case;
         end if;

      elsif Ekind (Op) = E_Function
        and then Is_Intrinsic_Subprogram (Op)
      then
         --  Operator renames a user-defined operator of the same name. Use
         --  the original operator in the node, which is the one that Gigi
         --  knows about.

         Set_Entity (N, Op);
         Set_Is_Overloaded (N, False);
      end if;
   end Rewrite_Renamed_Operator;

   -----------------------
   -- Set_Slice_Subtype --
   -----------------------

   --  Build an implicit subtype declaration to represent the type delivered
   --  by the slice. This is an abbreviated version of an array subtype. We
   --  define an index subtype for the slice, using either the subtype name
   --  or the discrete range of the slice. To be consistent with index usage
   --  elsewhere, we create a list header to hold the single index. This list
   --  is not otherwise attached to the syntax tree.

   procedure Set_Slice_Subtype (N : Node_Id) is
      Loc           : constant Source_Ptr := Sloc (N);
      Index_List    : constant List_Id    := New_List;
      Index         : Node_Id;
      Index_Subtype : Entity_Id;
      Index_Type    : Entity_Id;
      Slice_Subtype : Entity_Id;
      Drange        : constant Node_Id := Discrete_Range (N);

   begin
      if Is_Entity_Name (Drange) then
         Index_Subtype := Entity (Drange);

      else
         --  We force the evaluation of a range. This is definitely needed in
         --  the renamed case, and seems safer to do unconditionally. Note in
         --  any case that since we will create and insert an Itype referring
         --  to this range, we must make sure any side effect removal actions
         --  are inserted before the Itype definition.

         if Nkind (Drange) = N_Range then
            Force_Evaluation (Low_Bound (Drange));
            Force_Evaluation (High_Bound (Drange));
         end if;

         Index_Type := Base_Type (Etype (Drange));

         Index_Subtype := Create_Itype (Subtype_Kind (Ekind (Index_Type)), N);

         Set_Scalar_Range (Index_Subtype, Drange);
         Set_Etype        (Index_Subtype, Index_Type);
         Set_Size_Info    (Index_Subtype, Index_Type);
         Set_RM_Size      (Index_Subtype, RM_Size (Index_Type));
      end if;

      Slice_Subtype := Create_Itype (E_Array_Subtype, N);

      Index := New_Occurrence_Of (Index_Subtype, Loc);
      Set_Etype (Index, Index_Subtype);
      Append (Index, Index_List);

      Set_First_Index    (Slice_Subtype, Index);
      Set_Etype          (Slice_Subtype, Base_Type (Etype (N)));
      Set_Is_Constrained (Slice_Subtype, True);

      Check_Compile_Time_Size (Slice_Subtype);

      --  The Etype of the existing Slice node is reset to this slice subtype.
      --  Its bounds are obtained from its first index.

      Set_Etype (N, Slice_Subtype);

      --  In the packed case, this must be immediately frozen

      --  Couldn't we always freeze here??? and if we did, then the above
      --  call to Check_Compile_Time_Size could be eliminated, which would
      --  be nice, because then that routine could be made private to Freeze.

      --  Why the test for In_Spec_Expression here ???

      if Is_Packed (Slice_Subtype) and not In_Spec_Expression then
         Freeze_Itype (Slice_Subtype, N);
      end if;

   end Set_Slice_Subtype;

   --------------------------------
   -- Set_String_Literal_Subtype --
   --------------------------------

   procedure Set_String_Literal_Subtype (N : Node_Id; Typ : Entity_Id) is
      Loc        : constant Source_Ptr := Sloc (N);
      Low_Bound  : constant Node_Id :=
                        Type_Low_Bound (Etype (First_Index (Typ)));
      Subtype_Id : Entity_Id;

   begin
      if Nkind (N) /= N_String_Literal then
         return;
      end if;

      Subtype_Id := Create_Itype (E_String_Literal_Subtype, N);
      Set_String_Literal_Length (Subtype_Id, UI_From_Int
                                               (String_Length (Strval (N))));
      Set_Etype          (Subtype_Id, Base_Type (Typ));
      Set_Is_Constrained (Subtype_Id);
      Set_Etype          (N, Subtype_Id);

      if Is_OK_Static_Expression (Low_Bound) then

      --  The low bound is set from the low bound of the corresponding
      --  index type. Note that we do not store the high bound in the
      --  string literal subtype, but it can be deduced if necessary
      --  from the length and the low bound.

         Set_String_Literal_Low_Bound (Subtype_Id, Low_Bound);

      else
         Set_String_Literal_Low_Bound
           (Subtype_Id, Make_Integer_Literal (Loc, 1));
         Set_Etype (String_Literal_Low_Bound (Subtype_Id), Standard_Positive);

         --  Build bona fide subtype for the string, and wrap it in an
         --  unchecked conversion, because the backend expects the
         --  String_Literal_Subtype to have a static lower bound.

         declare
            Index_List    : constant List_Id    := New_List;
            Index_Type    : constant Entity_Id := Etype (First_Index (Typ));
            High_Bound    : constant Node_Id :=
                               Make_Op_Add (Loc,
                                  Left_Opnd => New_Copy_Tree (Low_Bound),
                                  Right_Opnd =>
                                    Make_Integer_Literal (Loc,
                                      String_Length (Strval (N)) - 1));
            Array_Subtype : Entity_Id;
            Index_Subtype : Entity_Id;
            Drange        : Node_Id;
            Index         : Node_Id;

         begin
            Index_Subtype :=
              Create_Itype (Subtype_Kind (Ekind (Index_Type)), N);
            Drange := Make_Range (Loc, New_Copy_Tree (Low_Bound), High_Bound);
            Set_Scalar_Range (Index_Subtype, Drange);
            Set_Parent (Drange, N);
            Analyze_And_Resolve (Drange, Index_Type);

            --  In the context, the Index_Type may already have a constraint,
            --  so use common base type on string subtype. The base type may
            --  be used when generating attributes of the string, for example
            --  in the context of a slice assignment.

            Set_Etype        (Index_Subtype, Base_Type (Index_Type));
            Set_Size_Info    (Index_Subtype, Index_Type);
            Set_RM_Size      (Index_Subtype, RM_Size (Index_Type));

            Array_Subtype := Create_Itype (E_Array_Subtype, N);

            Index := New_Occurrence_Of (Index_Subtype, Loc);
            Set_Etype (Index, Index_Subtype);
            Append (Index, Index_List);

            Set_First_Index    (Array_Subtype, Index);
            Set_Etype          (Array_Subtype, Base_Type (Typ));
            Set_Is_Constrained (Array_Subtype, True);

            Rewrite (N,
              Make_Unchecked_Type_Conversion (Loc,
                Subtype_Mark => New_Occurrence_Of (Array_Subtype, Loc),
                Expression => Relocate_Node (N)));
            Set_Etype (N, Array_Subtype);
         end;
      end if;
   end Set_String_Literal_Subtype;

   ------------------------------
   -- Simplify_Type_Conversion --
   ------------------------------

   procedure Simplify_Type_Conversion (N : Node_Id) is
   begin
      if Nkind (N) = N_Type_Conversion then
         declare
            Operand    : constant Node_Id   := Expression (N);
            Target_Typ : constant Entity_Id := Etype (N);
            Opnd_Typ   : constant Entity_Id := Etype (Operand);

         begin
            if Is_Floating_Point_Type (Opnd_Typ)
              and then
                (Is_Integer_Type (Target_Typ)
                   or else (Is_Fixed_Point_Type (Target_Typ)
                              and then Conversion_OK (N)))
              and then Nkind (Operand) = N_Attribute_Reference
              and then Attribute_Name (Operand) = Name_Truncation

            --  Special processing required if the conversion is the expression
            --  of a Truncation attribute reference. In this case we replace:

            --     ityp (ftyp'Truncation (x))

            --  by

            --     ityp (x)

            --  with the Float_Truncate flag set, which is more efficient

            then
               Rewrite (Operand,
                 Relocate_Node (First (Expressions (Operand))));
               Set_Float_Truncate (N, True);
            end if;
         end;
      end if;
   end Simplify_Type_Conversion;

   -----------------------------
   -- Unique_Fixed_Point_Type --
   -----------------------------

   function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id is
      T1   : Entity_Id := Empty;
      T2   : Entity_Id;
      Item : Node_Id;
      Scop : Entity_Id;

      procedure Fixed_Point_Error;
      --  If true ambiguity, give details

      -----------------------
      -- Fixed_Point_Error --
      -----------------------

      procedure Fixed_Point_Error is
      begin
         Error_Msg_N ("ambiguous universal_fixed_expression", N);
         Error_Msg_NE ("\\possible interpretation as}", N, T1);
         Error_Msg_NE ("\\possible interpretation as}", N, T2);
      end Fixed_Point_Error;

   --  Start of processing for Unique_Fixed_Point_Type

   begin
      --  The operations on Duration are visible, so Duration is always a
      --  possible interpretation.

      T1 := Standard_Duration;

      --  Look for fixed-point types in enclosing scopes

      Scop := Current_Scope;
      while Scop /= Standard_Standard loop
         T2 := First_Entity (Scop);
         while Present (T2) loop
            if Is_Fixed_Point_Type (T2)
              and then Current_Entity (T2) = T2
              and then Scope (Base_Type (T2)) = Scop
            then
               if Present (T1) then
                  Fixed_Point_Error;
                  return Any_Type;
               else
                  T1 := T2;
               end if;
            end if;

            Next_Entity (T2);
         end loop;

         Scop := Scope (Scop);
      end loop;

      --  Look for visible fixed type declarations in the context

      Item := First (Context_Items (Cunit (Current_Sem_Unit)));
      while Present (Item) loop
         if Nkind (Item) = N_With_Clause then
            Scop := Entity (Name (Item));
            T2 := First_Entity (Scop);
            while Present (T2) loop
               if Is_Fixed_Point_Type (T2)
                 and then Scope (Base_Type (T2)) = Scop
                 and then (Is_Potentially_Use_Visible (T2)
                             or else In_Use (T2))
               then
                  if Present (T1) then
                     Fixed_Point_Error;
                     return Any_Type;
                  else
                     T1 := T2;
                  end if;
               end if;

               Next_Entity (T2);
            end loop;
         end if;

         Next (Item);
      end loop;

      if Nkind (N) = N_Real_Literal then
         Error_Msg_NE ("?real literal interpreted as }!", N, T1);
      else
         Error_Msg_NE ("?universal_fixed expression interpreted as }!", N, T1);
      end if;

      return T1;
   end Unique_Fixed_Point_Type;

   ----------------------
   -- Valid_Conversion --
   ----------------------

   function Valid_Conversion
     (N       : Node_Id;
      Target  : Entity_Id;
      Operand : Node_Id) return Boolean
   is
      Target_Type : constant Entity_Id := Base_Type (Target);
      Opnd_Type   : Entity_Id := Etype (Operand);

      function Conversion_Check
        (Valid : Boolean;
         Msg   : String) return Boolean;
      --  Little routine to post Msg if Valid is False, returns Valid value

      function Valid_Tagged_Conversion
        (Target_Type : Entity_Id;
         Opnd_Type   : Entity_Id) return Boolean;
      --  Specifically test for validity of tagged conversions

      function Valid_Array_Conversion return Boolean;
      --  Check index and component conformance, and accessibility levels
      --  if the component types are anonymous access types (Ada 2005)

      ----------------------
      -- Conversion_Check --
      ----------------------

      function Conversion_Check
        (Valid : Boolean;
         Msg   : String) return Boolean
      is
      begin
         if not Valid then
            Error_Msg_N (Msg, Operand);
         end if;

         return Valid;
      end Conversion_Check;

      ----------------------------
      -- Valid_Array_Conversion --
      ----------------------------

      function Valid_Array_Conversion return Boolean
      is
         Opnd_Comp_Type : constant Entity_Id := Component_Type (Opnd_Type);
         Opnd_Comp_Base : constant Entity_Id := Base_Type (Opnd_Comp_Type);

         Opnd_Index      : Node_Id;
         Opnd_Index_Type : Entity_Id;

         Target_Comp_Type : constant Entity_Id :=
                              Component_Type (Target_Type);
         Target_Comp_Base : constant Entity_Id :=
                              Base_Type (Target_Comp_Type);

         Target_Index      : Node_Id;
         Target_Index_Type : Entity_Id;

      begin
         --  Error if wrong number of dimensions

         if
           Number_Dimensions (Target_Type) /= Number_Dimensions (Opnd_Type)
         then
            Error_Msg_N
              ("incompatible number of dimensions for conversion", Operand);
            return False;

         --  Number of dimensions matches

         else
            --  Loop through indexes of the two arrays

            Target_Index := First_Index (Target_Type);
            Opnd_Index   := First_Index (Opnd_Type);
            while Present (Target_Index) and then Present (Opnd_Index) loop
               Target_Index_Type := Etype (Target_Index);
               Opnd_Index_Type   := Etype (Opnd_Index);

               --  Error if index types are incompatible

               if not (Is_Integer_Type (Target_Index_Type)
                       and then Is_Integer_Type (Opnd_Index_Type))
                 and then (Root_Type (Target_Index_Type)
                           /= Root_Type (Opnd_Index_Type))
               then
                  Error_Msg_N
                    ("incompatible index types for array conversion",
                     Operand);
                  return False;
               end if;

               Next_Index (Target_Index);
               Next_Index (Opnd_Index);
            end loop;

            --  If component types have same base type, all set

            if Target_Comp_Base  = Opnd_Comp_Base then
               null;

               --  Here if base types of components are not the same. The only
               --  time this is allowed is if we have anonymous access types.

               --  The conversion of arrays of anonymous access types can lead
               --  to dangling pointers. AI-392 formalizes the accessibility
               --  checks that must be applied to such conversions to prevent
               --  out-of-scope references.

            elsif
              (Ekind (Target_Comp_Base) = E_Anonymous_Access_Type
                 or else
               Ekind (Target_Comp_Base) = E_Anonymous_Access_Subprogram_Type)
              and then Ekind (Opnd_Comp_Base) = Ekind (Target_Comp_Base)
              and then
                Subtypes_Statically_Match (Target_Comp_Type, Opnd_Comp_Type)
            then
               if Type_Access_Level (Target_Type) <
                   Type_Access_Level (Opnd_Type)
               then
                  if In_Instance_Body then
                     Error_Msg_N ("?source array type " &
                       "has deeper accessibility level than target", Operand);
                     Error_Msg_N ("\?Program_Error will be raised at run time",
                         Operand);
                     Rewrite (N,
                       Make_Raise_Program_Error (Sloc (N),
                         Reason => PE_Accessibility_Check_Failed));
                     Set_Etype (N, Target_Type);
                     return False;

                  --  Conversion not allowed because of accessibility levels

                  else
                     Error_Msg_N ("source array type " &
                       "has deeper accessibility level than target", Operand);
                     return False;
                  end if;
               else
                  null;
               end if;

            --  All other cases where component base types do not match

            else
               Error_Msg_N
                 ("incompatible component types for array conversion",
                  Operand);
               return False;
            end if;

            --  Check that component subtypes statically match. For numeric
            --  types this means that both must be either constrained or
            --  unconstrained. For enumeration types the bounds must match.
            --  All of this is checked in Subtypes_Statically_Match.

            if not Subtypes_Statically_Match
                            (Target_Comp_Type, Opnd_Comp_Type)
            then
               Error_Msg_N
                 ("component subtypes must statically match", Operand);
               return False;
            end if;
         end if;

         return True;
      end Valid_Array_Conversion;

      -----------------------------
      -- Valid_Tagged_Conversion --
      -----------------------------

      function Valid_Tagged_Conversion
        (Target_Type : Entity_Id;
         Opnd_Type   : Entity_Id) return Boolean
      is
      begin
         --  Upward conversions are allowed (RM 4.6(22))

         if Covers (Target_Type, Opnd_Type)
           or else Is_Ancestor (Target_Type, Opnd_Type)
         then
            return True;

         --  Downward conversion are allowed if the operand is class-wide
         --  (RM 4.6(23)).

         elsif Is_Class_Wide_Type (Opnd_Type)
           and then Covers (Opnd_Type, Target_Type)
         then
            return True;

         elsif Covers (Opnd_Type, Target_Type)
           or else Is_Ancestor (Opnd_Type, Target_Type)
         then
            return
              Conversion_Check (False,
                "downward conversion of tagged objects not allowed");

         --  Ada 2005 (AI-251): The conversion to/from interface types is
         --  always valid

         elsif Is_Interface (Target_Type) or else Is_Interface (Opnd_Type) then
            return True;

         --  If the operand is a class-wide type obtained through a limited_
         --  with clause, and the context includes the non-limited view, use
         --  it to determine whether the conversion is legal.

         elsif Is_Class_Wide_Type (Opnd_Type)
           and then From_With_Type (Opnd_Type)
           and then Present (Non_Limited_View (Etype (Opnd_Type)))
           and then Is_Interface (Non_Limited_View (Etype (Opnd_Type)))
         then
            return True;

         elsif Is_Access_Type (Opnd_Type)
           and then Is_Interface (Directly_Designated_Type (Opnd_Type))
         then
            return True;

         else
            Error_Msg_NE
              ("invalid tagged conversion, not compatible with}",
               N, First_Subtype (Opnd_Type));
            return False;
         end if;
      end Valid_Tagged_Conversion;

   --  Start of processing for Valid_Conversion

   begin
      Check_Parameterless_Call (Operand);

      if Is_Overloaded (Operand) then
         declare
            I   : Interp_Index;
            I1  : Interp_Index;
            It  : Interp;
            It1 : Interp;
            N1  : Entity_Id;

         begin
            --  Remove procedure calls, which syntactically cannot appear
            --  in this context, but which cannot be removed by type checking,
            --  because the context does not impose a type.

            --  When compiling for VMS, spurious ambiguities can be produced
            --  when arithmetic operations have a literal operand and return
            --  System.Address or a descendant of it. These ambiguities are
            --  otherwise resolved by the context, but for conversions there
            --  is no context type and the removal of the spurious operations
            --  must be done explicitly here.

            --  The node may be labelled overloaded, but still contain only
            --  one interpretation because others were discarded in previous
            --  filters. If this is the case, retain the single interpretation
            --  if legal.

            Get_First_Interp (Operand, I, It);
            Opnd_Type := It.Typ;
            Get_Next_Interp (I, It);

            if Present (It.Typ)
              and then Opnd_Type /= Standard_Void_Type
            then
               --  More than one candidate interpretation is available

               Get_First_Interp (Operand, I, It);
               while Present (It.Typ) loop
                  if It.Typ = Standard_Void_Type then
                     Remove_Interp (I);
                  end if;

                  if Present (System_Aux_Id)
                    and then Is_Descendent_Of_Address (It.Typ)
                  then
                     Remove_Interp (I);
                  end if;

                  Get_Next_Interp (I, It);
               end loop;
            end if;

            Get_First_Interp (Operand, I, It);
            I1  := I;
            It1 := It;

            if No (It.Typ) then
               Error_Msg_N ("illegal operand in conversion", Operand);
               return False;
            end if;

            Get_Next_Interp (I, It);

            if Present (It.Typ) then
               N1  := It1.Nam;
               It1 :=  Disambiguate (Operand, I1, I, Any_Type);

               if It1 = No_Interp then
                  Error_Msg_N ("ambiguous operand in conversion", Operand);

                  Error_Msg_Sloc := Sloc (It.Nam);
                  Error_Msg_N ("\\possible interpretation#!", Operand);

                  Error_Msg_Sloc := Sloc (N1);
                  Error_Msg_N ("\\possible interpretation#!", Operand);

                  return False;
               end if;
            end if;

            Set_Etype (Operand, It1.Typ);
            Opnd_Type := It1.Typ;
         end;
      end if;

      --  Numeric types

      if Is_Numeric_Type (Target_Type)  then

         --  A universal fixed expression can be converted to any numeric type

         if Opnd_Type = Universal_Fixed then
            return True;

         --  Also no need to check when in an instance or inlined body, because
         --  the legality has been established when the template was analyzed.
         --  Furthermore, numeric conversions may occur where only a private
         --  view of the operand type is visible at the instantiation point.
         --  This results in a spurious error if we check that the operand type
         --  is a numeric type.

         --  Note: in a previous version of this unit, the following tests were
         --  applied only for generated code (Comes_From_Source set to False),
         --  but in fact the test is required for source code as well, since
         --  this situation can arise in source code.

         elsif In_Instance or else In_Inlined_Body then
               return True;

         --  Otherwise we need the conversion check

         else
            return Conversion_Check
                    (Is_Numeric_Type (Opnd_Type),
                     "illegal operand for numeric conversion");
         end if;

      --  Array types

      elsif Is_Array_Type (Target_Type) then
         if not Is_Array_Type (Opnd_Type)
           or else Opnd_Type = Any_Composite
           or else Opnd_Type = Any_String
         then
            Error_Msg_N
              ("illegal operand for array conversion", Operand);
            return False;
         else
            return Valid_Array_Conversion;
         end if;

      --  Ada 2005 (AI-251): Anonymous access types where target references an
      --  interface type.

      elsif (Ekind (Target_Type) = E_General_Access_Type
              or else
             Ekind (Target_Type) = E_Anonymous_Access_Type)
        and then Is_Interface (Directly_Designated_Type (Target_Type))
      then
         --  Check the static accessibility rule of 4.6(17). Note that the
         --  check is not enforced when within an instance body, since the RM
         --  requires such cases to be caught at run time.

         if Ekind (Target_Type) /= E_Anonymous_Access_Type then
            if Type_Access_Level (Opnd_Type) >
               Type_Access_Level (Target_Type)
            then
               --  In an instance, this is a run-time check, but one we know
               --  will fail, so generate an appropriate warning. The raise
               --  will be generated by Expand_N_Type_Conversion.

               if In_Instance_Body then
                  Error_Msg_N
                    ("?cannot convert local pointer to non-local access type",
                     Operand);
                  Error_Msg_N
                    ("\?Program_Error will be raised at run time", Operand);
               else
                  Error_Msg_N
                    ("cannot convert local pointer to non-local access type",
                     Operand);
                  return False;
               end if;

            --  Special accessibility checks are needed in the case of access
            --  discriminants declared for a limited type.

            elsif Ekind (Opnd_Type) = E_Anonymous_Access_Type
              and then not Is_Local_Anonymous_Access (Opnd_Type)
            then
               --  When the operand is a selected access discriminant the check
               --  needs to be made against the level of the object denoted by
               --  the prefix of the selected name. (Object_Access_Level
               --  handles checking the prefix of the operand for this case.)

               if Nkind (Operand) = N_Selected_Component
                 and then Object_Access_Level (Operand) >
                          Type_Access_Level (Target_Type)
               then
                  --  In an instance, this is a run-time check, but one we
                  --  know will fail, so generate an appropriate warning.
                  --  The raise will be generated by Expand_N_Type_Conversion.

                  if In_Instance_Body then
                     Error_Msg_N
                       ("?cannot convert access discriminant to non-local" &
                        " access type", Operand);
                     Error_Msg_N
                       ("\?Program_Error will be raised at run time", Operand);
                  else
                     Error_Msg_N
                       ("cannot convert access discriminant to non-local" &
                        " access type", Operand);
                     return False;
                  end if;
               end if;

               --  The case of a reference to an access discriminant from
               --  within a limited type declaration (which will appear as
               --  a discriminal) is always illegal because the level of the
               --  discriminant is considered to be deeper than any (nameable)
               --  access type.

               if Is_Entity_Name (Operand)
                 and then not Is_Local_Anonymous_Access (Opnd_Type)
                 and then (Ekind (Entity (Operand)) = E_In_Parameter
                            or else Ekind (Entity (Operand)) = E_Constant)
                 and then Present (Discriminal_Link (Entity (Operand)))
               then
                  Error_Msg_N
                    ("discriminant has deeper accessibility level than target",
                     Operand);
                  return False;
               end if;
            end if;
         end if;

         return True;

      --  General and anonymous access types

      elsif (Ekind (Target_Type) = E_General_Access_Type
        or else Ekind (Target_Type) = E_Anonymous_Access_Type)
          and then
            Conversion_Check
              (Is_Access_Type (Opnd_Type)
                 and then Ekind (Opnd_Type) /=
                   E_Access_Subprogram_Type
                 and then Ekind (Opnd_Type) /=
                   E_Access_Protected_Subprogram_Type,
               "must be an access-to-object type")
      then
         if Is_Access_Constant (Opnd_Type)
           and then not Is_Access_Constant (Target_Type)
         then
            Error_Msg_N
              ("access-to-constant operand type not allowed", Operand);
            return False;
         end if;

         --  Check the static accessibility rule of 4.6(17). Note that the
         --  check is not enforced when within an instance body, since the RM
         --  requires such cases to be caught at run time.

         if Ekind (Target_Type) /= E_Anonymous_Access_Type
           or else Is_Local_Anonymous_Access (Target_Type)
         then
            if Type_Access_Level (Opnd_Type)
              > Type_Access_Level (Target_Type)
            then
               --  In an instance, this is a run-time check, but one we
               --  know will fail, so generate an appropriate warning.
               --  The raise will be generated by Expand_N_Type_Conversion.

               if In_Instance_Body then
                  Error_Msg_N
                    ("?cannot convert local pointer to non-local access type",
                     Operand);
                  Error_Msg_N
                    ("\?Program_Error will be raised at run time", Operand);

               else
                  --  Avoid generation of spurious error message

                  if not Error_Posted (N) then
                     Error_Msg_N
                      ("cannot convert local pointer to non-local access type",
                       Operand);
                  end if;

                  return False;
               end if;

            --  Special accessibility checks are needed in the case of access
            --  discriminants declared for a limited type.

            elsif Ekind (Opnd_Type) = E_Anonymous_Access_Type
              and then not Is_Local_Anonymous_Access (Opnd_Type)
            then

               --  When the operand is a selected access discriminant the check
               --  needs to be made against the level of the object denoted by
               --  the prefix of the selected name. (Object_Access_Level
               --  handles checking the prefix of the operand for this case.)

               if Nkind (Operand) = N_Selected_Component
                 and then Object_Access_Level (Operand) >
                          Type_Access_Level (Target_Type)
               then
                  --  In an instance, this is a run-time check, but one we
                  --  know will fail, so generate an appropriate warning.
                  --  The raise will be generated by Expand_N_Type_Conversion.

                  if In_Instance_Body then
                     Error_Msg_N
                       ("?cannot convert access discriminant to non-local" &
                        " access type", Operand);
                     Error_Msg_N
                       ("\?Program_Error will be raised at run time",
                        Operand);

                  else
                     Error_Msg_N
                       ("cannot convert access discriminant to non-local" &
                        " access type", Operand);
                     return False;
                  end if;
               end if;

               --  The case of a reference to an access discriminant from
               --  within a limited type declaration (which will appear as
               --  a discriminal) is always illegal because the level of the
               --  discriminant is considered to be deeper than any (nameable)
               --  access type.

               if Is_Entity_Name (Operand)
                 and then (Ekind (Entity (Operand)) = E_In_Parameter
                            or else Ekind (Entity (Operand)) = E_Constant)
                 and then Present (Discriminal_Link (Entity (Operand)))
               then
                  Error_Msg_N
                    ("discriminant has deeper accessibility level than target",
                     Operand);
                  return False;
               end if;
            end if;
         end if;

         declare
            function Full_Designated_Type (T : Entity_Id) return Entity_Id;
            --  Helper function to handle limited views

            --------------------------
            -- Full_Designated_Type --
            --------------------------

            function Full_Designated_Type (T : Entity_Id) return Entity_Id is
               Desig : constant Entity_Id := Designated_Type (T);
            begin
               if From_With_Type (Desig)
                 and then Is_Incomplete_Type (Desig)
                 and then Present (Non_Limited_View (Desig))
               then
                  return Non_Limited_View (Desig);
               else
                  return Desig;
               end if;
            end Full_Designated_Type;

            Target : constant Entity_Id := Full_Designated_Type (Target_Type);
            Opnd   : constant Entity_Id := Full_Designated_Type (Opnd_Type);

            Same_Base : constant Boolean :=
                          Base_Type (Target) = Base_Type (Opnd);

         begin
            if Is_Tagged_Type (Target) then
               return Valid_Tagged_Conversion (Target, Opnd);

            else
               if not Same_Base then
                  Error_Msg_NE
                    ("target designated type not compatible with }",
                     N, Base_Type (Opnd));
                  return False;

               --  Ada 2005 AI-384: legality rule is symmetric in both
               --  designated types. The conversion is legal (with possible
               --  constraint check) if either designated type is
               --  unconstrained.

               elsif Subtypes_Statically_Match (Target, Opnd)
                 or else
                   (Has_Discriminants (Target)
                     and then
                      (not Is_Constrained (Opnd)
                        or else not Is_Constrained (Target)))
               then
                  return True;

               else
                  Error_Msg_NE
                    ("target designated subtype not compatible with }",
                     N, Opnd);
                  return False;
               end if;
            end if;
         end;

      --  Access to subprogram types. If the operand is an access parameter,
      --  the type has a deeper accessibility that any master, and cannot
      --  be assigned.

      elsif (Ekind (Target_Type) = E_Access_Subprogram_Type
               or else
             Ekind (Target_Type) = E_Anonymous_Access_Subprogram_Type)
        and then No (Corresponding_Remote_Type (Opnd_Type))
      then
         if Ekind (Base_Type (Opnd_Type)) = E_Anonymous_Access_Subprogram_Type
           and then Is_Entity_Name (Operand)
           and then Ekind (Entity (Operand)) = E_In_Parameter
         then
            Error_Msg_N
              ("illegal attempt to store anonymous access to subprogram",
               Operand);
            Error_Msg_N
              ("\value has deeper accessibility than any master " &
               "(RM 3.10.2 (13))",
               Operand);

            Error_Msg_NE
             ("\use named access type for& instead of access parameter",
               Operand, Entity (Operand));
         end if;

         --  Check that the designated types are subtype conformant

         Check_Subtype_Conformant (New_Id  => Designated_Type (Target_Type),
                                   Old_Id  => Designated_Type (Opnd_Type),
                                   Err_Loc => N);

         --  Check the static accessibility rule of 4.6(20)

         if Type_Access_Level (Opnd_Type) >
            Type_Access_Level (Target_Type)
         then
            Error_Msg_N
              ("operand type has deeper accessibility level than target",
               Operand);

         --  Check that if the operand type is declared in a generic body,
         --  then the target type must be declared within that same body
         --  (enforces last sentence of 4.6(20)).

         elsif Present (Enclosing_Generic_Body (Opnd_Type)) then
            declare
               O_Gen : constant Node_Id :=
                         Enclosing_Generic_Body (Opnd_Type);

               T_Gen : Node_Id;

            begin
               T_Gen := Enclosing_Generic_Body (Target_Type);
               while Present (T_Gen) and then T_Gen /= O_Gen loop
                  T_Gen := Enclosing_Generic_Body (T_Gen);
               end loop;

               if T_Gen /= O_Gen then
                  Error_Msg_N
                    ("target type must be declared in same generic body"
                     & " as operand type", N);
               end if;
            end;
         end if;

         return True;

      --  Remote subprogram access types

      elsif Is_Remote_Access_To_Subprogram_Type (Target_Type)
        and then Is_Remote_Access_To_Subprogram_Type (Opnd_Type)
      then
         --  It is valid to convert from one RAS type to another provided
         --  that their specification statically match.

         Check_Subtype_Conformant
           (New_Id  =>
              Designated_Type (Corresponding_Remote_Type (Target_Type)),
            Old_Id  =>
              Designated_Type (Corresponding_Remote_Type (Opnd_Type)),
            Err_Loc =>
              N);
         return True;

      --  If both are tagged types, check legality of view conversions

      elsif Is_Tagged_Type (Target_Type)
        and then Is_Tagged_Type (Opnd_Type)
      then
         return Valid_Tagged_Conversion (Target_Type, Opnd_Type);

      --  Types derived from the same root type are convertible

      elsif Root_Type (Target_Type) = Root_Type (Opnd_Type) then
         return True;

      --  In an instance or an inlined body, there may be inconsistent
      --  views of the same type, or of types derived from a common root.

      elsif (In_Instance or In_Inlined_Body)
        and then
           Root_Type (Underlying_Type (Target_Type)) =
           Root_Type (Underlying_Type (Opnd_Type))
      then
         return True;

      --  Special check for common access type error case

      elsif Ekind (Target_Type) = E_Access_Type
         and then Is_Access_Type (Opnd_Type)
      then
         Error_Msg_N ("target type must be general access type!", N);
         Error_Msg_NE ("add ALL to }!", N, Target_Type);

         return False;

      else
         Error_Msg_NE ("invalid conversion, not compatible with }",
           N, Opnd_Type);

         return False;
      end if;
   end Valid_Conversion;

end Sem_Res;