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