gcc/ada/sem_ch4.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              S E M _ C H 4                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                                                                          --
  10 --          Copyright (C) 1992-2002, Free Software Foundation, Inc.         --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 with Atree;    use Atree;
  29 with Debug;    use Debug;
  30 with Einfo;    use Einfo;
  31 with Errout;   use Errout;
  32 with Exp_Util; use Exp_Util;
  33 with Hostparm; use Hostparm;
  34 with Itypes;   use Itypes;
  35 with Lib.Xref; use Lib.Xref;
  36 with Namet;    use Namet;
  37 with Nlists;   use Nlists;
  38 with Nmake;    use Nmake;
  39 with Opt;      use Opt;
  40 with Output;   use Output;
  41 with Restrict; use Restrict;
  42 with Sem;      use Sem;
  43 with Sem_Cat;  use Sem_Cat;
  44 with Sem_Ch3;  use Sem_Ch3;
  45 with Sem_Ch8;  use Sem_Ch8;
  46 with Sem_Dist; use Sem_Dist;
  47 with Sem_Eval; use Sem_Eval;
  48 with Sem_Res;  use Sem_Res;
  49 with Sem_Util; use Sem_Util;
  50 with Sem_Type; use Sem_Type;
  51 with Stand;    use Stand;
  52 with Sinfo;    use Sinfo;
  53 with Snames;   use Snames;
  54 with Tbuild;   use Tbuild;
  55
  56 with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
  57
  58 package body Sem_Ch4 is
  59
  60    -----------------------
  61    -- Local Subprograms --
  62    -----------------------
  63
  64    procedure Analyze_Expression (N : Node_Id);
  65    --  For expressions that are not names, this is just a call to analyze.
  66    --  If the expression is a name, it may be a call to a parameterless
  67    --  function, and if so must be converted into an explicit call node
  68    --  and analyzed as such. This deproceduring must be done during the first
  69    --  pass of overload resolution, because otherwise a procedure call with
  70    --  overloaded actuals may fail to resolve. See 4327-001 for an example.
  71
  72    procedure Analyze_Operator_Call (N : Node_Id; Op_Id : Entity_Id);
  73    --  Analyze a call of the form "+"(x, y), etc. The prefix of the call
  74    --  is an operator name or an expanded name whose selector is an operator
  75    --  name, and one possible interpretation is as a predefined operator.
  76
  77    procedure Analyze_Overloaded_Selected_Component (N : Node_Id);
  78    --  If the prefix of a selected_component is overloaded, the proper
  79    --  interpretation that yields a record type with the proper selector
  80    --  name must be selected.
  81
  82    procedure Analyze_User_Defined_Binary_Op (N : Node_Id; Op_Id : Entity_Id);
  83    --  Procedure to analyze a user defined binary operator, which is resolved
  84    --  like a function, but instead of a list of actuals it is presented
  85    --  with the left and right operands of an operator node.
  86
  87    procedure Analyze_User_Defined_Unary_Op (N : Node_Id; Op_Id : Entity_Id);
  88    --  Procedure to analyze a user defined unary operator, which is resolved
  89    --  like a function, but instead of a list of actuals, it is presented with
  90    --  the operand of the operator node.
  91
  92    procedure Ambiguous_Operands (N : Node_Id);
  93    --  for equality, membership, and comparison operators with overloaded
  94    --  arguments, list possible interpretations.
  95
  96    procedure Insert_Explicit_Dereference (N : Node_Id);
  97    --  In a context that requires a composite or subprogram type and
  98    --  where a prefix is an access type, insert an explicit dereference.
  99
 100    procedure Analyze_One_Call
 101       (N       : Node_Id;
 102        Nam     : Entity_Id;
 103        Report  : Boolean;
 104        Success : out Boolean);
 105    --  Check one interpretation of an overloaded subprogram name for
 106    --  compatibility with the types of the actuals in a call. If there is a
 107    --  single interpretation which does not match, post error if Report is
 108    --  set to True.
 109    --
 110    --  Nam is the entity that provides the formals against which the actuals
 111    --  are checked. Nam is either the name of a subprogram, or the internal
 112    --  subprogram type constructed for an access_to_subprogram. If the actuals
 113    --  are compatible with Nam, then Nam is added to the list of candidate
 114    --  interpretations for N, and Success is set to True.
 115
 116    procedure Check_Misspelled_Selector
 117      (Prefix : Entity_Id;
 118       Sel    : Node_Id);
 119    --  Give possible misspelling diagnostic if Sel is likely to be
 120    --  a misspelling of one of the selectors of the Prefix.
 121    --  This is called by Analyze_Selected_Component after producing
 122    --  an invalid selector error message.
 123
 124    function Defined_In_Scope (T : Entity_Id; S : Entity_Id) return Boolean;
 125    --  Verify that type T is declared in scope S. Used to find intepretations
 126    --  for operators given by expanded names. This is abstracted as a separate
 127    --  function to handle extensions to System, where S is System, but T is
 128    --  declared in the extension.
 129
 130    procedure Find_Arithmetic_Types
 131      (L, R  : Node_Id;
 132       Op_Id : Entity_Id;
 133       N     : Node_Id);
 134    --  L and R are the operands of an arithmetic operator. Find
 135    --  consistent pairs of interpretations for L and R that have a
 136    --  numeric type consistent with the semantics of the operator.
 137
 138    procedure Find_Comparison_Types
 139      (L, R  : Node_Id;
 140       Op_Id : Entity_Id;
 141       N     : Node_Id);
 142    --  L and R are operands of a comparison operator. Find consistent
 143    --  pairs of interpretations for L and R.
 144
 145    procedure Find_Concatenation_Types
 146      (L, R  : Node_Id;
 147       Op_Id : Entity_Id;
 148       N     : Node_Id);
 149    --  For the four varieties of concatenation.
 150
 151    procedure Find_Equality_Types
 152      (L, R  : Node_Id;
 153       Op_Id : Entity_Id;
 154       N     : Node_Id);
 155    --  Ditto for equality operators.
 156
 157    procedure Find_Boolean_Types
 158      (L, R  : Node_Id;
 159       Op_Id : Entity_Id;
 160       N     : Node_Id);
 161    --  Ditto for binary logical operations.
 162
 163    procedure Find_Negation_Types
 164      (R     : Node_Id;
 165       Op_Id : Entity_Id;
 166       N     : Node_Id);
 167    --  Find consistent interpretation for operand of negation operator.
 168
 169    procedure Find_Non_Universal_Interpretations
 170      (N     : Node_Id;
 171       R     : Node_Id;
 172       Op_Id : Entity_Id;
 173       T1    : Entity_Id);
 174    --  For equality and comparison operators, the result is always boolean,
 175    --  and the legality of the operation is determined from the visibility
 176    --  of the operand types. If one of the operands has a universal interpre-
 177    --  tation,  the legality check uses some compatible non-universal
 178    --  interpretation of the other operand. N can be an operator node, or
 179    --  a function call whose name is an operator designator.
 180
 181    procedure Find_Unary_Types
 182      (R     : Node_Id;
 183       Op_Id : Entity_Id;
 184       N     : Node_Id);
 185    --  Unary arithmetic types: plus, minus, abs.
 186
 187    procedure Check_Arithmetic_Pair
 188      (T1, T2 : Entity_Id;
 189       Op_Id  : Entity_Id;
 190       N      : Node_Id);
 191    --  Subsidiary procedure to Find_Arithmetic_Types. T1 and T2 are valid
 192    --  types for left and right operand. Determine whether they constitute
 193    --  a valid pair for the given operator, and record the corresponding
 194    --  interpretation of the operator node. The node N may be an operator
 195    --  node (the usual case) or a function call whose prefix is an operator
 196    --  designator. In  both cases Op_Id is the operator name itself.
 197
 198    procedure Diagnose_Call (N : Node_Id; Nam : Node_Id);
 199    --  Give detailed information on overloaded call where none of the
 200    --  interpretations match. N is the call node, Nam the designator for
 201    --  the overloaded entity being called.
 202
 203    function Junk_Operand (N : Node_Id) return Boolean;
 204    --  Test for an operand that is an inappropriate entity (e.g. a package
 205    --  name or a label). If so, issue an error message and return True. If
 206    --  the operand is not an inappropriate entity kind, return False.
 207
 208    procedure Operator_Check (N : Node_Id);
 209    --  Verify that an operator has received some valid interpretation.
 210    --  If none was found, determine whether a use clause would make the
 211    --  operation legal. The variable Candidate_Type (defined in Sem_Type) is
 212    --  set for every type compatible with the operator, even if the operator
 213    --  for the type is not directly visible. The routine uses this type to emit
 214    --  a more informative message.
 215
 216    function Try_Indexed_Call
 217      (N      : Node_Id;
 218       Nam    : Entity_Id;
 219       Typ    : Entity_Id)
 220       return   Boolean;
 221    --  If a function has defaults for all its actuals, a call to it may
 222    --  in fact be an indexing on the result of the call. Try_Indexed_Call
 223    --  attempts the interpretation as an indexing, prior to analysis as
 224    --  a call. If both are possible,  the node is overloaded with both
 225    --  interpretations (same symbol but two different types).
 226
 227    function Try_Indirect_Call
 228      (N      : Node_Id;
 229       Nam    : Entity_Id;
 230       Typ    : Entity_Id)
 231       return   Boolean;
 232    --  Similarly, a function F that needs no actuals can return an access
 233    --  to a subprogram, and the call F (X)  interpreted as F.all (X). In
 234    --  this case the call may be overloaded with both interpretations.
 235
 236    ------------------------
 237    -- Ambiguous_Operands --
 238    ------------------------
 239
 240    procedure Ambiguous_Operands (N : Node_Id) is
 241       procedure List_Interps (Opnd : Node_Id);
 242
 243       procedure List_Interps (Opnd : Node_Id) is
 244          Index : Interp_Index;
 245          It    : Interp;
 246          Nam   : Node_Id;
 247          Err   : Node_Id := N;
 248
 249       begin
 250          if Is_Overloaded (Opnd) then
 251             if Nkind (Opnd) in N_Op then
 252                Nam := Opnd;
 253
 254             elsif Nkind (Opnd) = N_Function_Call then
 255                Nam := Name (Opnd);
 256
 257             else
 258                return;
 259             end if;
 260
 261          else
 262             return;
 263          end if;
 264
 265          if Opnd = Left_Opnd (N) then
 266             Error_Msg_N
 267               ("\left operand has the following interpretations", N);
 268          else
 269             Error_Msg_N
 270               ("\right operand has the following interpretations", N);
 271             Err := Opnd;
 272          end if;
 273
 274          Get_First_Interp (Nam, Index, It);
 275
 276          while Present (It.Nam) loop
 277
 278             if Scope (It.Nam) = Standard_Standard
 279               and then Scope (It.Typ) /= Standard_Standard
 280             then
 281                Error_Msg_Sloc := Sloc (Parent (It.Typ));
 282                Error_Msg_NE ("   & (inherited) declared#!", Err, It.Nam);
 283
 284             else
 285                Error_Msg_Sloc := Sloc (It.Nam);
 286                Error_Msg_NE ("   & declared#!", Err, It.Nam);
 287             end if;
 288
 289             Get_Next_Interp (Index, It);
 290          end loop;
 291       end List_Interps;
 292
 293    begin
 294       if Nkind (N) = N_In
 295         or else Nkind (N) = N_Not_In
 296       then
 297          Error_Msg_N ("ambiguous operands for membership",  N);
 298
 299       elsif Nkind (N) = N_Op_Eq
 300         or else Nkind (N) = N_Op_Ne
 301       then
 302          Error_Msg_N ("ambiguous operands for equality",  N);
 303
 304       else
 305          Error_Msg_N ("ambiguous operands for comparison",  N);
 306       end if;
 307
 308       if All_Errors_Mode then
 309          List_Interps (Left_Opnd  (N));
 310          List_Interps (Right_Opnd (N));
 311       else
 312
 313          if OpenVMS then
 314             Error_Msg_N (
 315                "\use '/'R'E'P'O'R'T'_'E'R'R'O'R'S'='F'U'L'L for details",
 316                 N);
 317          else
 318             Error_Msg_N ("\use -gnatf for details", N);
 319          end if;
 320       end if;
 321    end Ambiguous_Operands;
 322
 323    -----------------------
 324    -- Analyze_Aggregate --
 325    -----------------------
 326
 327    --  Most of the analysis of Aggregates requires that the type be known,
 328    --  and is therefore put off until resolution.
 329
 330    procedure Analyze_Aggregate (N : Node_Id) is
 331    begin
 332       if No (Etype (N)) then
 333          Set_Etype (N, Any_Composite);
 334       end if;
 335    end Analyze_Aggregate;
 336
 337    -----------------------
 338    -- Analyze_Allocator --
 339    -----------------------
 340
 341    procedure Analyze_Allocator (N : Node_Id) is
 342       Loc      : constant Source_Ptr := Sloc (N);
 343       Sav_Errs : constant Nat        := Serious_Errors_Detected;
 344       E        : Node_Id             := Expression (N);
 345       Acc_Type : Entity_Id;
 346       Type_Id  : Entity_Id;
 347
 348    begin
 349       Check_Restriction (No_Allocators, N);
 350
 351       if Nkind (E) = N_Qualified_Expression then
 352          Acc_Type := Create_Itype (E_Allocator_Type, N);
 353          Set_Etype (Acc_Type, Acc_Type);
 354          Init_Size_Align (Acc_Type);
 355          Find_Type (Subtype_Mark (E));
 356          Type_Id := Entity (Subtype_Mark (E));
 357          Check_Fully_Declared (Type_Id, N);
 358          Set_Directly_Designated_Type (Acc_Type, Type_Id);
 359
 360          if Is_Protected_Type (Type_Id) then
 361             Check_Restriction (No_Protected_Type_Allocators, N);
 362          end if;
 363
 364          if Is_Limited_Type (Type_Id)
 365            and then Comes_From_Source (N)
 366            and then not In_Instance_Body
 367          then
 368             Error_Msg_N ("initialization not allowed for limited types", N);
 369          end if;
 370
 371          Analyze_And_Resolve (Expression (E), Type_Id);
 372
 373          --  A qualified expression requires an exact match of the type,
 374          --  class-wide matching is not allowed.
 375
 376          if Is_Class_Wide_Type (Type_Id)
 377            and then Base_Type (Etype (Expression (E))) /= Base_Type (Type_Id)
 378          then
 379             Wrong_Type (Expression (E), Type_Id);
 380          end if;
 381
 382          Check_Non_Static_Context (Expression (E));
 383
 384          --  We don't analyze the qualified expression itself because it's
 385          --  part of the allocator
 386
 387          Set_Etype  (E, Type_Id);
 388
 389       else
 390          declare
 391             Def_Id : Entity_Id;
 392
 393          begin
 394             --  If the allocator includes a N_Subtype_Indication then a
 395             --  constraint is present, otherwise the node is a subtype mark.
 396             --  Introduce an explicit subtype declaration into the tree
 397             --  defining some anonymous subtype and rewrite the allocator to
 398             --  use this subtype rather than the subtype indication.
 399
 400             --  It is important to introduce the explicit subtype declaration
 401             --  so that the bounds of the subtype indication are attached to
 402             --  the tree in case the allocator is inside a generic unit.
 403
 404             if Nkind (E) = N_Subtype_Indication then
 405
 406                --  A constraint is only allowed for a composite type in Ada
 407                --  95. In Ada 83, a constraint is also allowed for an
 408                --  access-to-composite type, but the constraint is ignored.
 409
 410                Find_Type (Subtype_Mark (E));
 411
 412                if Is_Elementary_Type (Entity (Subtype_Mark (E))) then
 413                   if not (Ada_83
 414                            and then Is_Access_Type (Entity (Subtype_Mark (E))))
 415                   then
 416                      Error_Msg_N ("constraint not allowed here", E);
 417
 418                      if Nkind (Constraint (E))
 419                        = N_Index_Or_Discriminant_Constraint
 420                      then
 421                         Error_Msg_N
 422                           ("\if qualified expression was meant, " &
 423                               "use apostrophe", Constraint (E));
 424                      end if;
 425                   end if;
 426
 427                   --  Get rid of the bogus constraint:
 428
 429                   Rewrite (E, New_Copy_Tree (Subtype_Mark (E)));
 430                   Analyze_Allocator (N);
 431                   return;
 432                end if;
 433
 434                if Expander_Active then
 435                   Def_Id :=
 436                     Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
 437
 438                   Insert_Action (E,
 439                     Make_Subtype_Declaration (Loc,
 440                       Defining_Identifier => Def_Id,
 441                       Subtype_Indication  => Relocate_Node (E)));
 442
 443                   if Sav_Errs /= Serious_Errors_Detected
 444                     and then Nkind (Constraint (E))
 445                       = N_Index_Or_Discriminant_Constraint
 446                   then
 447                      Error_Msg_N
 448                        ("if qualified expression was meant, " &
 449                            "use apostrophe!", Constraint (E));
 450                   end if;
 451
 452                   E := New_Occurrence_Of (Def_Id, Loc);
 453                   Rewrite (Expression (N), E);
 454                end if;
 455             end if;
 456
 457             Type_Id := Process_Subtype (E, N);
 458             Acc_Type := Create_Itype (E_Allocator_Type, N);
 459             Set_Etype                    (Acc_Type, Acc_Type);
 460             Init_Size_Align              (Acc_Type);
 461             Set_Directly_Designated_Type (Acc_Type, Type_Id);
 462             Check_Fully_Declared (Type_Id, N);
 463
 464             --  Check for missing initialization. Skip this check if we already
 465             --  had errors on analyzing the allocator, since in that case these
 466             --  are probably cascaded errors
 467
 468             if Is_Indefinite_Subtype (Type_Id)
 469               and then Serious_Errors_Detected = Sav_Errs
 470             then
 471                if Is_Class_Wide_Type (Type_Id) then
 472                   Error_Msg_N
 473                     ("initialization required in class-wide allocation", N);
 474                else
 475                   Error_Msg_N
 476                     ("initialization required in unconstrained allocation", N);
 477                end if;
 478             end if;
 479          end;
 480       end if;
 481
 482       if Is_Abstract (Type_Id) then
 483          Error_Msg_N ("cannot allocate abstract object", E);
 484       end if;
 485
 486       if Has_Task (Designated_Type (Acc_Type)) then
 487          Check_Restriction (No_Task_Allocators, N);
 488       end if;
 489
 490       Set_Etype (N, Acc_Type);
 491
 492       if not Is_Library_Level_Entity (Acc_Type) then
 493          Check_Restriction (No_Local_Allocators, N);
 494       end if;
 495
 496       if Serious_Errors_Detected > Sav_Errs then
 497          Set_Error_Posted (N);
 498          Set_Etype (N, Any_Type);
 499       end if;
 500
 501    end Analyze_Allocator;
 502
 503    ---------------------------
 504    -- Analyze_Arithmetic_Op --
 505    ---------------------------
 506
 507    procedure Analyze_Arithmetic_Op (N : Node_Id) is
 508       L     : constant Node_Id := Left_Opnd (N);
 509       R     : constant Node_Id := Right_Opnd (N);
 510       Op_Id : Entity_Id;
 511
 512    begin
 513       Candidate_Type := Empty;
 514       Analyze_Expression (L);
 515       Analyze_Expression (R);
 516
 517       --  If the entity is already set, the node is the instantiation of
 518       --  a generic node with a non-local reference, or was manufactured
 519       --  by a call to Make_Op_xxx. In either case the entity is known to
 520       --  be valid, and we do not need to collect interpretations, instead
 521       --  we just get the single possible interpretation.
 522
 523       Op_Id := Entity (N);
 524
 525       if Present (Op_Id) then
 526          if Ekind (Op_Id) = E_Operator then
 527
 528             if (Nkind (N) = N_Op_Divide   or else
 529                 Nkind (N) = N_Op_Mod      or else
 530                 Nkind (N) = N_Op_Multiply or else
 531                 Nkind (N) = N_Op_Rem)
 532               and then Treat_Fixed_As_Integer (N)
 533             then
 534                null;
 535             else
 536                Set_Etype (N, Any_Type);
 537                Find_Arithmetic_Types (L, R, Op_Id, N);
 538             end if;
 539
 540          else
 541             Set_Etype (N, Any_Type);
 542             Add_One_Interp (N, Op_Id, Etype (Op_Id));
 543          end if;
 544
 545       --  Entity is not already set, so we do need to collect interpretations
 546
 547       else
 548          Op_Id := Get_Name_Entity_Id (Chars (N));
 549          Set_Etype (N, Any_Type);
 550
 551          while Present (Op_Id) loop
 552             if Ekind (Op_Id) = E_Operator
 553               and then Present (Next_Entity (First_Entity (Op_Id)))
 554             then
 555                Find_Arithmetic_Types (L, R, Op_Id, N);
 556
 557             --  The following may seem superfluous, because an operator cannot
 558             --  be generic, but this ignores the cleverness of the author of
 559             --  ACVC bc1013a.
 560
 561             elsif Is_Overloadable (Op_Id) then
 562                Analyze_User_Defined_Binary_Op (N, Op_Id);
 563             end if;
 564
 565             Op_Id := Homonym (Op_Id);
 566          end loop;
 567       end if;
 568
 569       Operator_Check (N);
 570    end Analyze_Arithmetic_Op;
 571
 572    ------------------
 573    -- Analyze_Call --
 574    ------------------
 575
 576    --  Function, procedure, and entry calls are checked here. The Name
 577    --  in the call may be overloaded. The actuals have been analyzed
 578    --  and may themselves be overloaded. On exit from this procedure, the node
 579    --  N may have zero, one or more interpretations. In the first case an error
 580    --  message is produced. In the last case, the node is flagged as overloaded
 581    --  and the interpretations are collected in All_Interp.
 582
 583    --  If the name is an Access_To_Subprogram, it cannot be overloaded, but
 584    --  the type-checking is similar to that of other calls.
 585
 586    procedure Analyze_Call (N : Node_Id) is
 587       Actuals : constant List_Id := Parameter_Associations (N);
 588       Nam     : Node_Id          := Name (N);
 589       X       : Interp_Index;
 590       It      : Interp;
 591       Nam_Ent : Entity_Id;
 592       Success : Boolean := False;
 593
 594       function Name_Denotes_Function return Boolean;
 595       --  If the type of the name is an access to subprogram, this may be
 596       --  the type of a name, or the return type of the function being called.
 597       --  If the name is not an entity then it can denote a protected function.
 598       --  Until we distinguish Etype from Return_Type, we must use this
 599       --  routine to resolve the meaning of the name in the call.
 600
 601       ---------------------------
 602       -- Name_Denotes_Function --
 603       ---------------------------
 604
 605       function Name_Denotes_Function return Boolean is
 606       begin
 607          if Is_Entity_Name (Nam) then
 608             return Ekind (Entity (Nam)) = E_Function;
 609
 610          elsif Nkind (Nam) = N_Selected_Component then
 611             return Ekind (Entity (Selector_Name (Nam))) = E_Function;
 612
 613          else
 614             return False;
 615          end if;
 616       end Name_Denotes_Function;
 617
 618    --  Start of processing for Analyze_Call
 619
 620    begin
 621       --  Initialize the type of the result of the call to the error type,
 622       --  which will be reset if the type is successfully resolved.
 623
 624       Set_Etype (N, Any_Type);
 625
 626       if not Is_Overloaded (Nam) then
 627
 628          --  Only one interpretation to check
 629
 630          if Ekind (Etype (Nam)) = E_Subprogram_Type then
 631             Nam_Ent := Etype (Nam);
 632
 633          elsif Is_Access_Type (Etype (Nam))
 634            and then Ekind (Designated_Type (Etype (Nam))) = E_Subprogram_Type
 635            and then not Name_Denotes_Function
 636          then
 637             Nam_Ent := Designated_Type (Etype (Nam));
 638             Insert_Explicit_Dereference (Nam);
 639
 640          --  Selected component case. Simple entry or protected operation,
 641          --  where the entry name is given by the selector name.
 642
 643          elsif Nkind (Nam) = N_Selected_Component then
 644             Nam_Ent := Entity (Selector_Name (Nam));
 645
 646             if Ekind (Nam_Ent) /= E_Entry
 647               and then Ekind (Nam_Ent) /= E_Entry_Family
 648               and then Ekind (Nam_Ent) /= E_Function
 649               and then Ekind (Nam_Ent) /= E_Procedure
 650             then
 651                Error_Msg_N ("name in call is not a callable entity", Nam);
 652                Set_Etype (N, Any_Type);
 653                return;
 654             end if;
 655
 656          --  If the name is an Indexed component, it can be a call to a member
 657          --  of an entry family. The prefix must be a selected component whose
 658          --  selector is the entry. Analyze_Procedure_Call normalizes several
 659          --  kinds of call into this form.
 660
 661          elsif Nkind (Nam) = N_Indexed_Component then
 662
 663             if Nkind (Prefix (Nam)) = N_Selected_Component then
 664                Nam_Ent := Entity (Selector_Name (Prefix (Nam)));
 665
 666             else
 667                Error_Msg_N ("name in call is not a callable entity", Nam);
 668                Set_Etype (N, Any_Type);
 669                return;
 670
 671             end if;
 672
 673          elsif not Is_Entity_Name (Nam) then
 674             Error_Msg_N ("name in call is not a callable entity", Nam);
 675             Set_Etype (N, Any_Type);
 676             return;
 677
 678          else
 679             Nam_Ent := Entity (Nam);
 680
 681             --  If no interpretations, give error message
 682
 683             if not Is_Overloadable (Nam_Ent) then
 684                declare
 685                   L : constant Boolean   := Is_List_Member (N);
 686                   K : constant Node_Kind := Nkind (Parent (N));
 687
 688                begin
 689                   --  If the node is in a list whose parent is not an
 690                   --  expression then it must be an attempted procedure call.
 691
 692                   if L and then K not in N_Subexpr then
 693                      if Ekind (Entity (Nam)) = E_Generic_Procedure then
 694                         Error_Msg_NE
 695                           ("must instantiate generic procedure& before call",
 696                            Nam, Entity (Nam));
 697                      else
 698                         Error_Msg_N
 699                           ("procedure or entry name expected", Nam);
 700                      end if;
 701
 702                   --  Check for tasking cases where only an entry call will do
 703
 704                   elsif not L
 705                     and then (K = N_Entry_Call_Alternative
 706                                or else K = N_Triggering_Alternative)
 707                   then
 708                      Error_Msg_N ("entry name expected", Nam);
 709
 710                   --  Otherwise give general error message
 711
 712                   else
 713                      Error_Msg_N ("invalid prefix in call", Nam);
 714                   end if;
 715
 716                   return;
 717                end;
 718             end if;
 719          end if;
 720
 721          Analyze_One_Call (N, Nam_Ent, True, Success);
 722
 723       else
 724          --  An overloaded selected component must denote overloaded
 725          --  operations of a concurrent type. The interpretations are
 726          --  attached to the simple name of those operations.
 727
 728          if Nkind (Nam) = N_Selected_Component then
 729             Nam := Selector_Name (Nam);
 730          end if;
 731
 732          Get_First_Interp (Nam, X, It);
 733
 734          while Present (It.Nam) loop
 735             Nam_Ent := It.Nam;
 736
 737             --  Name may be call that returns an access to subprogram, or more
 738             --  generally an overloaded expression one of whose interpretations
 739             --  yields an access to subprogram. If the name is an entity, we
 740             --  do not dereference, because the node is a call that returns
 741             --  the access type: note difference between f(x), where the call
 742             --  may return an access subprogram type, and f(x)(y), where the
 743             --  type returned by the call to f is implicitly dereferenced to
 744             --  analyze the outer call.
 745
 746             if Is_Access_Type (Nam_Ent) then
 747                Nam_Ent := Designated_Type (Nam_Ent);
 748
 749             elsif Is_Access_Type (Etype (Nam_Ent))
 750               and then not Is_Entity_Name (Nam)
 751               and then Ekind (Designated_Type (Etype (Nam_Ent)))
 752                                                           = E_Subprogram_Type
 753             then
 754                Nam_Ent := Designated_Type (Etype (Nam_Ent));
 755             end if;
 756
 757             Analyze_One_Call (N, Nam_Ent, False, Success);
 758
 759             --  If the interpretation succeeds, mark the proper type of the
 760             --  prefix (any valid candidate will do). If not, remove the
 761             --  candidate interpretation. This only needs to be done for
 762             --  overloaded protected operations, for other entities disambi-
 763             --  guation is done directly in Resolve.
 764
 765             if Success then
 766                Set_Etype (Nam, It.Typ);
 767
 768             elsif Nkind (Name (N)) = N_Selected_Component then
 769                Remove_Interp (X);
 770             end if;
 771
 772             Get_Next_Interp (X, It);
 773          end loop;
 774
 775          --  If the name is the result of a function call, it can only
 776          --  be a call to a function returning an access to subprogram.
 777          --  Insert explicit dereference.
 778
 779          if Nkind (Nam) = N_Function_Call then
 780             Insert_Explicit_Dereference (Nam);
 781          end if;
 782
 783          if Etype (N) = Any_Type then
 784
 785             --  None of the interpretations is compatible with the actuals
 786
 787             Diagnose_Call (N, Nam);
 788
 789             --  Special checks for uninstantiated put routines
 790
 791             if Nkind (N) = N_Procedure_Call_Statement
 792               and then Is_Entity_Name (Nam)
 793               and then Chars (Nam) = Name_Put
 794               and then List_Length (Actuals) = 1
 795             then
 796                declare
 797                   Arg : constant Node_Id := First (Actuals);
 798                   Typ : Entity_Id;
 799
 800                begin
 801                   if Nkind (Arg) = N_Parameter_Association then
 802                      Typ := Etype (Explicit_Actual_Parameter (Arg));
 803                   else
 804                      Typ := Etype (Arg);
 805                   end if;
 806
 807                   if Is_Signed_Integer_Type (Typ) then
 808                      Error_Msg_N
 809                        ("possible missing instantiation of " &
 810                           "'Text_'I'O.'Integer_'I'O!", Nam);
 811
 812                   elsif Is_Modular_Integer_Type (Typ) then
 813                      Error_Msg_N
 814                        ("possible missing instantiation of " &
 815                           "'Text_'I'O.'Modular_'I'O!", Nam);
 816
 817                   elsif Is_Floating_Point_Type (Typ) then
 818                      Error_Msg_N
 819                        ("possible missing instantiation of " &
 820                           "'Text_'I'O.'Float_'I'O!", Nam);
 821
 822                   elsif Is_Ordinary_Fixed_Point_Type (Typ) then
 823                      Error_Msg_N
 824                        ("possible missing instantiation of " &
 825                           "'Text_'I'O.'Fixed_'I'O!", Nam);
 826
 827                   elsif Is_Decimal_Fixed_Point_Type (Typ) then
 828                      Error_Msg_N
 829                        ("possible missing instantiation of " &
 830                           "'Text_'I'O.'Decimal_'I'O!", Nam);
 831
 832                   elsif Is_Enumeration_Type (Typ) then
 833                      Error_Msg_N
 834                        ("possible missing instantiation of " &
 835                           "'Text_'I'O.'Enumeration_'I'O!", Nam);
 836                   end if;
 837                end;
 838             end if;
 839
 840          elsif not Is_Overloaded (N)
 841            and then Is_Entity_Name (Nam)
 842          then
 843             --  Resolution yields a single interpretation. Verify that
 844             --  is has the proper capitalization.
 845
 846             Set_Entity_With_Style_Check (Nam, Entity (Nam));
 847             Generate_Reference (Entity (Nam), Nam);
 848
 849             Set_Etype (Nam, Etype (Entity (Nam)));
 850          end if;
 851
 852          End_Interp_List;
 853       end if;
 854    end Analyze_Call;
 855
 856    ---------------------------
 857    -- Analyze_Comparison_Op --
 858    ---------------------------
 859
 860    procedure Analyze_Comparison_Op (N : Node_Id) is
 861       L     : constant Node_Id := Left_Opnd (N);
 862       R     : constant Node_Id := Right_Opnd (N);
 863       Op_Id : Entity_Id        := Entity (N);
 864
 865    begin
 866       Set_Etype (N, Any_Type);
 867       Candidate_Type := Empty;
 868
 869       Analyze_Expression (L);
 870       Analyze_Expression (R);
 871
 872       if Present (Op_Id) then
 873
 874          if Ekind (Op_Id) = E_Operator then
 875             Find_Comparison_Types (L, R, Op_Id, N);
 876          else
 877             Add_One_Interp (N, Op_Id, Etype (Op_Id));
 878          end if;
 879
 880          if Is_Overloaded (L) then
 881             Set_Etype (L, Intersect_Types (L, R));
 882          end if;
 883
 884       else
 885          Op_Id := Get_Name_Entity_Id (Chars (N));
 886
 887          while Present (Op_Id) loop
 888
 889             if Ekind (Op_Id) = E_Operator then
 890                Find_Comparison_Types (L, R, Op_Id, N);
 891             else
 892                Analyze_User_Defined_Binary_Op (N, Op_Id);
 893             end if;
 894
 895             Op_Id := Homonym (Op_Id);
 896          end loop;
 897       end if;
 898
 899       Operator_Check (N);
 900    end Analyze_Comparison_Op;
 901
 902    ---------------------------
 903    -- Analyze_Concatenation --
 904    ---------------------------
 905
 906    --  If the only one-dimensional array type in scope is String,
 907    --  this is the resulting type of the operation. Otherwise there
 908    --  will be a concatenation operation defined for each user-defined
 909    --  one-dimensional array.
 910
 911    procedure Analyze_Concatenation (N : Node_Id) is
 912       L     : constant Node_Id := Left_Opnd (N);
 913       R     : constant Node_Id := Right_Opnd (N);
 914       Op_Id : Entity_Id        := Entity (N);
 915       LT    : Entity_Id;
 916       RT    : Entity_Id;
 917
 918    begin
 919       Set_Etype (N, Any_Type);
 920       Candidate_Type := Empty;
 921
 922       Analyze_Expression (L);
 923       Analyze_Expression (R);
 924
 925       --  If the entity is present, the  node appears in an instance,
 926       --  and denotes a predefined concatenation operation. The resulting
 927       --  type is obtained from the arguments when possible.
 928
 929       if Present (Op_Id) then
 930          if Ekind (Op_Id) = E_Operator then
 931
 932             LT := Base_Type (Etype (L));
 933             RT := Base_Type (Etype (R));
 934
 935             if Is_Array_Type (LT)
 936               and then (RT = LT or else RT = Base_Type (Component_Type (LT)))
 937             then
 938                Add_One_Interp (N, Op_Id, LT);
 939
 940             elsif Is_Array_Type (RT)
 941               and then LT = Base_Type (Component_Type (RT))
 942             then
 943                Add_One_Interp (N, Op_Id, RT);
 944
 945             else
 946                Add_One_Interp (N, Op_Id, Etype (Op_Id));
 947             end if;
 948
 949          else
 950             Add_One_Interp (N, Op_Id, Etype (Op_Id));
 951          end if;
 952
 953       else
 954          Op_Id  := Get_Name_Entity_Id (Name_Op_Concat);
 955
 956          while Present (Op_Id) loop
 957             if Ekind (Op_Id) = E_Operator then
 958                Find_Concatenation_Types (L, R, Op_Id, N);
 959             else
 960                Analyze_User_Defined_Binary_Op (N, Op_Id);
 961             end if;
 962
 963             Op_Id := Homonym (Op_Id);
 964          end loop;
 965       end if;
 966
 967       Operator_Check (N);
 968    end Analyze_Concatenation;
 969
 970    ------------------------------------
 971    -- Analyze_Conditional_Expression --
 972    ------------------------------------
 973
 974    procedure Analyze_Conditional_Expression (N : Node_Id) is
 975       Condition : constant Node_Id := First (Expressions (N));
 976       Then_Expr : constant Node_Id := Next (Condition);
 977       Else_Expr : constant Node_Id := Next (Then_Expr);
 978
 979    begin
 980       Analyze_Expression (Condition);
 981       Analyze_Expression (Then_Expr);
 982       Analyze_Expression (Else_Expr);
 983       Set_Etype (N, Etype (Then_Expr));
 984    end Analyze_Conditional_Expression;
 985
 986    -------------------------
 987    -- Analyze_Equality_Op --
 988    -------------------------
 989
 990    procedure Analyze_Equality_Op (N : Node_Id) is
 991       Loc    : constant Source_Ptr := Sloc (N);
 992       L      : constant Node_Id := Left_Opnd (N);
 993       R      : constant Node_Id := Right_Opnd (N);
 994       Op_Id  : Entity_Id;
 995
 996    begin
 997       Set_Etype (N, Any_Type);
 998       Candidate_Type := Empty;
 999
1000       Analyze_Expression (L);
1001       Analyze_Expression (R);
1002
1003       --  If the entity is set, the node is a generic instance with a non-local
1004       --  reference to the predefined operator or to a user-defined function.
1005       --  It can also be an inequality that is expanded into the negation of a
1006       --  call to a user-defined equality operator.
1007
1008       --  For the predefined case, the result is Boolean, regardless of the
1009       --  type of the  operands. The operands may even be limited, if they are
1010       --  generic actuals. If they are overloaded, label the left argument with
1011       --  the common type that must be present, or with the type of the formal
1012       --  of the user-defined function.
1013
1014       if Present (Entity (N)) then
1015
1016          Op_Id := Entity (N);
1017
1018          if Ekind (Op_Id) = E_Operator then
1019             Add_One_Interp (N, Op_Id, Standard_Boolean);
1020          else
1021             Add_One_Interp (N, Op_Id, Etype (Op_Id));
1022          end if;
1023
1024          if Is_Overloaded (L) then
1025
1026             if Ekind (Op_Id) = E_Operator then
1027                Set_Etype (L, Intersect_Types (L, R));
1028             else
1029                Set_Etype (L, Etype (First_Formal (Op_Id)));
1030             end if;
1031          end if;
1032
1033       else
1034          Op_Id := Get_Name_Entity_Id (Chars (N));
1035
1036          while Present (Op_Id) loop
1037
1038             if Ekind (Op_Id) = E_Operator then
1039                Find_Equality_Types (L, R, Op_Id, N);
1040             else
1041                Analyze_User_Defined_Binary_Op (N, Op_Id);
1042             end if;
1043
1044             Op_Id := Homonym (Op_Id);
1045          end loop;
1046       end if;
1047
1048       --  If there was no match, and the operator is inequality, this may
1049       --  be a case where inequality has not been made explicit, as for
1050       --  tagged types. Analyze the node as the negation of an equality
1051       --  operation. This cannot be done earlier, because before analysis
1052       --  we cannot rule out the presence of an explicit inequality.
1053
1054       if Etype (N) = Any_Type
1055         and then Nkind (N) = N_Op_Ne
1056       then
1057          Op_Id := Get_Name_Entity_Id (Name_Op_Eq);
1058
1059          while Present (Op_Id) loop
1060
1061             if Ekind (Op_Id) = E_Operator then
1062                Find_Equality_Types (L, R, Op_Id, N);
1063             else
1064                Analyze_User_Defined_Binary_Op (N, Op_Id);
1065             end if;
1066
1067             Op_Id := Homonym (Op_Id);
1068          end loop;
1069
1070          if Etype (N) /= Any_Type then
1071             Op_Id := Entity (N);
1072
1073             Rewrite (N,
1074               Make_Op_Not (Loc,
1075                 Right_Opnd =>
1076                   Make_Op_Eq (Loc,
1077                     Left_Opnd =>  Relocate_Node (Left_Opnd (N)),
1078                     Right_Opnd => Relocate_Node (Right_Opnd (N)))));
1079
1080             Set_Entity (Right_Opnd (N), Op_Id);
1081             Analyze (N);
1082          end if;
1083       end if;
1084
1085       Operator_Check (N);
1086    end Analyze_Equality_Op;
1087
1088    ----------------------------------
1089    -- Analyze_Explicit_Dereference --
1090    ----------------------------------
1091
1092    procedure Analyze_Explicit_Dereference (N : Node_Id) is
1093       Loc   : constant Source_Ptr := Sloc (N);
1094       P     : constant Node_Id := Prefix (N);
1095       T     : Entity_Id;
1096       I     : Interp_Index;
1097       It    : Interp;
1098       New_N : Node_Id;
1099
1100       function Is_Function_Type return Boolean;
1101       --  Check whether node may be interpreted as an implicit function call.
1102
1103       function Is_Function_Type return Boolean is
1104          I     : Interp_Index;
1105          It    : Interp;
1106
1107       begin
1108          if not Is_Overloaded (N) then
1109             return Ekind (Base_Type (Etype (N))) = E_Subprogram_Type
1110               and then Etype (Base_Type (Etype (N))) /= Standard_Void_Type;
1111
1112          else
1113             Get_First_Interp (N, I, It);
1114
1115             while Present (It.Nam) loop
1116                if Ekind (Base_Type (It.Typ)) /= E_Subprogram_Type
1117                  or else Etype (Base_Type (It.Typ)) = Standard_Void_Type
1118                then
1119                   return False;
1120                end if;
1121
1122                Get_Next_Interp (I, It);
1123             end loop;
1124
1125             return True;
1126          end if;
1127       end Is_Function_Type;
1128
1129    begin
1130       Analyze (P);
1131       Set_Etype (N, Any_Type);
1132
1133       --  Test for remote access to subprogram type, and if so return
1134       --  after rewriting the original tree.
1135
1136       if Remote_AST_E_Dereference (P) then
1137          return;
1138       end if;
1139
1140       --  Normal processing for other than remote access to subprogram type
1141
1142       if not Is_Overloaded (P) then
1143          if Is_Access_Type (Etype (P)) then
1144
1145             --  Set the Etype. We need to go thru Is_For_Access_Subtypes
1146             --  to avoid other problems caused by the Private_Subtype
1147             --  and it is safe to go to the Base_Type because this is the
1148             --  same as converting the access value to its Base_Type.
1149
1150             declare
1151                DT : Entity_Id := Designated_Type (Etype (P));
1152
1153             begin
1154                if Ekind (DT) = E_Private_Subtype
1155                  and then Is_For_Access_Subtype (DT)
1156                then
1157                   DT := Base_Type (DT);
1158                end if;
1159
1160                Set_Etype (N, DT);
1161             end;
1162
1163          elsif Etype (P) /= Any_Type then
1164             Error_Msg_N ("prefix of dereference must be an access type", N);
1165             return;
1166          end if;
1167
1168       else
1169          Get_First_Interp (P, I, It);
1170
1171          while Present (It.Nam) loop
1172             T := It.Typ;
1173
1174             if Is_Access_Type (T) then
1175                Add_One_Interp (N, Designated_Type (T), Designated_Type (T));
1176             end if;
1177
1178             Get_Next_Interp (I, It);
1179          end loop;
1180
1181          End_Interp_List;
1182
1183          --  Error if no interpretation of the prefix has an access type.
1184
1185          if Etype (N) = Any_Type then
1186             Error_Msg_N
1187               ("access type required in prefix of explicit dereference", P);
1188             Set_Etype (N, Any_Type);
1189             return;
1190          end if;
1191       end if;
1192
1193       if Is_Function_Type
1194         and then Nkind (Parent (N)) /= N_Indexed_Component
1195
1196         and then (Nkind (Parent (N)) /= N_Function_Call
1197                    or else N /= Name (Parent (N)))
1198
1199         and then (Nkind (Parent (N)) /= N_Procedure_Call_Statement
1200                    or else N /= Name (Parent (N)))
1201
1202         and then Nkind (Parent (N)) /= N_Subprogram_Renaming_Declaration
1203         and then (Nkind (Parent (N)) /= N_Attribute_Reference
1204                     or else
1205                       (Attribute_Name (Parent (N)) /= Name_Address
1206                         and then
1207                        Attribute_Name (Parent (N)) /= Name_Access))
1208       then
1209          --  Name is a function call with no actuals, in a context that
1210          --  requires deproceduring (including as an actual in an enclosing
1211          --  function or procedure call). We can conceive of pathological cases
1212          --  where the prefix might include functions that return access to
1213          --  subprograms and others that return a regular type. Disambiguation
1214          --  of those will have to take place in Resolve. See e.g. 7117-014.
1215
1216          New_N :=
1217            Make_Function_Call (Loc,
1218            Name => Make_Explicit_Dereference (Loc, P),
1219            Parameter_Associations => New_List);
1220
1221          --  If the prefix is overloaded, remove operations that have formals,
1222          --  we know that this is a parameterless call.
1223
1224          if Is_Overloaded (P) then
1225             Get_First_Interp (P, I, It);
1226
1227             while Present (It.Nam) loop
1228                T := It.Typ;
1229
1230                if No (First_Formal (Base_Type (Designated_Type (T)))) then
1231                   Set_Etype (P, T);
1232                else
1233                   Remove_Interp (I);
1234                end if;
1235
1236                Get_Next_Interp (I, It);
1237             end loop;
1238          end if;
1239
1240          Rewrite (N, New_N);
1241          Analyze (N);
1242       end if;
1243
1244       --  A value of remote access-to-class-wide must not be dereferenced
1245       --  (RM E.2.2(16)).
1246
1247       Validate_Remote_Access_To_Class_Wide_Type (N);
1248
1249    end Analyze_Explicit_Dereference;
1250
1251    ------------------------
1252    -- Analyze_Expression --
1253    ------------------------
1254
1255    procedure Analyze_Expression (N : Node_Id) is
1256    begin
1257       Analyze (N);
1258       Check_Parameterless_Call (N);
1259    end Analyze_Expression;
1260
1261    ------------------------------------
1262    -- Analyze_Indexed_Component_Form --
1263    ------------------------------------
1264
1265    procedure Analyze_Indexed_Component_Form (N : Node_Id) is
1266       P   : constant Node_Id := Prefix (N);
1267       Exprs : List_Id := Expressions (N);
1268       Exp : Node_Id;
1269       P_T : Entity_Id;
1270       E   : Node_Id;
1271       U_N : Entity_Id;
1272
1273       procedure Process_Function_Call;
1274       --  Prefix in indexed component form is an overloadable entity,
1275       --  so the node is a function call. Reformat it as such.
1276
1277       procedure Process_Indexed_Component;
1278       --  Prefix in indexed component form is actually an indexed component.
1279       --  This routine processes it, knowing that the prefix is already
1280       --  resolved.
1281
1282       procedure Process_Indexed_Component_Or_Slice;
1283       --  An indexed component with a single index may designate a slice if
1284       --  the index is a subtype mark. This routine disambiguates these two
1285       --  cases by resolving the prefix to see if it is a subtype mark.
1286
1287       procedure Process_Overloaded_Indexed_Component;
1288       --  If the prefix of an indexed component is overloaded, the proper
1289       --  interpretation is selected by the index types and the context.
1290
1291       ---------------------------
1292       -- Process_Function_Call --
1293       ---------------------------
1294
1295       procedure Process_Function_Call is
1296          Actual : Node_Id;
1297
1298       begin
1299          Change_Node (N, N_Function_Call);
1300          Set_Name (N, P);
1301          Set_Parameter_Associations (N, Exprs);
1302          Actual := First (Parameter_Associations (N));
1303
1304          while Present (Actual) loop
1305             Analyze (Actual);
1306             Check_Parameterless_Call (Actual);
1307             Next_Actual (Actual);
1308          end loop;
1309
1310          Analyze_Call (N);
1311       end Process_Function_Call;
1312
1313       -------------------------------
1314       -- Process_Indexed_Component --
1315       -------------------------------
1316
1317       procedure Process_Indexed_Component is
1318          Exp          : Node_Id;
1319          Array_Type   : Entity_Id;
1320          Index        : Node_Id;
1321          Entry_Family : Entity_Id;
1322
1323       begin
1324          Exp := First (Exprs);
1325
1326          if Is_Overloaded (P) then
1327             Process_Overloaded_Indexed_Component;
1328
1329          else
1330             Array_Type := Etype (P);
1331
1332             --  Prefix must be appropriate for an array type.
1333             --  Dereference the prefix if it is an access type.
1334
1335             if Is_Access_Type (Array_Type) then
1336                Array_Type := Designated_Type (Array_Type);
1337
1338                if Warn_On_Dereference then
1339                   Error_Msg_N ("?implicit dereference", N);
1340                end if;
1341             end if;
1342
1343             if Is_Array_Type (Array_Type) then
1344                null;
1345
1346             elsif (Is_Entity_Name (P)
1347                      and then
1348                    Ekind (Entity (P)) = E_Entry_Family)
1349                or else
1350                  (Nkind (P) = N_Selected_Component
1351                     and then
1352                   Is_Entity_Name (Selector_Name (P))
1353                     and then
1354                   Ekind (Entity (Selector_Name (P))) = E_Entry_Family)
1355             then
1356                if Is_Entity_Name (P) then
1357                   Entry_Family := Entity (P);
1358                else
1359                   Entry_Family := Entity (Selector_Name (P));
1360                end if;
1361
1362                Analyze (Exp);
1363                Set_Etype (N, Any_Type);
1364
1365                if not Has_Compatible_Type
1366                  (Exp, Entry_Index_Type (Entry_Family))
1367                then
1368                   Error_Msg_N ("invalid index type in entry name", N);
1369
1370                elsif Present (Next (Exp)) then
1371                   Error_Msg_N ("too many subscripts in entry reference", N);
1372
1373                else
1374                   Set_Etype (N,  Etype (P));
1375                end if;
1376
1377                return;
1378
1379             elsif Is_Record_Type (Array_Type)
1380               and then Remote_AST_I_Dereference (P)
1381             then
1382                return;
1383
1384             elsif Array_Type = Any_Type then
1385                Set_Etype (N, Any_Type);
1386                return;
1387
1388             --  Here we definitely have a bad indexing
1389
1390             else
1391                if Nkind (Parent (N)) = N_Requeue_Statement
1392                  and then
1393                    ((Is_Entity_Name (P)
1394                         and then Ekind (Entity (P)) = E_Entry)
1395                     or else
1396                      (Nkind (P) = N_Selected_Component
1397                        and then Is_Entity_Name (Selector_Name (P))
1398                        and then Ekind (Entity (Selector_Name (P))) = E_Entry))
1399                then
1400                   Error_Msg_N
1401                     ("REQUEUE does not permit parameters", First (Exprs));
1402
1403                elsif Is_Entity_Name (P)
1404                  and then Etype (P) = Standard_Void_Type
1405                then
1406                   Error_Msg_NE ("incorrect use of&", P, Entity (P));
1407
1408                else
1409                   Error_Msg_N ("array type required in indexed component", P);
1410                end if;
1411
1412                Set_Etype (N, Any_Type);
1413                return;
1414             end if;
1415
1416             Index := First_Index (Array_Type);
1417
1418             while Present (Index) and then Present (Exp) loop
1419                if not Has_Compatible_Type (Exp, Etype (Index)) then
1420                   Wrong_Type (Exp, Etype (Index));
1421                   Set_Etype (N, Any_Type);
1422                   return;
1423                end if;
1424
1425                Next_Index (Index);
1426                Next (Exp);
1427             end loop;
1428
1429             Set_Etype (N, Component_Type (Array_Type));
1430
1431             if Present (Index) then
1432                Error_Msg_N
1433                  ("too few subscripts in array reference", First (Exprs));
1434
1435             elsif Present (Exp) then
1436                Error_Msg_N ("too many subscripts in array reference", Exp);
1437             end if;
1438          end if;
1439
1440       end Process_Indexed_Component;
1441
1442       ----------------------------------------
1443       -- Process_Indexed_Component_Or_Slice --
1444       ----------------------------------------
1445
1446       procedure Process_Indexed_Component_Or_Slice is
1447       begin
1448          Exp := First (Exprs);
1449
1450          while Present (Exp) loop
1451             Analyze_Expression (Exp);
1452             Next (Exp);
1453          end loop;
1454
1455          Exp := First (Exprs);
1456
1457          --  If one index is present, and it is a subtype name, then the
1458          --  node denotes a slice (note that the case of an explicit range
1459          --  for a slice was already built as an N_Slice node in the first
1460          --  place, so that case is not handled here).
1461
1462          --  We use a replace rather than a rewrite here because this is one
1463          --  of the cases in which the tree built by the parser is plain wrong.
1464
1465          if No (Next (Exp))
1466            and then Is_Entity_Name (Exp)
1467            and then Is_Type (Entity (Exp))
1468          then
1469             Replace (N,
1470                Make_Slice (Sloc (N),
1471                  Prefix => P,
1472                  Discrete_Range => New_Copy (Exp)));
1473             Analyze (N);
1474
1475          --  Otherwise (more than one index present, or single index is not
1476          --  a subtype name), then we have the indexed component case.
1477
1478          else
1479             Process_Indexed_Component;
1480          end if;
1481       end Process_Indexed_Component_Or_Slice;
1482
1483       ------------------------------------------
1484       -- Process_Overloaded_Indexed_Component --
1485       ------------------------------------------
1486
1487       procedure Process_Overloaded_Indexed_Component is
1488          Exp   : Node_Id;
1489          I     : Interp_Index;
1490          It    : Interp;
1491          Typ   : Entity_Id;
1492          Index : Node_Id;
1493          Found : Boolean;
1494
1495       begin
1496          Set_Etype (N, Any_Type);
1497          Get_First_Interp (P, I, It);
1498
1499          while Present (It.Nam) loop
1500             Typ := It.Typ;
1501
1502             if Is_Access_Type (Typ) then
1503                Typ := Designated_Type (Typ);
1504
1505                if Warn_On_Dereference then
1506                   Error_Msg_N ("?implicit dereference", N);
1507                end if;
1508             end if;
1509
1510             if Is_Array_Type (Typ) then
1511
1512                --  Got a candidate: verify that index types are compatible
1513
1514                Index := First_Index (Typ);
1515                Found := True;
1516
1517                Exp := First (Exprs);
1518
1519                while Present (Index) and then Present (Exp) loop
1520                   if Has_Compatible_Type (Exp, Etype (Index)) then
1521                      null;
1522                   else
1523                      Found := False;
1524                      Remove_Interp (I);
1525                      exit;
1526                   end if;
1527
1528                   Next_Index (Index);
1529                   Next (Exp);
1530                end loop;
1531
1532                if Found and then No (Index) and then No (Exp) then
1533                   Add_One_Interp (N,
1534                      Etype (Component_Type (Typ)),
1535                      Etype (Component_Type (Typ)));
1536                end if;
1537             end if;
1538
1539             Get_Next_Interp (I, It);
1540          end loop;
1541
1542          if Etype (N) = Any_Type then
1543             Error_Msg_N ("no legal interpetation for indexed component", N);
1544             Set_Is_Overloaded (N, False);
1545          end if;
1546
1547          End_Interp_List;
1548       end Process_Overloaded_Indexed_Component;
1549
1550    ------------------------------------
1551    -- Analyze_Indexed_Component_Form --
1552    ------------------------------------
1553
1554    begin
1555       --  Get name of array, function or type
1556
1557       Analyze (P);
1558       P_T := Base_Type (Etype (P));
1559
1560       if Is_Entity_Name (P)
1561         or else Nkind (P) = N_Operator_Symbol
1562       then
1563          U_N := Entity (P);
1564
1565          if Ekind (U_N) in  Type_Kind then
1566
1567             --  Reformat node as a type conversion.
1568
1569             E := Remove_Head (Exprs);
1570
1571             if Present (First (Exprs)) then
1572                Error_Msg_N
1573                 ("argument of type conversion must be single expression", N);
1574             end if;
1575
1576             Change_Node (N, N_Type_Conversion);
1577             Set_Subtype_Mark (N, P);
1578             Set_Etype (N, U_N);
1579             Set_Expression (N, E);
1580
1581             --  After changing the node, call for the specific Analysis
1582             --  routine directly, to avoid a double call to the expander.
1583
1584             Analyze_Type_Conversion (N);
1585             return;
1586          end if;
1587
1588          if Is_Overloadable (U_N) then
1589             Process_Function_Call;
1590
1591          elsif Ekind (Etype (P)) = E_Subprogram_Type
1592            or else (Is_Access_Type (Etype (P))
1593                       and then
1594                     Ekind (Designated_Type (Etype (P))) = E_Subprogram_Type)
1595          then
1596             --  Call to access_to-subprogram with possible implicit dereference
1597
1598             Process_Function_Call;
1599
1600          elsif Ekind (U_N) = E_Generic_Function
1601            or else Ekind (U_N) = E_Generic_Procedure
1602          then
1603             --  A common beginner's (or C++ templates fan) error.
1604
1605             Error_Msg_N ("generic subprogram cannot be called", N);
1606             Set_Etype (N, Any_Type);
1607             return;
1608
1609          else
1610             Process_Indexed_Component_Or_Slice;
1611          end if;
1612
1613       --  If not an entity name, prefix is an expression that may denote
1614       --  an array or an access-to-subprogram.
1615
1616       else
1617
1618          if (Ekind (P_T) = E_Subprogram_Type)
1619            or else (Is_Access_Type (P_T)
1620                      and then
1621                     Ekind (Designated_Type (P_T)) = E_Subprogram_Type)
1622          then
1623             Process_Function_Call;
1624
1625          elsif Nkind (P) = N_Selected_Component
1626            and then Ekind (Entity (Selector_Name (P))) = E_Function
1627          then
1628             Process_Function_Call;
1629
1630          else
1631             --  Indexed component, slice, or a call to a member of a family
1632             --  entry, which will be converted to an entry call later.
1633             Process_Indexed_Component_Or_Slice;
1634          end if;
1635       end if;
1636    end Analyze_Indexed_Component_Form;
1637
1638    ------------------------
1639    -- Analyze_Logical_Op --
1640    ------------------------
1641
1642    procedure Analyze_Logical_Op (N : Node_Id) is
1643       L     : constant Node_Id := Left_Opnd (N);
1644       R     : constant Node_Id := Right_Opnd (N);
1645       Op_Id : Entity_Id := Entity (N);
1646
1647    begin
1648       Set_Etype (N, Any_Type);
1649       Candidate_Type := Empty;
1650
1651       Analyze_Expression (L);
1652       Analyze_Expression (R);
1653
1654       if Present (Op_Id) then
1655
1656          if Ekind (Op_Id) = E_Operator then
1657             Find_Boolean_Types (L, R, Op_Id, N);
1658          else
1659             Add_One_Interp (N, Op_Id, Etype (Op_Id));
1660          end if;
1661
1662       else
1663          Op_Id := Get_Name_Entity_Id (Chars (N));
1664
1665          while Present (Op_Id) loop
1666             if Ekind (Op_Id) = E_Operator then
1667                Find_Boolean_Types (L, R, Op_Id, N);
1668             else
1669                Analyze_User_Defined_Binary_Op (N, Op_Id);
1670             end if;
1671
1672             Op_Id := Homonym (Op_Id);
1673          end loop;
1674       end if;
1675
1676       Operator_Check (N);
1677    end Analyze_Logical_Op;
1678
1679    ---------------------------
1680    -- Analyze_Membership_Op --
1681    ---------------------------
1682
1683    procedure Analyze_Membership_Op (N : Node_Id) is
1684       L     : constant Node_Id := Left_Opnd (N);
1685       R     : constant Node_Id := Right_Opnd (N);
1686
1687       Index : Interp_Index;
1688       It    : Interp;
1689       Found : Boolean := False;
1690       I_F   : Interp_Index;
1691       T_F   : Entity_Id;
1692
1693       procedure Try_One_Interp (T1 : Entity_Id);
1694       --  Routine to try one proposed interpretation. Note that the context
1695       --  of the operation plays no role in resolving the arguments, so that
1696       --  if there is more than one interpretation of the operands that is
1697       --  compatible with a membership test, the operation is ambiguous.
1698
1699       procedure Try_One_Interp (T1 : Entity_Id) is
1700       begin
1701          if Has_Compatible_Type (R, T1) then
1702             if Found
1703               and then Base_Type (T1) /= Base_Type (T_F)
1704             then
1705                It := Disambiguate (L, I_F, Index, Any_Type);
1706
1707                if It = No_Interp then
1708                   Ambiguous_Operands (N);
1709                   Set_Etype (L, Any_Type);
1710                   return;
1711
1712                else
1713                   T_F := It.Typ;
1714                end if;
1715
1716             else
1717                Found := True;
1718                T_F   := T1;
1719                I_F   := Index;
1720             end if;
1721
1722             Set_Etype (L, T_F);
1723          end if;
1724
1725       end Try_One_Interp;
1726
1727    --  Start of processing for Analyze_Membership_Op
1728
1729    begin
1730       Analyze_Expression (L);
1731
1732       if Nkind (R) = N_Range
1733         or else (Nkind (R) = N_Attribute_Reference
1734                   and then Attribute_Name (R) = Name_Range)
1735       then
1736          Analyze (R);
1737
1738          if not Is_Overloaded (L) then
1739             Try_One_Interp (Etype (L));
1740
1741          else
1742             Get_First_Interp (L, Index, It);
1743
1744             while Present (It.Typ) loop
1745                Try_One_Interp (It.Typ);
1746                Get_Next_Interp (Index, It);
1747             end loop;
1748          end if;
1749
1750       --  If not a range, it can only be a subtype mark, or else there
1751       --  is a more basic error, to be diagnosed in Find_Type.
1752
1753       else
1754          Find_Type (R);
1755
1756          if Is_Entity_Name (R) then
1757             Check_Fully_Declared (Entity (R), R);
1758          end if;
1759       end if;
1760
1761       --  Compatibility between expression and subtype mark or range is
1762       --  checked during resolution. The result of the operation is Boolean
1763       --  in any case.
1764
1765       Set_Etype (N, Standard_Boolean);
1766    end Analyze_Membership_Op;
1767
1768    ----------------------
1769    -- Analyze_Negation --
1770    ----------------------
1771
1772    procedure Analyze_Negation (N : Node_Id) is
1773       R     : constant Node_Id := Right_Opnd (N);
1774       Op_Id : Entity_Id := Entity (N);
1775
1776    begin
1777       Set_Etype (N, Any_Type);
1778       Candidate_Type := Empty;
1779
1780       Analyze_Expression (R);
1781
1782       if Present (Op_Id) then
1783          if Ekind (Op_Id) = E_Operator then
1784             Find_Negation_Types (R, Op_Id, N);
1785          else
1786             Add_One_Interp (N, Op_Id, Etype (Op_Id));
1787          end if;
1788
1789       else
1790          Op_Id := Get_Name_Entity_Id (Chars (N));
1791
1792          while Present (Op_Id) loop
1793             if Ekind (Op_Id) = E_Operator then
1794                Find_Negation_Types (R, Op_Id, N);
1795             else
1796                Analyze_User_Defined_Unary_Op (N, Op_Id);
1797             end if;
1798
1799             Op_Id := Homonym (Op_Id);
1800          end loop;
1801       end if;
1802
1803       Operator_Check (N);
1804    end Analyze_Negation;
1805
1806    -------------------
1807    --  Analyze_Null --
1808    -------------------
1809
1810    procedure Analyze_Null (N : Node_Id) is
1811    begin
1812       Set_Etype (N, Any_Access);
1813    end Analyze_Null;
1814
1815    ----------------------
1816    -- Analyze_One_Call --
1817    ----------------------
1818
1819    procedure Analyze_One_Call
1820       (N       : Node_Id;
1821        Nam     : Entity_Id;
1822        Report  : Boolean;
1823        Success : out Boolean)
1824    is
1825       Actuals    : constant List_Id   := Parameter_Associations (N);
1826       Prev_T     : constant Entity_Id := Etype (N);
1827       Formal     : Entity_Id;
1828       Actual     : Node_Id;
1829       Is_Indexed : Boolean := False;
1830       Subp_Type  : constant Entity_Id := Etype (Nam);
1831       Norm_OK    : Boolean;
1832
1833       procedure Set_Name;
1834       --  If candidate interpretation matches, indicate name and type of
1835       --  result on call node.
1836
1837       --------------
1838       -- Set_Name --
1839       --------------
1840
1841       procedure Set_Name is
1842       begin
1843          Add_One_Interp (N, Nam, Etype (Nam));
1844          Success := True;
1845
1846          --  If the prefix of the call is a name, indicate the entity
1847          --  being called. If it is not a name,  it is an expression that
1848          --  denotes an access to subprogram or else an entry or family. In
1849          --  the latter case, the name is a selected component, and the entity
1850          --  being called is noted on the selector.
1851
1852          if not Is_Type (Nam) then
1853             if Is_Entity_Name (Name (N))
1854               or else Nkind (Name (N)) = N_Operator_Symbol
1855             then
1856                Set_Entity (Name (N), Nam);
1857
1858             elsif Nkind (Name (N)) = N_Selected_Component then
1859                Set_Entity (Selector_Name (Name (N)),  Nam);
1860             end if;
1861          end if;
1862
1863          if Debug_Flag_E and not Report then
1864             Write_Str (" Overloaded call ");
1865             Write_Int (Int (N));
1866             Write_Str (" compatible with ");
1867             Write_Int (Int (Nam));
1868             Write_Eol;
1869          end if;
1870       end Set_Name;
1871
1872    --  Start of processing for Analyze_One_Call
1873
1874    begin
1875       Success := False;
1876
1877       --  If the subprogram has no formals, or if all the formals have
1878       --  defaults, and the return type is an array type, the node may
1879       --  denote an indexing of the result of a parameterless call.
1880
1881       if Needs_No_Actuals (Nam)
1882         and then Present (Actuals)
1883       then
1884          if Is_Array_Type (Subp_Type) then
1885             Is_Indexed := Try_Indexed_Call (N, Nam, Subp_Type);
1886
1887          elsif Is_Access_Type (Subp_Type)
1888            and then Is_Array_Type (Designated_Type (Subp_Type))
1889          then
1890             Is_Indexed :=
1891               Try_Indexed_Call (N, Nam, Designated_Type (Subp_Type));
1892
1893          elsif Is_Access_Type (Subp_Type)
1894            and then Ekind (Designated_Type (Subp_Type))  = E_Subprogram_Type
1895          then
1896             Is_Indexed := Try_Indirect_Call (N, Nam, Subp_Type);
1897          end if;
1898
1899       end if;
1900
1901       Normalize_Actuals (N, Nam, (Report and not Is_Indexed), Norm_OK);
1902
1903       if not Norm_OK then
1904
1905          --  Mismatch in number or names of parameters
1906
1907          if Debug_Flag_E then
1908             Write_Str (" normalization fails in call ");
1909             Write_Int (Int (N));
1910             Write_Str (" with subprogram ");
1911             Write_Int (Int (Nam));
1912             Write_Eol;
1913          end if;
1914
1915       --  If the context expects a function call, discard any interpretation
1916       --  that is a procedure. If the node is not overloaded, leave as is for
1917       --  better error reporting when type mismatch is found.
1918
1919       elsif Nkind (N) = N_Function_Call
1920         and then Is_Overloaded (Name (N))
1921         and then Ekind (Nam) = E_Procedure
1922       then
1923          return;
1924
1925       --  Ditto for function calls in a procedure context.
1926
1927       elsif Nkind (N) = N_Procedure_Call_Statement
1928          and then Is_Overloaded (Name (N))
1929          and then Etype (Nam) /= Standard_Void_Type
1930       then
1931          return;
1932
1933       elsif not Present (Actuals) then
1934
1935          --  If Normalize succeeds, then there are default parameters for
1936          --  all formals.
1937
1938          Set_Name;
1939
1940       elsif Ekind (Nam) = E_Operator then
1941
1942          if Nkind (N) = N_Procedure_Call_Statement then
1943             return;
1944          end if;
1945
1946          --  This can occur when the prefix of the call is an operator
1947          --  name or an expanded name whose selector is an operator name.
1948
1949          Analyze_Operator_Call (N, Nam);
1950
1951          if Etype (N) /= Prev_T then
1952
1953             --  There may be a user-defined operator that hides the
1954             --  current interpretation. We must check for this independently
1955             --  of the analysis of the call with the user-defined operation,
1956             --  because the parameter names may be wrong and yet the hiding
1957             --  takes place. Fixes b34014o.
1958
1959             if Is_Overloaded (Name (N)) then
1960                declare
1961                   I  : Interp_Index;
1962                   It : Interp;
1963
1964                begin
1965                   Get_First_Interp (Name (N), I, It);
1966
1967                   while Present (It.Nam) loop
1968
1969                      if Ekind (It.Nam) /= E_Operator
1970                         and then Hides_Op (It.Nam, Nam)
1971                         and then
1972                           Has_Compatible_Type
1973                             (First_Actual (N), Etype (First_Formal (It.Nam)))
1974                         and then (No (Next_Actual (First_Actual (N)))
1975                            or else Has_Compatible_Type
1976                             (Next_Actual (First_Actual (N)),
1977                              Etype (Next_Formal (First_Formal (It.Nam)))))
1978                      then
1979                         Set_Etype (N, Prev_T);
1980                         return;
1981                      end if;
1982
1983                      Get_Next_Interp (I, It);
1984                   end loop;
1985                end;
1986             end if;
1987
1988             --  If operator matches formals, record its name on the call.
1989             --  If the operator is overloaded, Resolve will select the
1990             --  correct one from the list of interpretations. The call
1991             --  node itself carries the first candidate.
1992
1993             Set_Entity (Name (N), Nam);
1994             Success := True;
1995
1996          elsif Report and then Etype (N) = Any_Type then
1997             Error_Msg_N ("incompatible arguments for operator", N);
1998          end if;
1999
2000       else
2001          --  Normalize_Actuals has chained the named associations in the
2002          --  correct order of the formals.
2003
2004          Actual := First_Actual (N);
2005          Formal := First_Formal (Nam);
2006
2007          while Present (Actual) and then Present (Formal) loop
2008
2009             if (Nkind (Parent (Actual)) /= N_Parameter_Association
2010               or else Chars (Selector_Name (Parent (Actual))) = Chars (Formal))
2011             then
2012                if Has_Compatible_Type (Actual, Etype (Formal)) then
2013                   Next_Actual (Actual);
2014                   Next_Formal (Formal);
2015
2016                else
2017                   if Debug_Flag_E then
2018                      Write_Str (" type checking fails in call ");
2019                      Write_Int (Int (N));
2020                      Write_Str (" with formal ");
2021                      Write_Int (Int (Formal));
2022                      Write_Str (" in subprogram ");
2023                      Write_Int (Int (Nam));
2024                      Write_Eol;
2025                   end if;
2026
2027                   if Report and not Is_Indexed then
2028
2029                      Wrong_Type (Actual, Etype (Formal));
2030
2031                      if Nkind (Actual) = N_Op_Eq
2032                        and then Nkind (Left_Opnd (Actual)) = N_Identifier
2033                      then
2034                         Formal := First_Formal (Nam);
2035
2036                         while Present (Formal) loop
2037
2038                            if Chars (Left_Opnd (Actual)) = Chars (Formal) then
2039                               Error_Msg_N
2040                                 ("possible misspelling of `=>`!", Actual);
2041                               exit;
2042                            end if;
2043
2044                            Next_Formal (Formal);
2045                         end loop;
2046                      end if;
2047
2048                      if All_Errors_Mode then
2049                         Error_Msg_Sloc := Sloc (Nam);
2050
2051                         if Is_Overloadable (Nam)
2052                           and then Present (Alias (Nam))
2053                           and then not Comes_From_Source (Nam)
2054                         then
2055                            Error_Msg_NE
2056                              ("  ==> in call to &#(inherited)!", Actual, Nam);
2057                         else
2058                            Error_Msg_NE ("  ==> in call to &#!", Actual, Nam);
2059                         end if;
2060                      end if;
2061                   end if;
2062
2063                   return;
2064                end if;
2065
2066             else
2067                --  Normalize_Actuals has verified that a default value exists
2068                --  for this formal. Current actual names a subsequent formal.
2069
2070                Next_Formal (Formal);
2071             end if;
2072          end loop;
2073
2074          --  On exit, all actuals match.
2075
2076          Set_Name;
2077       end if;
2078    end Analyze_One_Call;
2079
2080    ----------------------------
2081    --  Analyze_Operator_Call --
2082    ----------------------------
2083
2084    procedure Analyze_Operator_Call (N : Node_Id; Op_Id : Entity_Id) is
2085       Op_Name : constant Name_Id := Chars (Op_Id);
2086       Act1    : constant Node_Id := First_Actual (N);
2087       Act2    : constant Node_Id := Next_Actual (Act1);
2088
2089    begin
2090       if Present (Act2) then
2091
2092          --  Maybe binary operators
2093
2094          if Present (Next_Actual (Act2)) then
2095
2096             --  Too many actuals for an operator
2097
2098             return;
2099
2100          elsif     Op_Name = Name_Op_Add
2101            or else Op_Name = Name_Op_Subtract
2102            or else Op_Name = Name_Op_Multiply
2103            or else Op_Name = Name_Op_Divide
2104            or else Op_Name = Name_Op_Mod
2105            or else Op_Name = Name_Op_Rem
2106            or else Op_Name = Name_Op_Expon
2107          then
2108             Find_Arithmetic_Types (Act1, Act2, Op_Id, N);
2109
2110          elsif     Op_Name =  Name_Op_And
2111            or else Op_Name = Name_Op_Or
2112            or else Op_Name = Name_Op_Xor
2113          then
2114             Find_Boolean_Types (Act1, Act2, Op_Id, N);
2115
2116          elsif     Op_Name = Name_Op_Lt
2117            or else Op_Name = Name_Op_Le
2118            or else Op_Name = Name_Op_Gt
2119            or else Op_Name = Name_Op_Ge
2120          then
2121             Find_Comparison_Types (Act1, Act2, Op_Id,  N);
2122
2123          elsif     Op_Name = Name_Op_Eq
2124            or else Op_Name = Name_Op_Ne
2125          then
2126             Find_Equality_Types (Act1, Act2, Op_Id,  N);
2127
2128          elsif     Op_Name = Name_Op_Concat then
2129             Find_Concatenation_Types (Act1, Act2, Op_Id, N);
2130
2131          --  Is this else null correct, or should it be an abort???
2132
2133          else
2134             null;
2135          end if;
2136
2137       else
2138          --  Unary operators
2139
2140          if Op_Name = Name_Op_Subtract or else
2141             Op_Name = Name_Op_Add      or else
2142             Op_Name = Name_Op_Abs
2143          then
2144             Find_Unary_Types (Act1, Op_Id, N);
2145
2146          elsif
2147             Op_Name = Name_Op_Not
2148          then
2149             Find_Negation_Types (Act1, Op_Id, N);
2150
2151          --  Is this else null correct, or should it be an abort???
2152
2153          else
2154             null;
2155          end if;
2156       end if;
2157    end Analyze_Operator_Call;
2158
2159    -------------------------------------------
2160    -- Analyze_Overloaded_Selected_Component --
2161    -------------------------------------------
2162
2163    procedure Analyze_Overloaded_Selected_Component (N : Node_Id) is
2164       Comp  : Entity_Id;
2165       Nam   : Node_Id := Prefix (N);
2166       Sel   : Node_Id := Selector_Name (N);
2167       I     : Interp_Index;
2168       It    : Interp;
2169       T     : Entity_Id;
2170
2171    begin
2172       Get_First_Interp (Nam, I, It);
2173
2174       Set_Etype (Sel,  Any_Type);
2175
2176       while Present (It.Typ) loop
2177          if Is_Access_Type (It.Typ) then
2178             T := Designated_Type (It.Typ);
2179
2180             if Warn_On_Dereference then
2181                Error_Msg_N ("?implicit dereference", N);
2182             end if;
2183
2184          else
2185             T := It.Typ;
2186          end if;
2187
2188          if Is_Record_Type (T) then
2189             Comp := First_Entity (T);
2190
2191             while Present (Comp) loop
2192
2193                if Chars (Comp) = Chars (Sel)
2194                  and then Is_Visible_Component (Comp)
2195                then
2196                   Set_Entity_With_Style_Check (Sel, Comp);
2197                   Generate_Reference (Comp, Sel);
2198
2199                   Set_Etype (Sel, Etype (Comp));
2200                   Add_One_Interp (N, Etype (Comp), Etype (Comp));
2201
2202                   --  This also specifies a candidate to resolve the name.
2203                   --  Further overloading will be resolved from context.
2204
2205                   Set_Etype (Nam, It.Typ);
2206                end if;
2207
2208                Next_Entity (Comp);
2209             end loop;
2210
2211          elsif Is_Concurrent_Type (T) then
2212             Comp := First_Entity (T);
2213
2214             while Present (Comp)
2215               and then Comp /= First_Private_Entity (T)
2216             loop
2217                if Chars (Comp) = Chars (Sel) then
2218                   if Is_Overloadable (Comp) then
2219                      Add_One_Interp (Sel, Comp, Etype (Comp));
2220                   else
2221                      Set_Entity_With_Style_Check (Sel, Comp);
2222                      Generate_Reference (Comp, Sel);
2223                   end if;
2224
2225                   Set_Etype (Sel, Etype (Comp));
2226                   Set_Etype (N,   Etype (Comp));
2227                   Set_Etype (Nam, It.Typ);
2228
2229                   --  For access type case, introduce explicit deference for
2230                   --  more uniform treatment of entry calls.
2231
2232                   if Is_Access_Type (Etype (Nam)) then
2233                      Insert_Explicit_Dereference (Nam);
2234
2235                      if Warn_On_Dereference then
2236                         Error_Msg_N ("?implicit dereference", N);
2237                      end if;
2238                   end if;
2239                end if;
2240
2241                Next_Entity (Comp);
2242             end loop;
2243
2244             Set_Is_Overloaded (N, Is_Overloaded (Sel));
2245          end if;
2246
2247          Get_Next_Interp (I, It);
2248       end loop;
2249
2250       if Etype (N) = Any_Type then
2251          Error_Msg_NE ("undefined selector& for overloaded prefix", N, Sel);
2252          Set_Entity (Sel, Any_Id);
2253          Set_Etype  (Sel, Any_Type);
2254       end if;
2255
2256    end Analyze_Overloaded_Selected_Component;
2257
2258    ----------------------------------
2259    -- Analyze_Qualified_Expression --
2260    ----------------------------------
2261
2262    procedure Analyze_Qualified_Expression (N : Node_Id) is
2263       Mark : constant Entity_Id := Subtype_Mark (N);
2264       T    : Entity_Id;
2265
2266    begin
2267       Set_Etype (N, Any_Type);
2268       Find_Type (Mark);
2269       T := Entity (Mark);
2270
2271       if T = Any_Type then
2272          return;
2273       end if;
2274       Check_Fully_Declared (T, N);
2275
2276       Analyze_Expression (Expression (N));
2277       Set_Etype  (N, T);
2278    end Analyze_Qualified_Expression;
2279
2280    -------------------
2281    -- Analyze_Range --
2282    -------------------
2283
2284    procedure Analyze_Range (N : Node_Id) is
2285       L        : constant Node_Id := Low_Bound (N);
2286       H        : constant Node_Id := High_Bound (N);
2287       I1, I2   : Interp_Index;
2288       It1, It2 : Interp;
2289
2290       procedure Check_Common_Type (T1, T2 : Entity_Id);
2291       --  Verify the compatibility of two types,  and choose the
2292       --  non universal one if the other is universal.
2293
2294       procedure Check_High_Bound (T : Entity_Id);
2295       --  Test one interpretation of the low bound against all those
2296       --  of the high bound.
2297
2298       -----------------------
2299       -- Check_Common_Type --
2300       -----------------------
2301
2302       procedure Check_Common_Type (T1, T2 : Entity_Id) is
2303       begin
2304          if Covers (T1, T2) or else Covers (T2, T1) then
2305             if T1 = Universal_Integer
2306               or else T1 = Universal_Real
2307               or else T1 = Any_Character
2308             then
2309                Add_One_Interp (N, Base_Type (T2), Base_Type (T2));
2310
2311             elsif (T1 = T2) then
2312                Add_One_Interp (N, T1, T1);
2313
2314             else
2315                Add_One_Interp (N, Base_Type (T1), Base_Type (T1));
2316             end if;
2317          end if;
2318       end Check_Common_Type;
2319
2320       ----------------------
2321       -- Check_High_Bound --
2322       ----------------------
2323
2324       procedure Check_High_Bound (T : Entity_Id) is
2325       begin
2326          if not Is_Overloaded (H) then
2327             Check_Common_Type (T, Etype (H));
2328          else
2329             Get_First_Interp (H, I2, It2);
2330
2331             while Present (It2.Typ) loop
2332                Check_Common_Type (T, It2.Typ);
2333                Get_Next_Interp (I2, It2);
2334             end loop;
2335          end if;
2336       end Check_High_Bound;
2337
2338    --  Start of processing for Analyze_Range
2339
2340    begin
2341       Set_Etype (N, Any_Type);
2342       Analyze_Expression (L);
2343       Analyze_Expression (H);
2344
2345       if Etype (L) = Any_Type or else Etype (H) = Any_Type then
2346          return;
2347
2348       else
2349          if not Is_Overloaded (L) then
2350             Check_High_Bound (Etype (L));
2351          else
2352             Get_First_Interp (L, I1, It1);
2353
2354             while Present (It1.Typ) loop
2355                Check_High_Bound (It1.Typ);
2356                Get_Next_Interp (I1, It1);
2357             end loop;
2358          end if;
2359
2360          --  If result is Any_Type, then we did not find a compatible pair
2361
2362          if Etype (N) = Any_Type then
2363             Error_Msg_N ("incompatible types in range ", N);
2364          end if;
2365       end if;
2366    end Analyze_Range;
2367
2368    -----------------------
2369    -- Analyze_Reference --
2370    -----------------------
2371
2372    procedure Analyze_Reference (N : Node_Id) is
2373       P        : constant Node_Id := Prefix (N);
2374       Acc_Type : Entity_Id;
2375
2376    begin
2377       Analyze (P);
2378       Acc_Type := Create_Itype (E_Allocator_Type, N);
2379       Set_Etype                    (Acc_Type,  Acc_Type);
2380       Init_Size_Align              (Acc_Type);
2381       Set_Directly_Designated_Type (Acc_Type, Etype (P));
2382       Set_Etype (N, Acc_Type);
2383    end Analyze_Reference;
2384
2385    --------------------------------
2386    -- Analyze_Selected_Component --
2387    --------------------------------
2388
2389    --  Prefix is a record type or a task or protected type. In the
2390    --  later case, the selector must denote a visible entry.
2391
2392    procedure Analyze_Selected_Component (N : Node_Id) is
2393       Name        : constant Node_Id := Prefix (N);
2394       Sel         : constant Node_Id := Selector_Name (N);
2395       Comp        : Entity_Id;
2396       Entity_List : Entity_Id;
2397       Prefix_Type : Entity_Id;
2398       Act_Decl    : Node_Id;
2399       In_Scope    : Boolean;
2400       Parent_N    : Node_Id;
2401
2402    --  Start of processing for Analyze_Selected_Component
2403
2404    begin
2405       Set_Etype (N, Any_Type);
2406
2407       if Is_Overloaded (Name) then
2408          Analyze_Overloaded_Selected_Component (N);
2409          return;
2410
2411       elsif Etype (Name) = Any_Type then
2412          Set_Entity (Sel, Any_Id);
2413          Set_Etype (Sel, Any_Type);
2414          return;
2415
2416       else
2417          --  Function calls that are prefixes of selected components must be
2418          --  fully resolved in case we need to build an actual subtype, or
2419          --  do some other operation requiring a fully resolved prefix.
2420
2421          --  Note: Resolving all Nkinds of nodes here doesn't work.
2422          --  (Breaks 2129-008) ???.
2423
2424          if Nkind (Name) = N_Function_Call then
2425             Resolve (Name, Etype (Name));
2426          end if;
2427
2428          Prefix_Type := Etype (Name);
2429       end if;
2430
2431       if Is_Access_Type (Prefix_Type) then
2432
2433          --  A RACW object can never be used as prefix of a selected
2434          --  component since that means it is dereferenced without
2435          --  being a controlling operand of a dispatching operation
2436          --  (RM E.2.2(15)).
2437
2438          if Is_Remote_Access_To_Class_Wide_Type (Prefix_Type)
2439            and then Comes_From_Source (N)
2440          then
2441             Error_Msg_N
2442               ("invalid dereference of a remote access to class-wide value",
2443                N);
2444
2445          --  Normal case of selected component applied to access type
2446
2447          else
2448             if Warn_On_Dereference then
2449                Error_Msg_N ("?implicit dereference", N);
2450             end if;
2451          end if;
2452
2453          Prefix_Type := Designated_Type (Prefix_Type);
2454       end if;
2455
2456       if Ekind (Prefix_Type) = E_Private_Subtype then
2457          Prefix_Type := Base_Type (Prefix_Type);
2458       end if;
2459
2460       Entity_List := Prefix_Type;
2461
2462       --  For class-wide types, use the entity list of the root type. This
2463       --  indirection is specially important for private extensions because
2464       --  only the root type get switched (not the class-wide type).
2465
2466       if Is_Class_Wide_Type (Prefix_Type) then
2467          Entity_List := Root_Type (Prefix_Type);
2468       end if;
2469
2470       Comp := First_Entity (Entity_List);
2471
2472       --  If the selector has an original discriminant, the node appears in
2473       --  an instance. Replace the discriminant with the corresponding one
2474       --  in the current discriminated type. For nested generics, this must
2475       --  be done transitively, so note the new original discriminant.
2476
2477       if Nkind (Sel) = N_Identifier
2478         and then Present (Original_Discriminant (Sel))
2479       then
2480          Comp := Find_Corresponding_Discriminant (Sel, Prefix_Type);
2481
2482          --  Mark entity before rewriting, for completeness and because
2483          --  subsequent semantic checks might examine the original node.
2484
2485          Set_Entity (Sel, Comp);
2486          Rewrite (Selector_Name (N),
2487            New_Occurrence_Of (Comp, Sloc (N)));
2488          Set_Original_Discriminant (Selector_Name (N), Comp);
2489          Set_Etype (N, Etype (Comp));
2490
2491          if Is_Access_Type (Etype (Name)) then
2492             Insert_Explicit_Dereference (Name);
2493
2494             if Warn_On_Dereference then
2495                Error_Msg_N ("?implicit dereference", N);
2496             end if;
2497          end if;
2498
2499       elsif Is_Record_Type (Prefix_Type) then
2500
2501          --  Find component with given name
2502
2503          while Present (Comp) loop
2504
2505             if Chars (Comp) = Chars (Sel)
2506               and then Is_Visible_Component (Comp)
2507             then
2508                Set_Entity_With_Style_Check (Sel, Comp);
2509                Generate_Reference (Comp, Sel);
2510
2511                Set_Etype (Sel, Etype (Comp));
2512
2513                if Ekind (Comp) = E_Discriminant then
2514                   if Is_Unchecked_Union (Prefix_Type) then
2515                      Error_Msg_N
2516                        ("cannot reference discriminant of Unchecked_Union",
2517                         Sel);
2518                   end if;
2519
2520                   if Is_Generic_Type (Prefix_Type)
2521                        or else
2522                      Is_Generic_Type (Root_Type (Prefix_Type))
2523                   then
2524                      Set_Original_Discriminant (Sel, Comp);
2525                   end if;
2526                end if;
2527
2528                --  Resolve the prefix early otherwise it is not possible to
2529                --  build the actual subtype of the component: it may need
2530                --  to duplicate this prefix and duplication is only allowed
2531                --  on fully resolved expressions.
2532
2533                Resolve (Name, Etype (Name));
2534
2535                --  We never need an actual subtype for the case of a selection
2536                --  for a indexed component of a non-packed array, since in
2537                --  this case gigi generates all the checks and can find the
2538                --  necessary bounds information.
2539
2540                --  We also do not need an actual subtype for the case of
2541                --  a first, last, length, or range attribute applied to a
2542                --  non-packed array, since gigi can again get the bounds in
2543                --  these cases (gigi cannot handle the packed case, since it
2544                --  has the bounds of the packed array type, not the original
2545                --  bounds of the type). However, if the prefix is itself a
2546                --  selected component, as in a.b.c (i), gigi may regard a.b.c
2547                --  as a dynamic-sized temporary, so we do generate an actual
2548                --  subtype for this case.
2549
2550                Parent_N := Parent (N);
2551
2552                if not Is_Packed (Etype (Comp))
2553                  and then
2554                    ((Nkind (Parent_N) = N_Indexed_Component
2555                       and then Nkind (Name) /= N_Selected_Component)
2556                      or else
2557                       (Nkind (Parent_N) = N_Attribute_Reference
2558                          and then (Attribute_Name (Parent_N) = Name_First
2559                                     or else
2560                                    Attribute_Name (Parent_N) = Name_Last
2561                                     or else
2562                                    Attribute_Name (Parent_N) = Name_Length
2563                                     or else
2564                                    Attribute_Name (Parent_N) = Name_Range)))
2565                then
2566                   Set_Etype (N, Etype (Comp));
2567
2568                --  In all other cases, we currently build an actual subtype. It
2569                --  seems likely that many of these cases can be avoided, but
2570                --  right now, the front end makes direct references to the
2571                --  bounds (e.g. in egnerating a length check), and if we do
2572                --  not make an actual subtype, we end up getting a direct
2573                --  reference to a discriminant which will not do.
2574
2575                else
2576                   Act_Decl :=
2577                     Build_Actual_Subtype_Of_Component (Etype (Comp), N);
2578                   Insert_Action (N, Act_Decl);
2579
2580                   if No (Act_Decl) then
2581                      Set_Etype (N, Etype (Comp));
2582
2583                   else
2584                      --  Component type depends on discriminants. Enter the
2585                      --  main attributes of the subtype.
2586
2587                      declare
2588                         Subt : Entity_Id := Defining_Identifier (Act_Decl);
2589
2590                      begin
2591                         Set_Etype (Subt, Base_Type (Etype (Comp)));
2592                         Set_Ekind (Subt, Ekind (Etype (Comp)));
2593                         Set_Etype (N, Subt);
2594                      end;
2595                   end if;
2596                end if;
2597
2598                return;
2599             end if;
2600
2601             Next_Entity (Comp);
2602          end loop;
2603
2604       elsif Is_Private_Type (Prefix_Type) then
2605
2606          --  Allow access only to discriminants of the type. If the
2607          --  type has no full view, gigi uses the parent type for
2608          --  the components, so we do the same here.
2609
2610          if No (Full_View (Prefix_Type)) then
2611             Entity_List := Root_Type (Base_Type (Prefix_Type));
2612             Comp := First_Entity (Entity_List);
2613          end if;
2614
2615          while Present (Comp) loop
2616
2617             if Chars (Comp) = Chars (Sel) then
2618                if Ekind (Comp) = E_Discriminant then
2619                   Set_Entity_With_Style_Check (Sel, Comp);
2620                   Generate_Reference (Comp, Sel);
2621
2622                   Set_Etype (Sel, Etype (Comp));
2623                   Set_Etype (N,   Etype (Comp));
2624
2625                   if Is_Generic_Type (Prefix_Type)
2626                     or else
2627                      Is_Generic_Type (Root_Type (Prefix_Type))
2628                   then
2629                      Set_Original_Discriminant (Sel, Comp);
2630                   end if;
2631
2632                else
2633                   Error_Msg_NE
2634                     ("invisible selector for }",
2635                      N, First_Subtype (Prefix_Type));
2636                   Set_Entity (Sel, Any_Id);
2637                   Set_Etype (N, Any_Type);
2638                end if;
2639
2640                return;
2641             end if;
2642
2643             Next_Entity (Comp);
2644          end loop;
2645
2646       elsif Is_Concurrent_Type (Prefix_Type) then
2647
2648          --  Prefix is concurrent type. Find visible operation with given name
2649          --  For a task, this can only include entries or discriminants if
2650          --  the task type is not an enclosing scope. If it is an enclosing
2651          --  scope (e.g. in an inner task) then all entities are visible, but
2652          --  the prefix must denote the enclosing scope, i.e. can only be
2653          --  a direct name or an expanded name.
2654
2655          Set_Etype (Sel,  Any_Type);
2656          In_Scope := In_Open_Scopes (Prefix_Type);
2657
2658          while Present (Comp) loop
2659             if Chars (Comp) = Chars (Sel) then
2660                if Is_Overloadable (Comp) then
2661                   Add_One_Interp (Sel, Comp, Etype (Comp));
2662
2663                elsif Ekind (Comp) = E_Discriminant
2664                  or else Ekind (Comp) = E_Entry_Family
2665                  or else (In_Scope
2666                    and then Is_Entity_Name (Name))
2667                then
2668                   Set_Entity_With_Style_Check (Sel, Comp);
2669                   Generate_Reference (Comp, Sel);
2670
2671                else
2672                   goto Next_Comp;
2673                end if;
2674
2675                Set_Etype (Sel, Etype (Comp));
2676                Set_Etype (N,   Etype (Comp));
2677
2678                if Ekind (Comp) = E_Discriminant then
2679                   Set_Original_Discriminant (Sel, Comp);
2680                end if;
2681
2682                --  For access type case, introduce explicit deference for
2683                --  more uniform treatment of entry calls.
2684
2685                if Is_Access_Type (Etype (Name)) then
2686                   Insert_Explicit_Dereference (Name);
2687
2688                   if Warn_On_Dereference then
2689                      Error_Msg_N ("?implicit dereference", N);
2690                   end if;
2691                end if;
2692             end if;
2693
2694             <<Next_Comp>>
2695                Next_Entity (Comp);
2696                exit when not In_Scope
2697                  and then Comp = First_Private_Entity (Prefix_Type);
2698          end loop;
2699
2700          Set_Is_Overloaded (N, Is_Overloaded (Sel));
2701
2702       else
2703          --  Invalid prefix
2704
2705          Error_Msg_NE ("invalid prefix in selected component&", N, Sel);
2706       end if;
2707
2708       --  If N still has no type, the component is not defined in the prefix.
2709
2710       if Etype (N) = Any_Type then
2711
2712          --  If the prefix is a single concurrent object, use its name in
2713          --  the error message, rather than that of its anonymous type.
2714
2715          if Is_Concurrent_Type (Prefix_Type)
2716            and then Is_Internal_Name (Chars (Prefix_Type))
2717            and then not Is_Derived_Type (Prefix_Type)
2718            and then Is_Entity_Name (Name)
2719          then
2720
2721             Error_Msg_Node_2 := Entity (Name);
2722             Error_Msg_NE ("no selector& for&", N, Sel);
2723
2724             Check_Misspelled_Selector (Entity_List, Sel);
2725
2726          elsif Is_Generic_Type (Prefix_Type)
2727            and then Ekind (Prefix_Type) = E_Record_Type_With_Private
2728            and then Prefix_Type /= Etype (Prefix_Type)
2729            and then Is_Record_Type (Etype (Prefix_Type))
2730          then
2731             --  If this is a derived formal type, the parent may have a
2732             --  different visibility at this point. Try for an inherited
2733             --  component before reporting an error.
2734
2735             Set_Etype (Prefix (N), Etype (Prefix_Type));
2736             Analyze_Selected_Component (N);
2737             return;
2738
2739          else
2740             if Ekind (Prefix_Type) = E_Record_Subtype then
2741
2742                --  Check whether this is a component of the base type
2743                --  which is absent from a statically constrained subtype.
2744                --  This will raise constraint error at run-time, but is
2745                --  not a compile-time error. When the selector is illegal
2746                --  for base type as well fall through and generate a
2747                --  compilation error anyway.
2748
2749                Comp := First_Component (Base_Type (Prefix_Type));
2750
2751                while Present (Comp) loop
2752
2753                   if Chars (Comp) = Chars (Sel)
2754                     and then Is_Visible_Component (Comp)
2755                   then
2756                      Set_Entity_With_Style_Check (Sel, Comp);
2757                      Generate_Reference (Comp, Sel);
2758                      Set_Etype (Sel, Etype (Comp));
2759                      Set_Etype (N,   Etype (Comp));
2760
2761                      --  Emit appropriate message. Gigi will replace the
2762                      --  node subsequently with the appropriate Raise.
2763
2764                      Apply_Compile_Time_Constraint_Error
2765                        (N, "component not present in }?",
2766                         CE_Discriminant_Check_Failed,
2767                         Ent => Prefix_Type, Rep => False);
2768                      Set_Raises_Constraint_Error (N);
2769                      return;
2770                   end if;
2771
2772                   Next_Component (Comp);
2773                end loop;
2774
2775             end if;
2776
2777             Error_Msg_Node_2 := First_Subtype (Prefix_Type);
2778             Error_Msg_NE ("no selector& for}", N, Sel);
2779
2780             Check_Misspelled_Selector (Entity_List, Sel);
2781
2782          end if;
2783
2784          Set_Entity (Sel, Any_Id);
2785          Set_Etype (Sel, Any_Type);
2786       end if;
2787    end Analyze_Selected_Component;
2788
2789    ---------------------------
2790    -- Analyze_Short_Circuit --
2791    ---------------------------
2792
2793    procedure Analyze_Short_Circuit (N : Node_Id) is
2794       L   : constant Node_Id := Left_Opnd  (N);
2795       R   : constant Node_Id := Right_Opnd (N);
2796       Ind : Interp_Index;
2797       It  : Interp;
2798
2799    begin
2800       Analyze_Expression (L);
2801       Analyze_Expression (R);
2802       Set_Etype (N, Any_Type);
2803
2804       if not Is_Overloaded (L) then
2805
2806          if Root_Type (Etype (L)) = Standard_Boolean
2807            and then Has_Compatible_Type (R, Etype (L))
2808          then
2809             Add_One_Interp (N, Etype (L), Etype (L));
2810          end if;
2811
2812       else
2813          Get_First_Interp (L, Ind, It);
2814
2815          while Present (It.Typ) loop
2816             if Root_Type (It.Typ) = Standard_Boolean
2817               and then Has_Compatible_Type (R, It.Typ)
2818             then
2819                Add_One_Interp (N, It.Typ, It.Typ);
2820             end if;
2821
2822             Get_Next_Interp (Ind, It);
2823          end loop;
2824       end if;
2825
2826       --  Here we have failed to find an interpretation. Clearly we
2827       --  know that it is not the case that both operands can have
2828       --  an interpretation of Boolean, but this is by far the most
2829       --  likely intended interpretation. So we simply resolve both
2830       --  operands as Booleans, and at least one of these resolutions
2831       --  will generate an error message, and we do not need to give
2832       --  a further error message on the short circuit operation itself.
2833
2834       if Etype (N) = Any_Type then
2835          Resolve (L, Standard_Boolean);
2836          Resolve (R, Standard_Boolean);
2837          Set_Etype (N, Standard_Boolean);
2838       end if;
2839    end Analyze_Short_Circuit;
2840
2841    -------------------
2842    -- Analyze_Slice --
2843    -------------------
2844
2845    procedure Analyze_Slice (N : Node_Id) is
2846       P          : constant Node_Id := Prefix (N);
2847       D          : constant Node_Id := Discrete_Range (N);
2848       Array_Type : Entity_Id;
2849
2850       procedure Analyze_Overloaded_Slice;
2851       --  If the prefix is overloaded, select those interpretations that
2852       --  yield a one-dimensional array type.
2853
2854       procedure Analyze_Overloaded_Slice is
2855          I   : Interp_Index;
2856          It  : Interp;
2857          Typ : Entity_Id;
2858
2859       begin
2860          Set_Etype (N, Any_Type);
2861          Get_First_Interp (P, I, It);
2862
2863          while Present (It.Nam) loop
2864             Typ := It.Typ;
2865
2866             if Is_Access_Type (Typ) then
2867                Typ := Designated_Type (Typ);
2868
2869                if Warn_On_Dereference then
2870                   Error_Msg_N ("?implicit dereference", N);
2871                end if;
2872             end if;
2873
2874             if Is_Array_Type (Typ)
2875               and then Number_Dimensions (Typ) = 1
2876               and then Has_Compatible_Type (D, Etype (First_Index (Typ)))
2877             then
2878                Add_One_Interp (N, Typ, Typ);
2879             end if;
2880
2881             Get_Next_Interp (I, It);
2882          end loop;
2883
2884          if Etype (N) = Any_Type then
2885             Error_Msg_N ("expect array type in prefix of slice",  N);
2886          end if;
2887       end Analyze_Overloaded_Slice;
2888
2889    --  Start of processing for Analyze_Slice
2890
2891    begin
2892       --  Analyze the prefix if not done already
2893
2894       if No (Etype (P)) then
2895          Analyze (P);
2896       end if;
2897
2898       Analyze (D);
2899
2900       if Is_Overloaded (P) then
2901          Analyze_Overloaded_Slice;
2902
2903       else
2904          Array_Type := Etype (P);
2905          Set_Etype (N, Any_Type);
2906
2907          if Is_Access_Type (Array_Type) then
2908             Array_Type := Designated_Type (Array_Type);
2909
2910             if Warn_On_Dereference then
2911                Error_Msg_N ("?implicit dereference", N);
2912             end if;
2913          end if;
2914
2915          if not Is_Array_Type (Array_Type) then
2916             Wrong_Type (P, Any_Array);
2917
2918          elsif Number_Dimensions (Array_Type) > 1 then
2919             Error_Msg_N
2920               ("type is not one-dimensional array in slice prefix", N);
2921
2922          elsif not
2923            Has_Compatible_Type (D, Etype (First_Index (Array_Type)))
2924          then
2925             Wrong_Type (D, Etype (First_Index (Array_Type)));
2926
2927          else
2928             Set_Etype (N, Array_Type);
2929          end if;
2930       end if;
2931    end Analyze_Slice;
2932
2933    -----------------------------
2934    -- Analyze_Type_Conversion --
2935    -----------------------------
2936
2937    procedure Analyze_Type_Conversion (N : Node_Id) is
2938       Expr : constant Node_Id := Expression (N);
2939       T    : Entity_Id;
2940
2941    begin
2942       --  If Conversion_OK is set, then the Etype is already set, and the
2943       --  only processing required is to analyze the expression. This is
2944       --  used to construct certain "illegal" conversions which are not
2945       --  allowed by Ada semantics, but can be handled OK by Gigi, see
2946       --  Sinfo for further details.
2947
2948       if Conversion_OK (N) then
2949          Analyze (Expr);
2950          return;
2951       end if;
2952
2953       --  Otherwise full type analysis is required, as well as some semantic
2954       --  checks to make sure the argument of the conversion is appropriate.
2955
2956       Find_Type (Subtype_Mark (N));
2957       T := Entity (Subtype_Mark (N));
2958       Set_Etype (N, T);
2959       Check_Fully_Declared (T, N);
2960       Analyze_Expression (Expr);
2961       Validate_Remote_Type_Type_Conversion (N);
2962
2963       --  Only remaining step is validity checks on the argument. These
2964       --  are skipped if the conversion does not come from the source.
2965
2966       if not Comes_From_Source (N) then
2967          return;
2968
2969       elsif Nkind (Expr) = N_Null then
2970          Error_Msg_N ("argument of conversion cannot be null", N);
2971          Error_Msg_N ("\use qualified expression instead", N);
2972          Set_Etype (N, Any_Type);
2973
2974       elsif Nkind (Expr) = N_Aggregate then
2975          Error_Msg_N ("argument of conversion cannot be aggregate", N);
2976          Error_Msg_N ("\use qualified expression instead", N);
2977
2978       elsif Nkind (Expr) = N_Allocator then
2979          Error_Msg_N ("argument of conversion cannot be an allocator", N);
2980          Error_Msg_N ("\use qualified expression instead", N);
2981
2982       elsif Nkind (Expr) = N_String_Literal then
2983          Error_Msg_N ("argument of conversion cannot be string literal", N);
2984          Error_Msg_N ("\use qualified expression instead", N);
2985
2986       elsif Nkind (Expr) = N_Character_Literal then
2987          if Ada_83 then
2988             Resolve (Expr, T);
2989          else
2990             Error_Msg_N ("argument of conversion cannot be character literal",
2991               N);
2992             Error_Msg_N ("\use qualified expression instead", N);
2993          end if;
2994
2995       elsif Nkind (Expr) = N_Attribute_Reference
2996         and then
2997           (Attribute_Name (Expr) = Name_Access            or else
2998            Attribute_Name (Expr) = Name_Unchecked_Access  or else
2999            Attribute_Name (Expr) = Name_Unrestricted_Access)
3000       then
3001          Error_Msg_N ("argument of conversion cannot be access", N);
3002          Error_Msg_N ("\use qualified expression instead", N);
3003       end if;
3004
3005    end Analyze_Type_Conversion;
3006
3007    ----------------------
3008    -- Analyze_Unary_Op --
3009    ----------------------
3010
3011    procedure Analyze_Unary_Op (N : Node_Id) is
3012       R     : constant Node_Id := Right_Opnd (N);
3013       Op_Id : Entity_Id := Entity (N);
3014
3015    begin
3016       Set_Etype (N, Any_Type);
3017       Candidate_Type := Empty;
3018
3019       Analyze_Expression (R);
3020
3021       if Present (Op_Id) then
3022          if Ekind (Op_Id) = E_Operator then
3023             Find_Unary_Types (R, Op_Id,  N);
3024          else
3025             Add_One_Interp (N, Op_Id, Etype (Op_Id));
3026          end if;
3027
3028       else
3029          Op_Id := Get_Name_Entity_Id (Chars (N));
3030
3031          while Present (Op_Id) loop
3032
3033             if Ekind (Op_Id) = E_Operator then
3034                if No (Next_Entity (First_Entity (Op_Id))) then
3035                   Find_Unary_Types (R, Op_Id,  N);
3036                end if;
3037
3038             elsif Is_Overloadable (Op_Id) then
3039                Analyze_User_Defined_Unary_Op (N, Op_Id);
3040             end if;
3041
3042             Op_Id := Homonym (Op_Id);
3043          end loop;
3044       end if;
3045
3046       Operator_Check (N);
3047    end Analyze_Unary_Op;
3048
3049    ----------------------------------
3050    -- Analyze_Unchecked_Expression --
3051    ----------------------------------
3052
3053    procedure Analyze_Unchecked_Expression (N : Node_Id) is
3054    begin
3055       Analyze (Expression (N), Suppress => All_Checks);
3056       Set_Etype (N, Etype (Expression (N)));
3057       Save_Interps (Expression (N), N);
3058    end Analyze_Unchecked_Expression;
3059
3060    ---------------------------------------
3061    -- Analyze_Unchecked_Type_Conversion --
3062    ---------------------------------------
3063
3064    procedure Analyze_Unchecked_Type_Conversion (N : Node_Id) is
3065    begin
3066       Find_Type (Subtype_Mark (N));
3067       Analyze_Expression (Expression (N));
3068       Set_Etype (N, Entity (Subtype_Mark (N)));
3069    end Analyze_Unchecked_Type_Conversion;
3070
3071    ------------------------------------
3072    -- Analyze_User_Defined_Binary_Op --
3073    ------------------------------------
3074
3075    procedure Analyze_User_Defined_Binary_Op
3076      (N     : Node_Id;
3077       Op_Id : Entity_Id)
3078    is
3079    begin
3080       --  Only do analysis if the operator Comes_From_Source, since otherwise
3081       --  the operator was generated by the expander, and all such operators
3082       --  always refer to the operators in package Standard.
3083
3084       if Comes_From_Source (N) then
3085          declare
3086             F1 : constant Entity_Id := First_Formal (Op_Id);
3087             F2 : constant Entity_Id := Next_Formal (F1);
3088
3089          begin
3090             --  Verify that Op_Id is a visible binary function. Note that since
3091             --  we know Op_Id is overloaded, potentially use visible means use
3092             --  visible for sure (RM 9.4(11)).
3093
3094             if Ekind (Op_Id) = E_Function
3095               and then Present (F2)
3096               and then (Is_Immediately_Visible (Op_Id)
3097                          or else Is_Potentially_Use_Visible (Op_Id))
3098               and then Has_Compatible_Type (Left_Opnd (N), Etype (F1))
3099               and then Has_Compatible_Type (Right_Opnd (N), Etype (F2))
3100             then
3101                Add_One_Interp (N, Op_Id, Etype (Op_Id));
3102
3103                if Debug_Flag_E then
3104                   Write_Str ("user defined operator ");
3105                   Write_Name (Chars (Op_Id));
3106                   Write_Str (" on node ");
3107                   Write_Int (Int (N));
3108                   Write_Eol;
3109                end if;
3110             end if;
3111          end;
3112       end if;
3113    end Analyze_User_Defined_Binary_Op;
3114
3115    -----------------------------------
3116    -- Analyze_User_Defined_Unary_Op --
3117    -----------------------------------
3118
3119    procedure Analyze_User_Defined_Unary_Op
3120      (N     : Node_Id;
3121       Op_Id : Entity_Id)
3122    is
3123    begin
3124       --  Only do analysis if the operator Comes_From_Source, since otherwise
3125       --  the operator was generated by the expander, and all such operators
3126       --  always refer to the operators in package Standard.
3127
3128       if Comes_From_Source (N) then
3129          declare
3130             F : constant Entity_Id := First_Formal (Op_Id);
3131
3132          begin
3133             --  Verify that Op_Id is a visible unary function. Note that since
3134             --  we know Op_Id is overloaded, potentially use visible means use
3135             --  visible for sure (RM 9.4(11)).
3136
3137             if Ekind (Op_Id) = E_Function
3138               and then No (Next_Formal (F))
3139               and then (Is_Immediately_Visible (Op_Id)
3140                          or else Is_Potentially_Use_Visible (Op_Id))
3141               and then Has_Compatible_Type (Right_Opnd (N), Etype (F))
3142             then
3143                Add_One_Interp (N, Op_Id, Etype (Op_Id));
3144             end if;
3145          end;
3146       end if;
3147    end Analyze_User_Defined_Unary_Op;
3148
3149    ---------------------------
3150    -- Check_Arithmetic_Pair --
3151    ---------------------------
3152
3153    procedure Check_Arithmetic_Pair
3154      (T1, T2 : Entity_Id;
3155       Op_Id  : Entity_Id;
3156       N      : Node_Id)
3157    is
3158       Op_Name : constant Name_Id   := Chars (Op_Id);
3159
3160       function Specific_Type (T1, T2 : Entity_Id) return Entity_Id;
3161       --  Get specific type (i.e. non-universal type if there is one)
3162
3163       function Specific_Type (T1, T2 : Entity_Id) return Entity_Id is
3164       begin
3165          if T1 = Universal_Integer or else T1 = Universal_Real then
3166             return Base_Type (T2);
3167          else
3168             return Base_Type (T1);
3169          end if;
3170       end Specific_Type;
3171
3172    --  Start of processing for Check_Arithmetic_Pair
3173
3174    begin
3175       if Op_Name = Name_Op_Add or else Op_Name = Name_Op_Subtract then
3176
3177          if Is_Numeric_Type (T1)
3178            and then Is_Numeric_Type (T2)
3179            and then (Covers (T1, T2) or else Covers (T2, T1))
3180          then
3181             Add_One_Interp (N, Op_Id, Specific_Type (T1, T2));
3182          end if;
3183
3184       elsif Op_Name = Name_Op_Multiply or else Op_Name = Name_Op_Divide then
3185
3186          if Is_Fixed_Point_Type (T1)
3187            and then (Is_Fixed_Point_Type (T2)
3188                        or else T2 = Universal_Real)
3189          then
3190             --  If Treat_Fixed_As_Integer is set then the Etype is already set
3191             --  and no further processing is required (this is the case of an
3192             --  operator constructed by Exp_Fixd for a fixed point operation)
3193             --  Otherwise add one interpretation with universal fixed result
3194             --  If the operator is given in  functional notation, it comes
3195             --  from source and Fixed_As_Integer cannot apply.
3196
3197             if Nkind (N) not in N_Op
3198               or else not Treat_Fixed_As_Integer (N) then
3199                Add_One_Interp (N, Op_Id, Universal_Fixed);
3200             end if;
3201
3202          elsif Is_Fixed_Point_Type (T2)
3203            and then (Nkind (N) not in N_Op
3204                       or else not Treat_Fixed_As_Integer (N))
3205            and then T1 = Universal_Real
3206          then
3207             Add_One_Interp (N, Op_Id, Universal_Fixed);
3208
3209          elsif Is_Numeric_Type (T1)
3210            and then Is_Numeric_Type (T2)
3211            and then (Covers (T1, T2) or else Covers (T2, T1))
3212          then
3213             Add_One_Interp (N, Op_Id, Specific_Type (T1, T2));
3214
3215          elsif Is_Fixed_Point_Type (T1)
3216            and then (Base_Type (T2) = Base_Type (Standard_Integer)
3217                        or else T2 = Universal_Integer)
3218          then
3219             Add_One_Interp (N, Op_Id, T1);
3220
3221          elsif T2 = Universal_Real
3222            and then Base_Type (T1) = Base_Type (Standard_Integer)
3223            and then Op_Name = Name_Op_Multiply
3224          then
3225             Add_One_Interp (N, Op_Id, Any_Fixed);
3226
3227          elsif T1 = Universal_Real
3228            and then Base_Type (T2) = Base_Type (Standard_Integer)
3229          then
3230             Add_One_Interp (N, Op_Id, Any_Fixed);
3231
3232          elsif Is_Fixed_Point_Type (T2)
3233            and then (Base_Type (T1) = Base_Type (Standard_Integer)
3234                        or else T1 = Universal_Integer)
3235            and then Op_Name = Name_Op_Multiply
3236          then
3237             Add_One_Interp (N, Op_Id, T2);
3238
3239          elsif T1 = Universal_Real and then T2 = Universal_Integer then
3240             Add_One_Interp (N, Op_Id, T1);
3241
3242          elsif T2 = Universal_Real
3243            and then T1 = Universal_Integer
3244            and then Op_Name = Name_Op_Multiply
3245          then
3246             Add_One_Interp (N, Op_Id, T2);
3247          end if;
3248
3249       elsif Op_Name = Name_Op_Mod or else Op_Name = Name_Op_Rem then
3250
3251          --  Note: The fixed-point operands case with Treat_Fixed_As_Integer
3252          --  set does not require any special processing, since the Etype is
3253          --  already set (case of operation constructed by Exp_Fixed).
3254
3255          if Is_Integer_Type (T1)
3256            and then (Covers (T1, T2) or else Covers (T2, T1))
3257          then
3258             Add_One_Interp (N, Op_Id, Specific_Type (T1, T2));
3259          end if;
3260
3261       elsif Op_Name = Name_Op_Expon then
3262
3263          if Is_Numeric_Type (T1)
3264            and then not Is_Fixed_Point_Type (T1)
3265            and then (Base_Type (T2) = Base_Type (Standard_Integer)
3266                       or else T2 = Universal_Integer)
3267          then
3268             Add_One_Interp (N, Op_Id, Base_Type (T1));
3269          end if;
3270
3271       else pragma Assert (Nkind (N) in N_Op_Shift);
3272
3273          --  If not one of the predefined operators, the node may be one
3274          --  of the intrinsic functions. Its kind is always specific, and
3275          --  we can use it directly, rather than the name of the operation.
3276
3277          if Is_Integer_Type (T1)
3278            and then (Base_Type (T2) = Base_Type (Standard_Integer)
3279                       or else T2 = Universal_Integer)
3280          then
3281             Add_One_Interp (N, Op_Id, Base_Type (T1));
3282          end if;
3283       end if;
3284    end Check_Arithmetic_Pair;
3285
3286    -------------------------------
3287    -- Check_Misspelled_Selector --
3288    -------------------------------
3289
3290    procedure Check_Misspelled_Selector
3291      (Prefix : Entity_Id;
3292       Sel    : Node_Id)
3293    is
3294       Max_Suggestions   : constant := 2;
3295       Nr_Of_Suggestions : Natural := 0;
3296
3297       Suggestion_1 : Entity_Id := Empty;
3298       Suggestion_2 : Entity_Id := Empty;
3299
3300       Comp : Entity_Id;
3301
3302    begin
3303       --  All the components of the prefix of selector Sel are matched
3304       --  against  Sel and a count is maintained of possible misspellings.
3305       --  When at the end of the analysis there are one or two (not more!)
3306       --  possible misspellings, these misspellings will be suggested as
3307       --  possible correction.
3308
3309       if not (Is_Private_Type (Prefix) or Is_Record_Type (Prefix)) then
3310          --  Concurrent types should be handled as well ???
3311          return;
3312       end if;
3313
3314       Get_Name_String (Chars (Sel));
3315
3316       declare
3317          S  : constant String (1 .. Name_Len) :=
3318                 Name_Buffer (1 .. Name_Len);
3319
3320       begin
3321          Comp  := First_Entity (Prefix);
3322
3323          while Nr_Of_Suggestions <= Max_Suggestions
3324             and then Present (Comp)
3325          loop
3326
3327             if Is_Visible_Component (Comp) then
3328                Get_Name_String (Chars (Comp));
3329
3330                if Is_Bad_Spelling_Of (Name_Buffer (1 .. Name_Len), S) then
3331                   Nr_Of_Suggestions := Nr_Of_Suggestions + 1;
3332
3333                   case Nr_Of_Suggestions is
3334                      when 1      => Suggestion_1 := Comp;
3335                      when 2      => Suggestion_2 := Comp;
3336                      when others => exit;
3337                   end case;
3338                end if;
3339             end if;
3340
3341             Comp := Next_Entity (Comp);
3342          end loop;
3343
3344          --  Report at most two suggestions
3345
3346          if Nr_Of_Suggestions = 1 then
3347             Error_Msg_NE ("\possible misspelling of&", Sel, Suggestion_1);
3348
3349          elsif Nr_Of_Suggestions = 2 then
3350             Error_Msg_Node_2 := Suggestion_2;
3351             Error_Msg_NE ("\possible misspelling of& or&",
3352               Sel, Suggestion_1);
3353          end if;
3354       end;
3355    end Check_Misspelled_Selector;
3356
3357    ----------------------
3358    -- Defined_In_Scope --
3359    ----------------------
3360
3361    function Defined_In_Scope (T : Entity_Id; S : Entity_Id) return Boolean
3362    is
3363       S1 : constant Entity_Id := Scope (Base_Type (T));
3364
3365    begin
3366       return S1 = S
3367         or else (S1 = System_Aux_Id and then S = Scope (S1));
3368    end Defined_In_Scope;
3369
3370    -------------------
3371    -- Diagnose_Call --
3372    -------------------
3373
3374    procedure Diagnose_Call (N : Node_Id; Nam : Node_Id) is
3375       Actual  : Node_Id;
3376       X       : Interp_Index;
3377       It      : Interp;
3378       Success : Boolean;
3379
3380    begin
3381       if Extensions_Allowed then
3382          Actual := First_Actual (N);
3383
3384          while Present (Actual) loop
3385             if not Analyzed (Etype (Actual))
3386              and then From_With_Type (Etype (Actual))
3387             then
3388                Error_Msg_Qual_Level := 1;
3389                Error_Msg_NE
3390                 ("missing with_clause for scope of imported type&",
3391                   Actual, Etype (Actual));
3392                Error_Msg_Qual_Level := 0;
3393             end if;
3394
3395             Next_Actual (Actual);
3396          end loop;
3397       end if;
3398
3399       if All_Errors_Mode then
3400
3401          --   Analyze each candidate call again, with full error reporting
3402          --   for each.
3403
3404          Error_Msg_N ("\no candidate interpretations "
3405            & "match the actuals:!", Nam);
3406
3407          Get_First_Interp (Nam, X, It);
3408
3409          while Present (It.Nam) loop
3410             Analyze_One_Call (N, It.Nam, True, Success);
3411             Get_Next_Interp (X, It);
3412          end loop;
3413
3414       else
3415          if OpenVMS then
3416             Error_Msg_N
3417               ("invalid parameter list in call " &
3418                "('/'R'E'P'O'R'T'_'E'R'R'O'R'S'='F'U'L'L for details)!",
3419                 Nam);
3420          else
3421             Error_Msg_N
3422               ("invalid parameter list in call (use -gnatf for details)!",
3423                 Nam);
3424          end if;
3425       end if;
3426
3427       if Nkind (N) = N_Function_Call then
3428          Get_First_Interp (Nam, X, It);
3429
3430          while Present (It.Nam) loop
3431             if Ekind (It.Nam) = E_Function
3432               or else Ekind (It.Nam) = E_Operator
3433             then
3434                return;
3435             else
3436                Get_Next_Interp (X, It);
3437             end if;
3438          end loop;
3439
3440          --  If all interpretations are procedures, this deserves a
3441          --  more precise message. Ditto if this appears as the prefix
3442          --  of a selected component, which may be a lexical error.
3443
3444          Error_Msg_N (
3445          "\context requires function call, found procedure name", Nam);
3446
3447          if Nkind (Parent (N)) = N_Selected_Component
3448            and then N = Prefix (Parent (N))
3449          then
3450             Error_Msg_N (
3451               "\period should probably be semicolon", Parent (N));
3452          end if;
3453       end if;
3454    end Diagnose_Call;
3455
3456    ---------------------------
3457    -- Find_Arithmetic_Types --
3458    ---------------------------
3459
3460    procedure Find_Arithmetic_Types
3461      (L, R  : Node_Id;
3462       Op_Id : Entity_Id;
3463       N     : Node_Id)
3464    is
3465       Index1, Index2 : Interp_Index;
3466       It1, It2 : Interp;
3467
3468       procedure Check_Right_Argument (T : Entity_Id);
3469       --  Check right operand of operator
3470
3471       procedure Check_Right_Argument (T : Entity_Id) is
3472       begin
3473          if not Is_Overloaded (R) then
3474             Check_Arithmetic_Pair (T, Etype (R), Op_Id,  N);
3475          else
3476             Get_First_Interp (R, Index2, It2);
3477
3478             while Present (It2.Typ) loop
3479                Check_Arithmetic_Pair (T, It2.Typ, Op_Id, N);
3480                Get_Next_Interp (Index2, It2);
3481             end loop;
3482          end if;
3483       end Check_Right_Argument;
3484
3485    --  Start processing for Find_Arithmetic_Types
3486
3487    begin
3488       if not Is_Overloaded (L) then
3489          Check_Right_Argument (Etype (L));
3490
3491       else
3492          Get_First_Interp (L, Index1, It1);
3493
3494          while Present (It1.Typ) loop
3495             Check_Right_Argument (It1.Typ);
3496             Get_Next_Interp (Index1, It1);
3497          end loop;
3498       end if;
3499
3500    end Find_Arithmetic_Types;
3501
3502    ------------------------
3503    -- Find_Boolean_Types --
3504    ------------------------
3505
3506    procedure Find_Boolean_Types
3507      (L, R  : Node_Id;
3508       Op_Id : Entity_Id;
3509       N     : Node_Id)
3510    is
3511       Index : Interp_Index;
3512       It    : Interp;
3513
3514       procedure Check_Numeric_Argument (T : Entity_Id);
3515       --  Special case for logical operations one of whose operands is an
3516       --  integer literal. If both are literal the result is any modular type.
3517
3518       procedure Check_Numeric_Argument (T : Entity_Id) is
3519       begin
3520          if T = Universal_Integer then
3521             Add_One_Interp (N, Op_Id, Any_Modular);
3522
3523          elsif Is_Modular_Integer_Type (T) then
3524             Add_One_Interp (N, Op_Id, T);
3525          end if;
3526       end Check_Numeric_Argument;
3527
3528    --  Start of processing for Find_Boolean_Types
3529
3530    begin
3531       if not Is_Overloaded (L) then
3532
3533          if Etype (L) = Universal_Integer
3534            or else Etype (L) = Any_Modular
3535          then
3536             if not Is_Overloaded (R) then
3537                Check_Numeric_Argument (Etype (R));
3538
3539             else
3540                Get_First_Interp (R, Index, It);
3541
3542                while Present (It.Typ) loop
3543                   Check_Numeric_Argument (It.Typ);
3544
3545                   Get_Next_Interp (Index, It);
3546                end loop;
3547             end if;
3548
3549          elsif Valid_Boolean_Arg (Etype (L))
3550            and then Has_Compatible_Type (R, Etype (L))
3551          then
3552             Add_One_Interp (N, Op_Id, Etype (L));
3553          end if;
3554
3555       else
3556          Get_First_Interp (L, Index, It);
3557
3558          while Present (It.Typ) loop
3559             if Valid_Boolean_Arg (It.Typ)
3560               and then Has_Compatible_Type (R, It.Typ)
3561             then
3562                Add_One_Interp (N, Op_Id, It.Typ);
3563             end if;
3564
3565             Get_Next_Interp (Index, It);
3566          end loop;
3567       end if;
3568    end Find_Boolean_Types;
3569
3570    ---------------------------
3571    -- Find_Comparison_Types --
3572    ---------------------------
3573
3574    procedure Find_Comparison_Types
3575      (L, R  : Node_Id;
3576       Op_Id : Entity_Id;
3577       N     : Node_Id)
3578    is
3579       Index : Interp_Index;
3580       It    : Interp;
3581       Found : Boolean := False;
3582       I_F   : Interp_Index;
3583       T_F   : Entity_Id;
3584       Scop  : Entity_Id := Empty;
3585
3586       procedure Try_One_Interp (T1 : Entity_Id);
3587       --  Routine to try one proposed interpretation. Note that the context
3588       --  of the operator plays no role in resolving the arguments, so that
3589       --  if there is more than one interpretation of the operands that is
3590       --  compatible with comparison, the operation is ambiguous.
3591
3592       procedure Try_One_Interp (T1 : Entity_Id) is
3593       begin
3594
3595          --  If the operator is an expanded name, then the type of the operand
3596          --  must be defined in the corresponding scope. If the type is
3597          --  universal, the context will impose the correct type.
3598
3599          if Present (Scop)
3600             and then not Defined_In_Scope (T1, Scop)
3601             and then T1 /= Universal_Integer
3602             and then T1 /= Universal_Real
3603             and then T1 /= Any_String
3604             and then T1 /= Any_Composite
3605          then
3606             return;
3607          end if;
3608
3609          if Valid_Comparison_Arg (T1)
3610            and then Has_Compatible_Type (R, T1)
3611          then
3612             if Found
3613               and then Base_Type (T1) /= Base_Type (T_F)
3614             then
3615                It := Disambiguate (L, I_F, Index, Any_Type);
3616
3617                if It = No_Interp then
3618                   Ambiguous_Operands (N);
3619                   Set_Etype (L, Any_Type);
3620                   return;
3621
3622                else
3623                   T_F := It.Typ;
3624                end if;
3625
3626             else
3627                Found := True;
3628                T_F   := T1;
3629                I_F   := Index;
3630             end if;
3631
3632             Set_Etype (L, T_F);
3633             Find_Non_Universal_Interpretations (N, R, Op_Id, T1);
3634
3635          end if;
3636       end Try_One_Interp;
3637
3638    --  Start processing for Find_Comparison_Types
3639
3640    begin
3641
3642       if Nkind (N) = N_Function_Call
3643          and then Nkind (Name (N)) = N_Expanded_Name
3644       then
3645          Scop := Entity (Prefix (Name (N)));
3646
3647          --  The prefix may be a package renaming, and the subsequent test
3648          --  requires the original package.
3649
3650          if Ekind (Scop) = E_Package
3651            and then Present (Renamed_Entity (Scop))
3652          then
3653             Scop := Renamed_Entity (Scop);
3654             Set_Entity (Prefix (Name (N)), Scop);
3655          end if;
3656       end if;
3657
3658       if not Is_Overloaded (L) then
3659          Try_One_Interp (Etype (L));
3660
3661       else
3662          Get_First_Interp (L, Index, It);
3663
3664          while Present (It.Typ) loop
3665             Try_One_Interp (It.Typ);
3666             Get_Next_Interp (Index, It);
3667          end loop;
3668       end if;
3669    end Find_Comparison_Types;
3670
3671    ----------------------------------------
3672    -- Find_Non_Universal_Interpretations --
3673    ----------------------------------------
3674
3675    procedure Find_Non_Universal_Interpretations
3676      (N     : Node_Id;
3677       R     : Node_Id;
3678       Op_Id : Entity_Id;
3679       T1    : Entity_Id)
3680    is
3681       Index : Interp_Index;
3682       It   : Interp;
3683
3684    begin
3685       if T1 = Universal_Integer
3686         or else T1 = Universal_Real
3687       then
3688          if not Is_Overloaded (R) then
3689             Add_One_Interp
3690               (N, Op_Id, Standard_Boolean, Base_Type (Etype (R)));
3691          else
3692             Get_First_Interp (R, Index, It);
3693
3694             while Present (It.Typ) loop
3695                if Covers (It.Typ, T1) then
3696                   Add_One_Interp
3697                     (N, Op_Id, Standard_Boolean, Base_Type (It.Typ));
3698                end if;
3699
3700                Get_Next_Interp (Index, It);
3701             end loop;
3702          end if;
3703       else
3704          Add_One_Interp (N, Op_Id, Standard_Boolean, Base_Type (T1));
3705       end if;
3706    end Find_Non_Universal_Interpretations;
3707
3708    ------------------------------
3709    -- Find_Concatenation_Types --
3710    ------------------------------
3711
3712    procedure Find_Concatenation_Types
3713      (L, R  : Node_Id;
3714       Op_Id : Entity_Id;
3715       N     : Node_Id)
3716    is
3717       Op_Type : constant Entity_Id := Etype (Op_Id);
3718
3719    begin
3720       if Is_Array_Type (Op_Type)
3721         and then not Is_Limited_Type (Op_Type)
3722
3723         and then (Has_Compatible_Type (L, Op_Type)
3724                     or else
3725                   Has_Compatible_Type (L, Component_Type (Op_Type)))
3726
3727         and then (Has_Compatible_Type (R, Op_Type)
3728                     or else
3729                   Has_Compatible_Type (R, Component_Type (Op_Type)))
3730       then
3731          Add_One_Interp (N, Op_Id, Op_Type);
3732       end if;
3733    end Find_Concatenation_Types;
3734
3735    -------------------------
3736    -- Find_Equality_Types --
3737    -------------------------
3738
3739    procedure Find_Equality_Types
3740      (L, R  : Node_Id;
3741       Op_Id : Entity_Id;
3742       N     : Node_Id)
3743    is
3744       Index : Interp_Index;
3745       It    : Interp;
3746       Found : Boolean := False;
3747       I_F   : Interp_Index;
3748       T_F   : Entity_Id;
3749       Scop  : Entity_Id := Empty;
3750
3751       procedure Try_One_Interp (T1 : Entity_Id);
3752       --  The context of the operator plays no role in resolving the
3753       --  arguments,  so that if there is more than one interpretation
3754       --  of the operands that is compatible with equality, the construct
3755       --  is ambiguous and an error can be emitted now, after trying to
3756       --  disambiguate, i.e. applying preference rules.
3757
3758       procedure Try_One_Interp (T1 : Entity_Id) is
3759       begin
3760
3761          --  If the operator is an expanded name, then the type of the operand
3762          --  must be defined in the corresponding scope. If the type is
3763          --  universal, the context will impose the correct type. An anonymous
3764          --  type for a 'Access reference is also universal in this sense, as
3765          --  the actual type is obtained from context.
3766
3767          if Present (Scop)
3768             and then not Defined_In_Scope (T1, Scop)
3769             and then T1 /= Universal_Integer
3770             and then T1 /= Universal_Real
3771             and then T1 /= Any_Access
3772             and then T1 /= Any_String
3773             and then T1 /= Any_Composite
3774             and then (Ekind (T1) /= E_Access_Subprogram_Type
3775                         or else Comes_From_Source (T1))
3776          then
3777             return;
3778          end if;
3779
3780          if T1 /= Standard_Void_Type
3781            and then not Is_Limited_Type (T1)
3782            and then not Is_Limited_Composite (T1)
3783            and then Ekind (T1) /= E_Anonymous_Access_Type
3784            and then Has_Compatible_Type (R, T1)
3785          then
3786             if Found
3787               and then Base_Type (T1) /= Base_Type (T_F)
3788             then
3789                It := Disambiguate (L, I_F, Index, Any_Type);
3790
3791                if It = No_Interp then
3792                   Ambiguous_Operands (N);
3793                   Set_Etype (L, Any_Type);
3794                   return;
3795
3796                else
3797                   T_F := It.Typ;
3798                end if;
3799
3800             else
3801                Found := True;
3802                T_F   := T1;
3803                I_F   := Index;
3804             end if;
3805
3806             if not Analyzed (L) then
3807                Set_Etype (L, T_F);
3808             end if;
3809
3810             Find_Non_Universal_Interpretations (N, R, Op_Id, T1);
3811
3812             if Etype (N) = Any_Type then
3813
3814                --  Operator was not visible.
3815
3816                Found := False;
3817             end if;
3818          end if;
3819       end Try_One_Interp;
3820
3821    --  Start of processing for Find_Equality_Types
3822
3823    begin
3824
3825       if Nkind (N) = N_Function_Call
3826          and then Nkind (Name (N)) = N_Expanded_Name
3827       then
3828          Scop := Entity (Prefix (Name (N)));
3829
3830          --  The prefix may be a package renaming, and the subsequent test
3831          --  requires the original package.
3832
3833          if Ekind (Scop) = E_Package
3834            and then Present (Renamed_Entity (Scop))
3835          then
3836             Scop := Renamed_Entity (Scop);
3837             Set_Entity (Prefix (Name (N)), Scop);
3838          end if;
3839       end if;
3840
3841       if not Is_Overloaded (L) then
3842          Try_One_Interp (Etype (L));
3843       else
3844
3845          Get_First_Interp (L, Index, It);
3846
3847          while Present (It.Typ) loop
3848             Try_One_Interp (It.Typ);
3849             Get_Next_Interp (Index, It);
3850          end loop;
3851       end if;
3852    end Find_Equality_Types;
3853
3854    -------------------------
3855    -- Find_Negation_Types --
3856    -------------------------
3857
3858    procedure Find_Negation_Types
3859      (R     : Node_Id;
3860       Op_Id : Entity_Id;
3861       N     : Node_Id)
3862    is
3863       Index : Interp_Index;
3864       It    : Interp;
3865
3866    begin
3867       if not Is_Overloaded (R) then
3868
3869          if Etype (R) = Universal_Integer then
3870             Add_One_Interp (N, Op_Id, Any_Modular);
3871
3872          elsif Valid_Boolean_Arg (Etype (R)) then
3873             Add_One_Interp (N, Op_Id, Etype (R));
3874          end if;
3875
3876       else
3877          Get_First_Interp (R, Index, It);
3878
3879          while Present (It.Typ) loop
3880             if Valid_Boolean_Arg (It.Typ) then
3881                Add_One_Interp (N, Op_Id, It.Typ);
3882             end if;
3883
3884             Get_Next_Interp (Index, It);
3885          end loop;
3886       end if;
3887    end Find_Negation_Types;
3888
3889    ----------------------
3890    -- Find_Unary_Types --
3891    ----------------------
3892
3893    procedure Find_Unary_Types
3894      (R     : Node_Id;
3895       Op_Id : Entity_Id;
3896       N     : Node_Id)
3897    is
3898       Index : Interp_Index;
3899       It    : Interp;
3900
3901    begin
3902       if not Is_Overloaded (R) then
3903          if Is_Numeric_Type (Etype (R)) then
3904             Add_One_Interp (N, Op_Id, Base_Type (Etype (R)));
3905          end if;
3906
3907       else
3908          Get_First_Interp (R, Index, It);
3909
3910          while Present (It.Typ) loop
3911             if Is_Numeric_Type (It.Typ) then
3912                Add_One_Interp (N, Op_Id, Base_Type (It.Typ));
3913             end if;
3914
3915             Get_Next_Interp (Index, It);
3916          end loop;
3917       end if;
3918    end Find_Unary_Types;
3919
3920    ---------------------------------
3921    -- Insert_Explicit_Dereference --
3922    ---------------------------------
3923
3924    procedure Insert_Explicit_Dereference (N : Node_Id) is
3925       New_Prefix : Node_Id := Relocate_Node (N);
3926       I          : Interp_Index;
3927       It         : Interp;
3928       T          : Entity_Id;
3929
3930    begin
3931       Save_Interps (N, New_Prefix);
3932       Rewrite (N,
3933         Make_Explicit_Dereference (Sloc (N), Prefix => New_Prefix));
3934
3935       Set_Etype (N, Designated_Type (Etype (New_Prefix)));
3936
3937       if Is_Overloaded (New_Prefix) then
3938
3939          --  The deference is also overloaded, and its interpretations are the
3940          --  designated types of the interpretations of the original node.
3941
3942          Set_Is_Overloaded (N);
3943          Get_First_Interp (New_Prefix, I, It);
3944
3945          while Present (It.Nam) loop
3946             T := It.Typ;
3947
3948             if Is_Access_Type (T) then
3949                Add_One_Interp (N, Designated_Type (T), Designated_Type (T));
3950             end if;
3951
3952             Get_Next_Interp (I, It);
3953          end loop;
3954
3955          End_Interp_List;
3956       end if;
3957
3958    end Insert_Explicit_Dereference;
3959
3960    ------------------
3961    -- Junk_Operand --
3962    ------------------
3963
3964    function Junk_Operand (N : Node_Id) return Boolean is
3965       Enode : Node_Id;
3966
3967    begin
3968       if Error_Posted (N) then
3969          return False;
3970       end if;
3971
3972       --  Get entity to be tested
3973
3974       if Is_Entity_Name (N)
3975         and then Present (Entity (N))
3976       then
3977          Enode := N;
3978
3979       --  An odd case, a procedure name gets converted to a very peculiar
3980       --  function call, and here is where we detect this happening.
3981
3982       elsif Nkind (N) = N_Function_Call
3983         and then Is_Entity_Name (Name (N))
3984         and then Present (Entity (Name (N)))
3985       then
3986          Enode := Name (N);
3987
3988       --  Another odd case, there are at least some cases of selected
3989       --  components where the selected component is not marked as having
3990       --  an entity, even though the selector does have an entity
3991
3992       elsif Nkind (N) = N_Selected_Component
3993         and then Present (Entity (Selector_Name (N)))
3994       then
3995          Enode := Selector_Name (N);
3996
3997       else
3998          return False;
3999       end if;
4000
4001       --  Now test the entity we got to see if it a bad case
4002
4003       case Ekind (Entity (Enode)) is
4004
4005          when E_Package =>
4006             Error_Msg_N
4007               ("package name cannot be used as operand", Enode);
4008
4009          when Generic_Unit_Kind =>
4010             Error_Msg_N
4011               ("generic unit name cannot be used as operand", Enode);
4012
4013          when Type_Kind =>
4014             Error_Msg_N
4015               ("subtype name cannot be used as operand", Enode);
4016
4017          when Entry_Kind =>
4018             Error_Msg_N
4019               ("entry name cannot be used as operand", Enode);
4020
4021          when E_Procedure =>
4022             Error_Msg_N
4023               ("procedure name cannot be used as operand", Enode);
4024
4025          when E_Exception =>
4026             Error_Msg_N
4027               ("exception name cannot be used as operand", Enode);
4028
4029          when E_Block | E_Label | E_Loop =>
4030             Error_Msg_N
4031               ("label name cannot be used as operand", Enode);
4032
4033          when others =>
4034             return False;
4035
4036       end case;
4037
4038       return True;
4039    end Junk_Operand;
4040
4041    --------------------
4042    -- Operator_Check --
4043    --------------------
4044
4045    procedure Operator_Check (N : Node_Id) is
4046    begin
4047       --  Test for case of no interpretation found for operator
4048
4049       if Etype (N) = Any_Type then
4050          declare
4051             L : Node_Id;
4052             R : Node_Id;
4053
4054          begin
4055             R := Right_Opnd (N);
4056
4057             if Nkind (N) in N_Binary_Op then
4058                L := Left_Opnd (N);
4059             else
4060                L := Empty;
4061             end if;
4062
4063             --  If either operand has no type, then don't complain further,
4064             --  since this simply means that we have a propragated error.
4065
4066             if R = Error
4067               or else Etype (R) = Any_Type
4068               or else (Nkind (N) in N_Binary_Op and then Etype (L) = Any_Type)
4069             then
4070                return;
4071
4072             --  We explicitly check for the case of concatenation of
4073             --  component with component to avoid reporting spurious
4074             --  matching array types that might happen to be lurking
4075             --  in distant packages (such as run-time packages). This
4076             --  also prevents inconsistencies in the messages for certain
4077             --  ACVC B tests, which can vary depending on types declared
4078             --  in run-time interfaces. A further improvement, when
4079             --  aggregates are present, is to look for a well-typed operand.
4080
4081             elsif Present (Candidate_Type)
4082               and then (Nkind (N) /= N_Op_Concat
4083                          or else Is_Array_Type (Etype (L))
4084                          or else Is_Array_Type (Etype (R)))
4085             then
4086
4087                if Nkind (N) = N_Op_Concat then
4088                   if Etype (L) /= Any_Composite
4089                     and then Is_Array_Type (Etype (L))
4090                   then
4091                      Candidate_Type := Etype (L);
4092
4093                   elsif Etype (R) /= Any_Composite
4094                     and then Is_Array_Type (Etype (R))
4095                   then
4096                      Candidate_Type := Etype (R);
4097                   end if;
4098                end if;
4099
4100                Error_Msg_NE
4101                  ("operator for} is not directly visible!",
4102                   N, First_Subtype (Candidate_Type));
4103                Error_Msg_N ("use clause would make operation legal!",  N);
4104                return;
4105
4106             --  If either operand is a junk operand (e.g. package name), then
4107             --  post appropriate error messages, but do not complain further.
4108
4109             --  Note that the use of OR in this test instead of OR ELSE
4110             --  is quite deliberate, we may as well check both operands
4111             --  in the binary operator case.
4112
4113             elsif Junk_Operand (R)
4114               or (Nkind (N) in N_Binary_Op and then Junk_Operand (L))
4115             then
4116                return;
4117
4118             --  If we have a logical operator, one of whose operands is
4119             --  Boolean, then we know that the other operand cannot resolve
4120             --  to Boolean (since we got no interpretations), but in that
4121             --  case we pretty much know that the other operand should be
4122             --  Boolean, so resolve it that way (generating an error)
4123
4124             elsif Nkind (N) = N_Op_And
4125                     or else
4126                   Nkind (N) = N_Op_Or
4127                     or else
4128                   Nkind (N) = N_Op_Xor
4129             then
4130                if Etype (L) = Standard_Boolean then
4131                   Resolve (R, Standard_Boolean);
4132                   return;
4133                elsif Etype (R) = Standard_Boolean then
4134                   Resolve (L, Standard_Boolean);
4135                   return;
4136                end if;
4137
4138             --  For an arithmetic operator or comparison operator, if one
4139             --  of the operands is numeric, then we know the other operand
4140             --  is not the same numeric type. If it is a non-numeric type,
4141             --  then probably it is intended to match the other operand.
4142
4143             elsif Nkind (N) = N_Op_Add      or else
4144                   Nkind (N) = N_Op_Divide   or else
4145                   Nkind (N) = N_Op_Ge       or else
4146                   Nkind (N) = N_Op_Gt       or else
4147                   Nkind (N) = N_Op_Le       or else
4148                   Nkind (N) = N_Op_Lt       or else
4149                   Nkind (N) = N_Op_Mod      or else
4150                   Nkind (N) = N_Op_Multiply or else
4151                   Nkind (N) = N_Op_Rem      or else
4152                   Nkind (N) = N_Op_Subtract
4153             then
4154                if Is_Numeric_Type (Etype (L))
4155                  and then not Is_Numeric_Type (Etype (R))
4156                then
4157                   Resolve (R, Etype (L));
4158                   return;
4159
4160                elsif Is_Numeric_Type (Etype (R))
4161                  and then not Is_Numeric_Type (Etype (L))
4162                then
4163                   Resolve (L, Etype (R));
4164                   return;
4165                end if;
4166
4167             --  Comparisons on A'Access are common enough to deserve a
4168             --  special message.
4169
4170             elsif (Nkind (N) = N_Op_Eq  or else
4171                    Nkind (N) = N_Op_Ne)
4172                and then Ekind (Etype (L)) = E_Access_Attribute_Type
4173                and then Ekind (Etype (R)) = E_Access_Attribute_Type
4174             then
4175                Error_Msg_N
4176                  ("two access attributes cannot be compared directly", N);
4177                Error_Msg_N
4178                  ("\they must be converted to an explicit type for comparison",
4179                    N);
4180                return;
4181
4182             --  Another one for C programmers
4183
4184             elsif Nkind (N) = N_Op_Concat
4185               and then Valid_Boolean_Arg (Etype (L))
4186               and then Valid_Boolean_Arg (Etype (R))
4187             then
4188                Error_Msg_N ("invalid operands for concatenation", N);
4189                Error_Msg_N ("\maybe AND was meant", N);
4190                return;
4191
4192             --  A special case for comparison of access parameter with null
4193
4194             elsif Nkind (N) = N_Op_Eq
4195               and then Is_Entity_Name (L)
4196               and then Nkind (Parent (Entity (L))) = N_Parameter_Specification
4197               and then Nkind (Parameter_Type (Parent (Entity (L)))) =
4198                                                   N_Access_Definition
4199               and then Nkind (R) = N_Null
4200             then
4201                Error_Msg_N ("access parameter is not allowed to be null", L);
4202                Error_Msg_N ("\(call would raise Constraint_Error)", L);
4203                return;
4204             end if;
4205
4206             --  If we fall through then just give general message. Note
4207             --  that in the following messages, if the operand is overloaded
4208             --  we choose an arbitrary type to complain about, but that is
4209             --  probably more useful than not giving a type at all.
4210
4211             if Nkind (N) in N_Unary_Op then
4212                Error_Msg_Node_2 := Etype (R);
4213                Error_Msg_N ("operator& not defined for}", N);
4214                return;
4215
4216             else
4217                Error_Msg_N ("invalid operand types for operator&", N);
4218
4219                if Nkind (N) in N_Binary_Op
4220                  and then Nkind (N) /= N_Op_Concat
4221                then
4222                   Error_Msg_NE ("\left operand has}!",  N, Etype (L));
4223                   Error_Msg_NE ("\right operand has}!", N, Etype (R));
4224                end if;
4225             end if;
4226          end;
4227       end if;
4228    end Operator_Check;
4229
4230    -----------------------
4231    -- Try_Indirect_Call --
4232    -----------------------
4233
4234    function Try_Indirect_Call
4235      (N      : Node_Id;
4236       Nam    : Entity_Id;
4237       Typ    : Entity_Id)
4238       return   Boolean
4239    is
4240       Actuals    : List_Id   := Parameter_Associations (N);
4241       Actual     : Node_Id   := First (Actuals);
4242       Formal     : Entity_Id := First_Formal (Designated_Type (Typ));
4243
4244    begin
4245       while Present (Actual)
4246         and then Present (Formal)
4247       loop
4248          if not Has_Compatible_Type (Actual, Etype (Formal)) then
4249             return False;
4250          end if;
4251
4252          Next (Actual);
4253          Next_Formal (Formal);
4254       end loop;
4255
4256       if No (Actual) and then No (Formal) then
4257          Add_One_Interp (N, Nam, Etype (Designated_Type (Typ)));
4258
4259          --  Nam is a candidate interpretation for the name in the call,
4260          --  if it is not an indirect call.
4261
4262          if not Is_Type (Nam)
4263             and then Is_Entity_Name (Name (N))
4264          then
4265             Set_Entity (Name (N), Nam);
4266          end if;
4267
4268          return True;
4269       else
4270          return False;
4271       end if;
4272    end Try_Indirect_Call;
4273
4274    ----------------------
4275    -- Try_Indexed_Call --
4276    ----------------------
4277
4278    function Try_Indexed_Call
4279      (N      : Node_Id;
4280       Nam    : Entity_Id;
4281       Typ    : Entity_Id)
4282       return   Boolean
4283    is
4284       Actuals    : List_Id   := Parameter_Associations (N);
4285       Actual     : Node_Id   := First (Actuals);
4286       Index      : Entity_Id := First_Index (Typ);
4287
4288    begin
4289       while Present (Actual)
4290         and then Present (Index)
4291       loop
4292          --  If the parameter list has a named association, the expression
4293          --  is definitely a call and not an indexed component.
4294
4295          if Nkind (Actual) = N_Parameter_Association then
4296             return False;
4297          end if;
4298
4299          if not Has_Compatible_Type (Actual, Etype (Index)) then
4300             return False;
4301          end if;
4302
4303          Next (Actual);
4304          Next_Index (Index);
4305       end loop;
4306
4307       if No (Actual) and then No (Index) then
4308          Add_One_Interp (N, Nam, Component_Type (Typ));
4309
4310          --  Nam is a candidate interpretation for the name in the call,
4311          --  if it is not an indirect call.
4312
4313          if not Is_Type (Nam)
4314             and then Is_Entity_Name (Name (N))
4315          then
4316             Set_Entity (Name (N), Nam);
4317          end if;
4318
4319          return True;
4320       else
4321          return False;
4322       end if;
4323
4324    end Try_Indexed_Call;
4325
4326 end Sem_Ch4;