gcc/ada/sem_ch4.adb

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