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