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-2006, 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,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, 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 Elists;   use Elists;
  31 with Errout;   use Errout;
  32 with Exp_Util; use Exp_Util;
  33 with Fname;    use Fname;
  34 with Itypes;   use Itypes;
  35 with Lib;      use Lib;
  36 with Lib.Xref; use Lib.Xref;
  37 with Namet;    use Namet;
  38 with Nlists;   use Nlists;
  39 with Nmake;    use Nmake;
  40 with Opt;      use Opt;
  41 with Output;   use Output;
  42 with Restrict; use Restrict;
  43 with Rident;   use Rident;
  44 with Sem;      use Sem;
  45 with Sem_Cat;  use Sem_Cat;
  46 with Sem_Ch3;  use Sem_Ch3;
  47 with Sem_Ch8;  use Sem_Ch8;
  48 with Sem_Disp; use Sem_Disp;
  49 with Sem_Dist; use Sem_Dist;
  50 with Sem_Eval; use Sem_Eval;
  51 with Sem_Res;  use Sem_Res;
  52 with Sem_Util; use Sem_Util;
  53 with Sem_Type; use Sem_Type;
  54 with Stand;    use Stand;
  55 with Sinfo;    use Sinfo;
  56 with Snames;   use Snames;
  57 with Tbuild;   use Tbuild;
  58
  59 with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
  60
  61 package body Sem_Ch4 is
  62
  63    -----------------------
  64    -- Local Subprograms --
  65    -----------------------
  66
  67    procedure Analyze_Expression (N : Node_Id);
  68    --  For expressions that are not names, this is just a call to analyze.
  69    --  If the expression is a name, it may be a call to a parameterless
  70    --  function, and if so must be converted into an explicit call node
  71    --  and analyzed as such. This deproceduring must be done during the first
  72    --  pass of overload resolution, because otherwise a procedure call with
  73    --  overloaded actuals may fail to resolve. See 4327-001 for an example.
  74
  75    procedure Analyze_Operator_Call (N : Node_Id; Op_Id : Entity_Id);
  76    --  Analyze a call of the form "+"(x, y), etc. The prefix of the call
  77    --  is an operator name or an expanded name whose selector is an operator
  78    --  name, and one possible interpretation is as a predefined operator.
  79
  80    procedure Analyze_Overloaded_Selected_Component (N : Node_Id);
  81    --  If the prefix of a selected_component is overloaded, the proper
  82    --  interpretation that yields a record type with the proper selector
  83    --  name must be selected.
  84
  85    procedure Analyze_User_Defined_Binary_Op (N : Node_Id; Op_Id : Entity_Id);
  86    --  Procedure to analyze a user defined binary operator, which is resolved
  87    --  like a function, but instead of a list of actuals it is presented
  88    --  with the left and right operands of an operator node.
  89
  90    procedure Analyze_User_Defined_Unary_Op (N : Node_Id; Op_Id : Entity_Id);
  91    --  Procedure to analyze a user defined unary operator, which is resolved
  92    --  like a function, but instead of a list of actuals, it is presented with
  93    --  the operand of the operator node.
  94
  95    procedure Ambiguous_Operands (N : Node_Id);
  96    --  for equality, membership, and comparison operators with overloaded
  97    --  arguments, list possible interpretations.
  98
  99    procedure Analyze_One_Call
 100       (N          : Node_Id;
 101        Nam        : Entity_Id;
 102        Report     : Boolean;
 103        Success    : out Boolean;
 104        Skip_First : Boolean := False);
 105    --  Check one interpretation of an overloaded subprogram name for
 106    --  compatibility with the types of the actuals in a call. If there is a
 107    --  single interpretation which does not match, post error if Report is
 108    --  set to True.
 109    --
 110    --  Nam is the entity that provides the formals against which the actuals
 111    --  are checked. Nam is either the name of a subprogram, or the internal
 112    --  subprogram type constructed for an access_to_subprogram. If the actuals
 113    --  are compatible with Nam, then Nam is added to the list of candidate
 114    --  interpretations for N, and Success is set to True.
 115    --
 116    --  The flag Skip_First is used when analyzing a call that was rewritten
 117    --  from object notation. In this case the first actual may have to receive
 118    --  an explicit dereference, depending on the first formal of the operation
 119    --  being called. The caller will have verified that the object is legal
 120    --  for the call. If the remaining parameters match, the first parameter
 121    --  will rewritten as a dereference if needed, prior to completing analysis.
 122
 123    procedure Check_Misspelled_Selector
 124      (Prefix : Entity_Id;
 125       Sel    : Node_Id);
 126    --  Give possible misspelling diagnostic if Sel is likely to be
 127    --  a misspelling of one of the selectors of the Prefix.
 128    --  This is called by Analyze_Selected_Component after producing
 129    --  an invalid selector error message.
 130
 131    function Defined_In_Scope (T : Entity_Id; S : Entity_Id) return Boolean;
 132    --  Verify that type T is declared in scope S. Used to find intepretations
 133    --  for operators given by expanded names. This is abstracted as a separate
 134    --  function to handle extensions to System, where S is System, but T is
 135    --  declared in the extension.
 136
 137    procedure Find_Arithmetic_Types
 138      (L, R  : Node_Id;
 139       Op_Id : Entity_Id;
 140       N     : Node_Id);
 141    --  L and R are the operands of an arithmetic operator. Find
 142    --  consistent pairs of interpretations for L and R that have a
 143    --  numeric type consistent with the semantics of the operator.
 144
 145    procedure Find_Comparison_Types
 146      (L, R  : Node_Id;
 147       Op_Id : Entity_Id;
 148       N     : Node_Id);
 149    --  L and R are operands of a comparison operator. Find consistent
 150    --  pairs of interpretations for L and R.
 151
 152    procedure Find_Concatenation_Types
 153      (L, R  : Node_Id;
 154       Op_Id : Entity_Id;
 155       N     : Node_Id);
 156    --  For the four varieties of concatenation
 157
 158    procedure Find_Equality_Types
 159      (L, R  : Node_Id;
 160       Op_Id : Entity_Id;
 161       N     : Node_Id);
 162    --  Ditto for equality operators
 163
 164    procedure Find_Boolean_Types
 165      (L, R  : Node_Id;
 166       Op_Id : Entity_Id;
 167       N     : Node_Id);
 168    --  Ditto for binary logical operations
 169
 170    procedure Find_Negation_Types
 171      (R     : Node_Id;
 172       Op_Id : Entity_Id;
 173       N     : Node_Id);
 174    --  Find consistent interpretation for operand of negation operator
 175
 176    procedure Find_Non_Universal_Interpretations
 177      (N     : Node_Id;
 178       R     : Node_Id;
 179       Op_Id : Entity_Id;
 180       T1    : Entity_Id);
 181    --  For equality and comparison operators, the result is always boolean,
 182    --  and the legality of the operation is determined from the visibility
 183    --  of the operand types. If one of the operands has a universal interpre-
 184    --  tation,  the legality check uses some compatible non-universal
 185    --  interpretation of the other operand. N can be an operator node, or
 186    --  a function call whose name is an operator designator.
 187
 188    procedure Find_Unary_Types
 189      (R     : Node_Id;
 190       Op_Id : Entity_Id;
 191       N     : Node_Id);
 192    --  Unary arithmetic types: plus, minus, abs
 193
 194    procedure Check_Arithmetic_Pair
 195      (T1, T2 : Entity_Id;
 196       Op_Id  : Entity_Id;
 197       N      : Node_Id);
 198    --  Subsidiary procedure to Find_Arithmetic_Types. T1 and T2 are valid
 199    --  types for left and right operand. Determine whether they constitute
 200    --  a valid pair for the given operator, and record the corresponding
 201    --  interpretation of the operator node. The node N may be an operator
 202    --  node (the usual case) or a function call whose prefix is an operator
 203    --  designator. In  both cases Op_Id is the operator name itself.
 204
 205    procedure Diagnose_Call (N : Node_Id; Nam : Node_Id);
 206    --  Give detailed information on overloaded call where none of the
 207    --  interpretations match. N is the call node, Nam the designator for
 208    --  the overloaded entity being called.
 209
 210    function Junk_Operand (N : Node_Id) return Boolean;
 211    --  Test for an operand that is an inappropriate entity (e.g. a package
 212    --  name or a label). If so, issue an error message and return True. If
 213    --  the operand is not an inappropriate entity kind, return False.
 214
 215    procedure Operator_Check (N : Node_Id);
 216    --  Verify that an operator has received some valid interpretation. If none
 217    --  was found, determine whether a use clause would make the operation
 218    --  legal. The variable Candidate_Type (defined in Sem_Type) is set for
 219    --  every type compatible with the operator, even if the operator for the
 220    --  type is not directly visible. The routine uses this type to emit a more
 221    --  informative message.
 222
 223    procedure Process_Implicit_Dereference_Prefix
 224      (E : Entity_Id;
 225       P : Node_Id);
 226    --  Called when P is the prefix of an implicit dereference, denoting an
 227    --  object E. If in semantics only mode (-gnatc or generic), record that is
 228    --  a reference to E. Normally, such a reference is generated only when the
 229    --  implicit dereference is expanded into an explicit one. E may be empty,
 230    --  in which case this procedure does nothing.
 231
 232    procedure Remove_Abstract_Operations (N : Node_Id);
 233    --  Ada 2005: implementation of AI-310. An abstract non-dispatching
 234    --  operation is not a candidate interpretation.
 235
 236    function Try_Indexed_Call
 237      (N   : Node_Id;
 238       Nam : Entity_Id;
 239       Typ : Entity_Id) return Boolean;
 240    --  If a function has defaults for all its actuals, a call to it may
 241    --  in fact be an indexing on the result of the call. Try_Indexed_Call
 242    --  attempts the interpretation as an indexing, prior to analysis as
 243    --  a call. If both are possible,  the node is overloaded with both
 244    --  interpretations (same symbol but two different types).
 245
 246    function Try_Indirect_Call
 247      (N   : Node_Id;
 248       Nam : Entity_Id;
 249       Typ : Entity_Id) return Boolean;
 250    --  Similarly, a function F that needs no actuals can return an access
 251    --  to a subprogram, and the call F (X)  interpreted as F.all (X). In
 252    --  this case the call may be overloaded with both interpretations.
 253
 254    function Try_Object_Operation (N : Node_Id) return Boolean;
 255    --  Ada 2005 (AI-252): Give support to the object operation notation
 256
 257    ------------------------
 258    -- Ambiguous_Operands --
 259    ------------------------
 260
 261    procedure Ambiguous_Operands (N : Node_Id) is
 262       procedure List_Operand_Interps (Opnd : Node_Id);
 263
 264       --------------------------
 265       -- List_Operand_Interps --
 266       --------------------------
 267
 268       procedure List_Operand_Interps (Opnd : Node_Id) is
 269          Nam   : Node_Id;
 270          Err   : Node_Id := N;
 271
 272       begin
 273          if Is_Overloaded (Opnd) then
 274             if Nkind (Opnd) in N_Op then
 275                Nam := Opnd;
 276             elsif Nkind (Opnd) = N_Function_Call then
 277                Nam := Name (Opnd);
 278             else
 279                return;
 280             end if;
 281
 282          else
 283             return;
 284          end if;
 285
 286          if Opnd = Left_Opnd (N) then
 287             Error_Msg_N
 288               ("\left operand has the following interpretations", N);
 289          else
 290             Error_Msg_N
 291               ("\right operand has the following interpretations", N);
 292             Err := Opnd;
 293          end if;
 294
 295          List_Interps (Nam, Err);
 296       end List_Operand_Interps;
 297
 298    --  Start of processing for Ambiguous_Operands
 299
 300    begin
 301       if Nkind (N) in N_Membership_Test then
 302          Error_Msg_N ("ambiguous operands for membership",  N);
 303
 304       elsif Nkind (N) = N_Op_Eq
 305         or else Nkind (N) = N_Op_Ne
 306       then
 307          Error_Msg_N ("ambiguous operands for equality",  N);
 308
 309       else
 310          Error_Msg_N ("ambiguous operands for comparison",  N);
 311       end if;
 312
 313       if All_Errors_Mode then
 314          List_Operand_Interps (Left_Opnd  (N));
 315          List_Operand_Interps (Right_Opnd (N));
 316       else
 317          Error_Msg_N ("\use -gnatf switch for details", N);
 318       end if;
 319    end Ambiguous_Operands;
 320
 321    -----------------------
 322    -- Analyze_Aggregate --
 323    -----------------------
 324
 325    --  Most of the analysis of Aggregates requires that the type be known,
 326    --  and is therefore put off until resolution.
 327
 328    procedure Analyze_Aggregate (N : Node_Id) is
 329    begin
 330       if No (Etype (N)) then
 331          Set_Etype (N, Any_Composite);
 332       end if;
 333    end Analyze_Aggregate;
 334
 335    -----------------------
 336    -- Analyze_Allocator --
 337    -----------------------
 338
 339    procedure Analyze_Allocator (N : Node_Id) is
 340       Loc      : constant Source_Ptr := Sloc (N);
 341       Sav_Errs : constant Nat        := Serious_Errors_Detected;
 342       E        : Node_Id             := Expression (N);
 343       Acc_Type : Entity_Id;
 344       Type_Id  : Entity_Id;
 345
 346    begin
 347       Check_Restriction (No_Allocators, N);
 348
 349       if Nkind (E) = N_Qualified_Expression then
 350          Acc_Type := Create_Itype (E_Allocator_Type, N);
 351          Set_Etype (Acc_Type, Acc_Type);
 352          Init_Size_Align (Acc_Type);
 353          Find_Type (Subtype_Mark (E));
 354          Type_Id := Entity (Subtype_Mark (E));
 355          Check_Fully_Declared (Type_Id, N);
 356          Set_Directly_Designated_Type (Acc_Type, Type_Id);
 357
 358          Analyze_And_Resolve (Expression (E), Type_Id);
 359
 360          if Is_Limited_Type (Type_Id)
 361            and then Comes_From_Source (N)
 362            and then not In_Instance_Body
 363          then
 364             if not OK_For_Limited_Init (Expression (E)) then
 365                Error_Msg_N ("initialization not allowed for limited types", N);
 366                Explain_Limited_Type (Type_Id, N);
 367             end if;
 368          end if;
 369
 370          --  A qualified expression requires an exact match of the type,
 371          --  class-wide matching is not allowed.
 372
 373          if Is_Class_Wide_Type (Type_Id)
 374            and then Base_Type (Etype (Expression (E))) /= Base_Type (Type_Id)
 375          then
 376             Wrong_Type (Expression (E), Type_Id);
 377          end if;
 378
 379          Check_Non_Static_Context (Expression (E));
 380
 381          --  We don't analyze the qualified expression itself because it's
 382          --  part of the allocator
 383
 384          Set_Etype  (E, Type_Id);
 385
 386       --  Case where no qualified expression is present
 387
 388       else
 389          declare
 390             Def_Id   : Entity_Id;
 391             Base_Typ : Entity_Id;
 392
 393          begin
 394             --  If the allocator includes a N_Subtype_Indication then a
 395             --  constraint is present, otherwise the node is a subtype mark.
 396             --  Introduce an explicit subtype declaration into the tree
 397             --  defining some anonymous subtype and rewrite the allocator to
 398             --  use this subtype rather than the subtype indication.
 399
 400             --  It is important to introduce the explicit subtype declaration
 401             --  so that the bounds of the subtype indication are attached to
 402             --  the tree in case the allocator is inside a generic unit.
 403
 404             if Nkind (E) = N_Subtype_Indication then
 405
 406                --  A constraint is only allowed for a composite type in Ada
 407                --  95. In Ada 83, a constraint is also allowed for an
 408                --  access-to-composite type, but the constraint is ignored.
 409
 410                Find_Type (Subtype_Mark (E));
 411                Base_Typ := Entity (Subtype_Mark (E));
 412
 413                if Is_Elementary_Type (Base_Typ) then
 414                   if not (Ada_Version = Ada_83
 415                            and then Is_Access_Type (Base_Typ))
 416                   then
 417                      Error_Msg_N ("constraint not allowed here", E);
 418
 419                      if Nkind (Constraint (E))
 420                        = N_Index_Or_Discriminant_Constraint
 421                      then
 422                         Error_Msg_N
 423                           ("\if qualified expression was meant, " &
 424                               "use apostrophe", Constraint (E));
 425                      end if;
 426                   end if;
 427
 428                   --  Get rid of the bogus constraint:
 429
 430                   Rewrite (E, New_Copy_Tree (Subtype_Mark (E)));
 431                   Analyze_Allocator (N);
 432                   return;
 433
 434                --  Ada 2005, AI-363: if the designated type has a constrained
 435                --  partial view, it cannot receive a discriminant constraint,
 436                --  and the allocated object is unconstrained.
 437
 438                elsif Ada_Version >= Ada_05
 439                  and then Has_Constrained_Partial_View (Base_Typ)
 440                then
 441                   Error_Msg_N
 442                     ("constraint no allowed when type " &
 443                       "has a constrained partial view", Constraint (E));
 444                end if;
 445
 446                if Expander_Active then
 447                   Def_Id :=
 448                     Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
 449
 450                   Insert_Action (E,
 451                     Make_Subtype_Declaration (Loc,
 452                       Defining_Identifier => Def_Id,
 453                       Subtype_Indication  => Relocate_Node (E)));
 454
 455                   if Sav_Errs /= Serious_Errors_Detected
 456                     and then Nkind (Constraint (E))
 457                       = N_Index_Or_Discriminant_Constraint
 458                   then
 459                      Error_Msg_N
 460                        ("if qualified expression was meant, " &
 461                            "use apostrophe!", Constraint (E));
 462                   end if;
 463
 464                   E := New_Occurrence_Of (Def_Id, Loc);
 465                   Rewrite (Expression (N), E);
 466                end if;
 467             end if;
 468
 469             Type_Id := Process_Subtype (E, N);
 470             Acc_Type := Create_Itype (E_Allocator_Type, N);
 471             Set_Etype                    (Acc_Type, Acc_Type);
 472             Init_Size_Align              (Acc_Type);
 473             Set_Directly_Designated_Type (Acc_Type, Type_Id);
 474             Check_Fully_Declared (Type_Id, N);
 475
 476             --  Ada 2005 (AI-231)
 477
 478             if Can_Never_Be_Null (Type_Id) then
 479                Error_Msg_N ("(Ada 2005) qualified expression required",
 480                             Expression (N));
 481             end if;
 482
 483             --  Check restriction against dynamically allocated protected
 484             --  objects. Note that when limited aggregates are supported,
 485             --  a similar test should be applied to an allocator with a
 486             --  qualified expression ???
 487
 488             if Is_Protected_Type (Type_Id) then
 489                Check_Restriction (No_Protected_Type_Allocators, N);
 490             end if;
 491
 492             --  Check for missing initialization. Skip this check if we already
 493             --  had errors on analyzing the allocator, since in that case these
 494             --  are probably cascaded errors
 495
 496             if Is_Indefinite_Subtype (Type_Id)
 497               and then Serious_Errors_Detected = Sav_Errs
 498             then
 499                if Is_Class_Wide_Type (Type_Id) then
 500                   Error_Msg_N
 501                     ("initialization required in class-wide allocation", N);
 502                else
 503                   Error_Msg_N
 504                     ("initialization required in unconstrained allocation", N);
 505                end if;
 506             end if;
 507          end;
 508       end if;
 509
 510       if Is_Abstract (Type_Id) then
 511          Error_Msg_N ("cannot allocate abstract object", E);
 512       end if;
 513
 514       if Has_Task (Designated_Type (Acc_Type)) then
 515          Check_Restriction (No_Tasking, N);
 516          Check_Restriction (Max_Tasks, N);
 517          Check_Restriction (No_Task_Allocators, N);
 518       end if;
 519
 520       --  If the No_Streams restriction is set, check that the type of the
 521       --  object is not, and does not contain, any subtype derived from
 522       --  Ada.Streams.Root_Stream_Type. Note that we guard the call to
 523       --  Has_Stream just for efficiency reasons. There is no point in
 524       --  spending time on a Has_Stream check if the restriction is not set.
 525
 526       if Restrictions.Set (No_Streams) then
 527          if Has_Stream (Designated_Type (Acc_Type)) then
 528             Check_Restriction (No_Streams, N);
 529          end if;
 530       end if;
 531
 532       Set_Etype (N, Acc_Type);
 533
 534       if not Is_Library_Level_Entity (Acc_Type) then
 535          Check_Restriction (No_Local_Allocators, N);
 536       end if;
 537
 538       if Serious_Errors_Detected > Sav_Errs then
 539          Set_Error_Posted (N);
 540          Set_Etype (N, Any_Type);
 541       end if;
 542    end Analyze_Allocator;
 543
 544    ---------------------------
 545    -- Analyze_Arithmetic_Op --
 546    ---------------------------
 547
 548    procedure Analyze_Arithmetic_Op (N : Node_Id) is
 549       L     : constant Node_Id := Left_Opnd (N);
 550       R     : constant Node_Id := Right_Opnd (N);
 551       Op_Id : Entity_Id;
 552
 553    begin
 554       Candidate_Type := Empty;
 555       Analyze_Expression (L);
 556       Analyze_Expression (R);
 557
 558       --  If the entity is already set, the node is the instantiation of
 559       --  a generic node with a non-local reference, or was manufactured
 560       --  by a call to Make_Op_xxx. In either case the entity is known to
 561       --  be valid, and we do not need to collect interpretations, instead
 562       --  we just get the single possible interpretation.
 563
 564       Op_Id := Entity (N);
 565
 566       if Present (Op_Id) then
 567          if Ekind (Op_Id) = E_Operator then
 568
 569             if (Nkind (N) = N_Op_Divide   or else
 570                 Nkind (N) = N_Op_Mod      or else
 571                 Nkind (N) = N_Op_Multiply or else
 572                 Nkind (N) = N_Op_Rem)
 573               and then Treat_Fixed_As_Integer (N)
 574             then
 575                null;
 576             else
 577                Set_Etype (N, Any_Type);
 578                Find_Arithmetic_Types (L, R, Op_Id, N);
 579             end if;
 580
 581          else
 582             Set_Etype (N, Any_Type);
 583             Add_One_Interp (N, Op_Id, Etype (Op_Id));
 584          end if;
 585
 586       --  Entity is not already set, so we do need to collect interpretations
 587
 588       else
 589          Op_Id := Get_Name_Entity_Id (Chars (N));
 590          Set_Etype (N, Any_Type);
 591
 592          while Present (Op_Id) loop
 593             if Ekind (Op_Id) = E_Operator
 594               and then Present (Next_Entity (First_Entity (Op_Id)))
 595             then
 596                Find_Arithmetic_Types (L, R, Op_Id, N);
 597
 598             --  The following may seem superfluous, because an operator cannot
 599             --  be generic, but this ignores the cleverness of the author of
 600             --  ACVC bc1013a.
 601
 602             elsif Is_Overloadable (Op_Id) then
 603                Analyze_User_Defined_Binary_Op (N, Op_Id);
 604             end if;
 605
 606             Op_Id := Homonym (Op_Id);
 607          end loop;
 608       end if;
 609
 610       Operator_Check (N);
 611    end Analyze_Arithmetic_Op;
 612
 613    ------------------
 614    -- Analyze_Call --
 615    ------------------
 616
 617    --  Function, procedure, and entry calls are checked here. The Name in
 618    --  the call may be overloaded. The actuals have been analyzed and may
 619    --  themselves be overloaded. On exit from this procedure, the node N
 620    --  may have zero, one or more interpretations. In the first case an
 621    --  error message is produced. In the last case, the node is flagged
 622    --  as overloaded and the interpretations are collected in All_Interp.
 623
 624    --  If the name is an Access_To_Subprogram, it cannot be overloaded, but
 625    --  the type-checking is similar to that of other calls.
 626
 627    procedure Analyze_Call (N : Node_Id) is
 628       Actuals : constant List_Id := Parameter_Associations (N);
 629       Nam     : Node_Id          := Name (N);
 630       X       : Interp_Index;
 631       It      : Interp;
 632       Nam_Ent : Entity_Id;
 633       Success : Boolean := False;
 634
 635       function Name_Denotes_Function return Boolean;
 636       --  If the type of the name is an access to subprogram, this may be
 637       --  the type of a name, or the return type of the function being called.
 638       --  If the name is not an entity then it can denote a protected function.
 639       --  Until we distinguish Etype from Return_Type, we must use this
 640       --  routine to resolve the meaning of the name in the call.
 641
 642       ---------------------------
 643       -- Name_Denotes_Function --
 644       ---------------------------
 645
 646       function Name_Denotes_Function return Boolean is
 647       begin
 648          if Is_Entity_Name (Nam) then
 649             return Ekind (Entity (Nam)) = E_Function;
 650
 651          elsif Nkind (Nam) = N_Selected_Component then
 652             return Ekind (Entity (Selector_Name (Nam))) = E_Function;
 653
 654          else
 655             return False;
 656          end if;
 657       end Name_Denotes_Function;
 658
 659    --  Start of processing for Analyze_Call
 660
 661    begin
 662       --  Initialize the type of the result of the call to the error type,
 663       --  which will be reset if the type is successfully resolved.
 664
 665       Set_Etype (N, Any_Type);
 666
 667       if not Is_Overloaded (Nam) then
 668
 669          --  Only one interpretation to check
 670
 671          if Ekind (Etype (Nam)) = E_Subprogram_Type then
 672             Nam_Ent := Etype (Nam);
 673
 674          --  If the prefix is an access_to_subprogram, this may be an indirect
 675          --  call. This is the case if the name in the call is not an entity
 676          --  name, or if it is a function name in the context of a procedure
 677          --  call. In this latter case, we have a call to a parameterless
 678          --  function that returns a pointer_to_procedure which is the entity
 679          --  being called.
 680
 681          elsif Is_Access_Type (Etype (Nam))
 682            and then Ekind (Designated_Type (Etype (Nam))) = E_Subprogram_Type
 683            and then
 684              (not Name_Denotes_Function
 685                 or else Nkind (N) = N_Procedure_Call_Statement)
 686          then
 687             Nam_Ent := Designated_Type (Etype (Nam));
 688             Insert_Explicit_Dereference (Nam);
 689
 690          --  Selected component case. Simple entry or protected operation,
 691          --  where the entry name is given by the selector name.
 692
 693          elsif Nkind (Nam) = N_Selected_Component then
 694             Nam_Ent := Entity (Selector_Name (Nam));
 695
 696             if Ekind (Nam_Ent) /= E_Entry
 697               and then Ekind (Nam_Ent) /= E_Entry_Family
 698               and then Ekind (Nam_Ent) /= E_Function
 699               and then Ekind (Nam_Ent) /= E_Procedure
 700             then
 701                Error_Msg_N ("name in call is not a callable entity", Nam);
 702                Set_Etype (N, Any_Type);
 703                return;
 704             end if;
 705
 706          --  If the name is an Indexed component, it can be a call to a member
 707          --  of an entry family. The prefix must be a selected component whose
 708          --  selector is the entry. Analyze_Procedure_Call normalizes several
 709          --  kinds of call into this form.
 710
 711          elsif Nkind (Nam) = N_Indexed_Component then
 712
 713             if Nkind (Prefix (Nam)) = N_Selected_Component then
 714                Nam_Ent := Entity (Selector_Name (Prefix (Nam)));
 715             else
 716                Error_Msg_N ("name in call is not a callable entity", Nam);
 717                Set_Etype (N, Any_Type);
 718                return;
 719             end if;
 720
 721          elsif not Is_Entity_Name (Nam) then
 722             Error_Msg_N ("name in call is not a callable entity", Nam);
 723             Set_Etype (N, Any_Type);
 724             return;
 725
 726          else
 727             Nam_Ent := Entity (Nam);
 728
 729             --  If no interpretations, give error message
 730
 731             if not Is_Overloadable (Nam_Ent) then
 732                declare
 733                   L : constant Boolean   := Is_List_Member (N);
 734                   K : constant Node_Kind := Nkind (Parent (N));
 735
 736                begin
 737                   --  If the node is in a list whose parent is not an
 738                   --  expression then it must be an attempted procedure call.
 739
 740                   if L and then K not in N_Subexpr then
 741                      if Ekind (Entity (Nam)) = E_Generic_Procedure then
 742                         Error_Msg_NE
 743                           ("must instantiate generic procedure& before call",
 744                            Nam, Entity (Nam));
 745                      else
 746                         Error_Msg_N
 747                           ("procedure or entry name expected", Nam);
 748                      end if;
 749
 750                   --  Check for tasking cases where only an entry call will do
 751
 752                   elsif not L
 753                     and then (K = N_Entry_Call_Alternative
 754                                or else K = N_Triggering_Alternative)
 755                   then
 756                      Error_Msg_N ("entry name expected", Nam);
 757
 758                   --  Otherwise give general error message
 759
 760                   else
 761                      Error_Msg_N ("invalid prefix in call", Nam);
 762                   end if;
 763
 764                   return;
 765                end;
 766             end if;
 767          end if;
 768
 769          Analyze_One_Call (N, Nam_Ent, True, Success);
 770
 771          --  If this is an indirect call, the return type of the access_to
 772          --  subprogram may be an incomplete type. At the point of the call,
 773          --  use the full type if available, and at the same time update
 774          --  the return type of the access_to_subprogram.
 775
 776          if Success
 777            and then  Nkind (Nam) = N_Explicit_Dereference
 778            and then Ekind (Etype (N)) = E_Incomplete_Type
 779            and then Present (Full_View (Etype (N)))
 780          then
 781             Set_Etype (N, Full_View (Etype (N)));
 782             Set_Etype (Nam_Ent, Etype (N));
 783          end if;
 784
 785       else
 786          --  An overloaded selected component must denote overloaded
 787          --  operations of a concurrent type. The interpretations are
 788          --  attached to the simple name of those operations.
 789
 790          if Nkind (Nam) = N_Selected_Component then
 791             Nam := Selector_Name (Nam);
 792          end if;
 793
 794          Get_First_Interp (Nam, X, It);
 795
 796          while Present (It.Nam) loop
 797             Nam_Ent := It.Nam;
 798
 799             --  Name may be call that returns an access to subprogram, or more
 800             --  generally an overloaded expression one of whose interpretations
 801             --  yields an access to subprogram. If the name is an entity, we
 802             --  do not dereference, because the node is a call that returns
 803             --  the access type: note difference between f(x), where the call
 804             --  may return an access subprogram type, and f(x)(y), where the
 805             --  type returned by the call to f is implicitly dereferenced to
 806             --  analyze the outer call.
 807
 808             if Is_Access_Type (Nam_Ent) then
 809                Nam_Ent := Designated_Type (Nam_Ent);
 810
 811             elsif Is_Access_Type (Etype (Nam_Ent))
 812               and then not Is_Entity_Name (Nam)
 813               and then Ekind (Designated_Type (Etype (Nam_Ent)))
 814                                                           = E_Subprogram_Type
 815             then
 816                Nam_Ent := Designated_Type (Etype (Nam_Ent));
 817             end if;
 818
 819             Analyze_One_Call (N, Nam_Ent, False, Success);
 820
 821             --  If the interpretation succeeds, mark the proper type of the
 822             --  prefix (any valid candidate will do). If not, remove the
 823             --  candidate interpretation. This only needs to be done for
 824             --  overloaded protected operations, for other entities disambi-
 825             --  guation is done directly in Resolve.
 826
 827             if Success then
 828                Set_Etype (Nam, It.Typ);
 829
 830             elsif Nkind (Name (N)) = N_Selected_Component
 831               or else Nkind (Name (N)) = N_Function_Call
 832             then
 833                Remove_Interp (X);
 834             end if;
 835
 836             Get_Next_Interp (X, It);
 837          end loop;
 838
 839          --  If the name is the result of a function call, it can only
 840          --  be a call to a function returning an access to subprogram.
 841          --  Insert explicit dereference.
 842
 843          if Nkind (Nam) = N_Function_Call then
 844             Insert_Explicit_Dereference (Nam);
 845          end if;
 846
 847          if Etype (N) = Any_Type then
 848
 849             --  None of the interpretations is compatible with the actuals
 850
 851             Diagnose_Call (N, Nam);
 852
 853             --  Special checks for uninstantiated put routines
 854
 855             if Nkind (N) = N_Procedure_Call_Statement
 856               and then Is_Entity_Name (Nam)
 857               and then Chars (Nam) = Name_Put
 858               and then List_Length (Actuals) = 1
 859             then
 860                declare
 861                   Arg : constant Node_Id := First (Actuals);
 862                   Typ : Entity_Id;
 863
 864                begin
 865                   if Nkind (Arg) = N_Parameter_Association then
 866                      Typ := Etype (Explicit_Actual_Parameter (Arg));
 867                   else
 868                      Typ := Etype (Arg);
 869                   end if;
 870
 871                   if Is_Signed_Integer_Type (Typ) then
 872                      Error_Msg_N
 873                        ("possible missing instantiation of " &
 874                           "'Text_'I'O.'Integer_'I'O!", Nam);
 875
 876                   elsif Is_Modular_Integer_Type (Typ) then
 877                      Error_Msg_N
 878                        ("possible missing instantiation of " &
 879                           "'Text_'I'O.'Modular_'I'O!", Nam);
 880
 881                   elsif Is_Floating_Point_Type (Typ) then
 882                      Error_Msg_N
 883                        ("possible missing instantiation of " &
 884                           "'Text_'I'O.'Float_'I'O!", Nam);
 885
 886                   elsif Is_Ordinary_Fixed_Point_Type (Typ) then
 887                      Error_Msg_N
 888                        ("possible missing instantiation of " &
 889                           "'Text_'I'O.'Fixed_'I'O!", Nam);
 890
 891                   elsif Is_Decimal_Fixed_Point_Type (Typ) then
 892                      Error_Msg_N
 893                        ("possible missing instantiation of " &
 894                           "'Text_'I'O.'Decimal_'I'O!", Nam);
 895
 896                   elsif Is_Enumeration_Type (Typ) then
 897                      Error_Msg_N
 898                        ("possible missing instantiation of " &
 899                           "'Text_'I'O.'Enumeration_'I'O!", Nam);
 900                   end if;
 901                end;
 902             end if;
 903
 904          elsif not Is_Overloaded (N)
 905            and then Is_Entity_Name (Nam)
 906          then
 907             --  Resolution yields a single interpretation. Verify that
 908             --  is has the proper capitalization.
 909
 910             Set_Entity_With_Style_Check (Nam, Entity (Nam));
 911             Generate_Reference (Entity (Nam), Nam);
 912
 913             Set_Etype (Nam, Etype (Entity (Nam)));
 914          else
 915             Remove_Abstract_Operations (N);
 916          end if;
 917
 918          End_Interp_List;
 919       end if;
 920
 921       --  Check for not-yet-implemented cases of AI-318.
 922       --  We only need to check for inherently limited types,
 923       --  because other limited types will be returned by copy,
 924       --  which works just fine.
 925
 926       if Ada_Version >= Ada_05
 927         and then not Debug_Flag_Dot_L
 928         and then Is_Inherently_Limited_Type (Etype (N))
 929         and then (Nkind (Parent (N)) = N_Selected_Component
 930                   or else Nkind (Parent (N)) = N_Indexed_Component
 931                   or else Nkind (Parent (N)) = N_Slice
 932                   or else Nkind (Parent (N)) = N_Attribute_Reference
 933                   or else Nkind (Parent (N)) = N_Component_Declaration
 934                   or else Nkind (Parent (N)) = N_Formal_Object_Declaration
 935                   or else Nkind (Parent (N)) = N_Generic_Association)
 936       then
 937          Error_Msg_N ("(Ada 2005) limited function call in this context" &
 938                       " is not yet implemented", N);
 939       end if;
 940    end Analyze_Call;
 941
 942    ---------------------------
 943    -- Analyze_Comparison_Op --
 944    ---------------------------
 945
 946    procedure Analyze_Comparison_Op (N : Node_Id) is
 947       L     : constant Node_Id := Left_Opnd (N);
 948       R     : constant Node_Id := Right_Opnd (N);
 949       Op_Id : Entity_Id        := Entity (N);
 950
 951    begin
 952       Set_Etype (N, Any_Type);
 953       Candidate_Type := Empty;
 954
 955       Analyze_Expression (L);
 956       Analyze_Expression (R);
 957
 958       if Present (Op_Id) then
 959          if Ekind (Op_Id) = E_Operator then
 960             Find_Comparison_Types (L, R, Op_Id, N);
 961          else
 962             Add_One_Interp (N, Op_Id, Etype (Op_Id));
 963          end if;
 964
 965          if Is_Overloaded (L) then
 966             Set_Etype (L, Intersect_Types (L, R));
 967          end if;
 968
 969       else
 970          Op_Id := Get_Name_Entity_Id (Chars (N));
 971          while Present (Op_Id) loop
 972             if Ekind (Op_Id) = E_Operator then
 973                Find_Comparison_Types (L, R, Op_Id, N);
 974             else
 975                Analyze_User_Defined_Binary_Op (N, Op_Id);
 976             end if;
 977
 978             Op_Id := Homonym (Op_Id);
 979          end loop;
 980       end if;
 981
 982       Operator_Check (N);
 983    end Analyze_Comparison_Op;
 984
 985    ---------------------------
 986    -- Analyze_Concatenation --
 987    ---------------------------
 988
 989    --  If the only one-dimensional array type in scope is String,
 990    --  this is the resulting type of the operation. Otherwise there
 991    --  will be a concatenation operation defined for each user-defined
 992    --  one-dimensional array.
 993
 994    procedure Analyze_Concatenation (N : Node_Id) is
 995       L     : constant Node_Id := Left_Opnd (N);
 996       R     : constant Node_Id := Right_Opnd (N);
 997       Op_Id : Entity_Id        := Entity (N);
 998       LT    : Entity_Id;
 999       RT    : Entity_Id;
1000
1001    begin
1002       Set_Etype (N, Any_Type);
1003       Candidate_Type := Empty;
1004
1005       Analyze_Expression (L);
1006       Analyze_Expression (R);
1007
1008       --  If the entity is present, the  node appears in an instance,
1009       --  and denotes a predefined concatenation operation. The resulting
1010       --  type is obtained from the arguments when possible. If the arguments
1011       --  are aggregates, the array type and the concatenation type must be
1012       --  visible.
1013
1014       if Present (Op_Id) then
1015          if Ekind (Op_Id) = E_Operator then
1016
1017             LT := Base_Type (Etype (L));
1018             RT := Base_Type (Etype (R));
1019
1020             if Is_Array_Type (LT)
1021               and then (RT = LT or else RT = Base_Type (Component_Type (LT)))
1022             then
1023                Add_One_Interp (N, Op_Id, LT);
1024
1025             elsif Is_Array_Type (RT)
1026               and then LT = Base_Type (Component_Type (RT))
1027             then
1028                Add_One_Interp (N, Op_Id, RT);
1029
1030             --  If one operand is a string type or a user-defined array type,
1031             --  and the other is a literal, result is of the specific type.
1032
1033             elsif
1034               (Root_Type (LT) = Standard_String
1035                  or else Scope (LT) /= Standard_Standard)
1036               and then Etype (R) = Any_String
1037             then
1038                Add_One_Interp (N, Op_Id, LT);
1039
1040             elsif
1041               (Root_Type (RT) = Standard_String
1042                  or else Scope (RT) /= Standard_Standard)
1043               and then Etype (L) = Any_String
1044             then
1045                Add_One_Interp (N, Op_Id, RT);
1046
1047             elsif not Is_Generic_Type (Etype (Op_Id)) then
1048                Add_One_Interp (N, Op_Id, Etype (Op_Id));
1049
1050             else
1051                --  Type and its operations must be visible
1052
1053                Set_Entity (N, Empty);
1054                Analyze_Concatenation (N);
1055             end if;
1056
1057          else
1058             Add_One_Interp (N, Op_Id, Etype (Op_Id));
1059          end if;
1060
1061       else
1062          Op_Id := Get_Name_Entity_Id (Name_Op_Concat);
1063          while Present (Op_Id) loop
1064             if Ekind (Op_Id) = E_Operator then
1065
1066                --  Do not consider operators declared in dead code, they can
1067                --  not be part of the resolution.
1068
1069                if Is_Eliminated (Op_Id) then
1070                   null;
1071                else
1072                   Find_Concatenation_Types (L, R, Op_Id, N);
1073                end if;
1074
1075             else
1076                Analyze_User_Defined_Binary_Op (N, Op_Id);
1077             end if;
1078
1079             Op_Id := Homonym (Op_Id);
1080          end loop;
1081       end if;
1082
1083       Operator_Check (N);
1084    end Analyze_Concatenation;
1085
1086    ------------------------------------
1087    -- Analyze_Conditional_Expression --
1088    ------------------------------------
1089
1090    procedure Analyze_Conditional_Expression (N : Node_Id) is
1091       Condition : constant Node_Id := First (Expressions (N));
1092       Then_Expr : constant Node_Id := Next (Condition);
1093       Else_Expr : constant Node_Id := Next (Then_Expr);
1094    begin
1095       Analyze_Expression (Condition);
1096       Analyze_Expression (Then_Expr);
1097       Analyze_Expression (Else_Expr);
1098       Set_Etype (N, Etype (Then_Expr));
1099    end Analyze_Conditional_Expression;
1100
1101    -------------------------
1102    -- Analyze_Equality_Op --
1103    -------------------------
1104
1105    procedure Analyze_Equality_Op (N : Node_Id) is
1106       Loc   : constant Source_Ptr := Sloc (N);
1107       L     : constant Node_Id := Left_Opnd (N);
1108       R     : constant Node_Id := Right_Opnd (N);
1109       Op_Id : Entity_Id;
1110
1111    begin
1112       Set_Etype (N, Any_Type);
1113       Candidate_Type := Empty;
1114
1115       Analyze_Expression (L);
1116       Analyze_Expression (R);
1117
1118       --  If the entity is set, the node is a generic instance with a non-local
1119       --  reference to the predefined operator or to a user-defined function.
1120       --  It can also be an inequality that is expanded into the negation of a
1121       --  call to a user-defined equality operator.
1122
1123       --  For the predefined case, the result is Boolean, regardless of the
1124       --  type of the  operands. The operands may even be limited, if they are
1125       --  generic actuals. If they are overloaded, label the left argument with
1126       --  the common type that must be present, or with the type of the formal
1127       --  of the user-defined function.
1128
1129       if Present (Entity (N)) then
1130          Op_Id := Entity (N);
1131
1132          if Ekind (Op_Id) = E_Operator then
1133             Add_One_Interp (N, Op_Id, Standard_Boolean);
1134          else
1135             Add_One_Interp (N, Op_Id, Etype (Op_Id));
1136          end if;
1137
1138          if Is_Overloaded (L) then
1139             if Ekind (Op_Id) = E_Operator then
1140                Set_Etype (L, Intersect_Types (L, R));
1141             else
1142                Set_Etype (L, Etype (First_Formal (Op_Id)));
1143             end if;
1144          end if;
1145
1146       else
1147          Op_Id := Get_Name_Entity_Id (Chars (N));
1148          while Present (Op_Id) loop
1149             if Ekind (Op_Id) = E_Operator then
1150                Find_Equality_Types (L, R, Op_Id, N);
1151             else
1152                Analyze_User_Defined_Binary_Op (N, Op_Id);
1153             end if;
1154
1155             Op_Id := Homonym (Op_Id);
1156          end loop;
1157       end if;
1158
1159       --  If there was no match, and the operator is inequality, this may
1160       --  be a case where inequality has not been made explicit, as for
1161       --  tagged types. Analyze the node as the negation of an equality
1162       --  operation. This cannot be done earlier, because before analysis
1163       --  we cannot rule out the presence of an explicit inequality.
1164
1165       if Etype (N) = Any_Type
1166         and then Nkind (N) = N_Op_Ne
1167       then
1168          Op_Id := Get_Name_Entity_Id (Name_Op_Eq);
1169          while Present (Op_Id) loop
1170             if Ekind (Op_Id) = E_Operator then
1171                Find_Equality_Types (L, R, Op_Id, N);
1172             else
1173                Analyze_User_Defined_Binary_Op (N, Op_Id);
1174             end if;
1175
1176             Op_Id := Homonym (Op_Id);
1177          end loop;
1178
1179          if Etype (N) /= Any_Type then
1180             Op_Id := Entity (N);
1181
1182             Rewrite (N,
1183               Make_Op_Not (Loc,
1184                 Right_Opnd =>
1185                   Make_Op_Eq (Loc,
1186                     Left_Opnd =>  Relocate_Node (Left_Opnd (N)),
1187                     Right_Opnd => Relocate_Node (Right_Opnd (N)))));
1188
1189             Set_Entity (Right_Opnd (N), Op_Id);
1190             Analyze (N);
1191          end if;
1192       end if;
1193
1194       Operator_Check (N);
1195    end Analyze_Equality_Op;
1196
1197    ----------------------------------
1198    -- Analyze_Explicit_Dereference --
1199    ----------------------------------
1200
1201    procedure Analyze_Explicit_Dereference (N : Node_Id) is
1202       Loc   : constant Source_Ptr := Sloc (N);
1203       P     : constant Node_Id := Prefix (N);
1204       T     : Entity_Id;
1205       I     : Interp_Index;
1206       It    : Interp;
1207       New_N : Node_Id;
1208
1209       function Is_Function_Type return Boolean;
1210       --  Check whether node may be interpreted as an implicit function call
1211
1212       ----------------------
1213       -- Is_Function_Type --
1214       ----------------------
1215
1216       function Is_Function_Type return Boolean is
1217          I  : Interp_Index;
1218          It : Interp;
1219
1220       begin
1221          if not Is_Overloaded (N) then
1222             return Ekind (Base_Type (Etype (N))) = E_Subprogram_Type
1223               and then Etype (Base_Type (Etype (N))) /= Standard_Void_Type;
1224
1225          else
1226             Get_First_Interp (N, I, It);
1227             while Present (It.Nam) loop
1228                if Ekind (Base_Type (It.Typ)) /= E_Subprogram_Type
1229                  or else Etype (Base_Type (It.Typ)) = Standard_Void_Type
1230                then
1231                   return False;
1232                end if;
1233
1234                Get_Next_Interp (I, It);
1235             end loop;
1236
1237             return True;
1238          end if;
1239       end Is_Function_Type;
1240
1241    --  Start of processing for Analyze_Explicit_Dereference
1242
1243    begin
1244       Analyze (P);
1245       Set_Etype (N, Any_Type);
1246
1247       --  Test for remote access to subprogram type, and if so return
1248       --  after rewriting the original tree.
1249
1250       if Remote_AST_E_Dereference (P) then
1251          return;
1252       end if;
1253
1254       --  Normal processing for other than remote access to subprogram type
1255
1256       if not Is_Overloaded (P) then
1257          if Is_Access_Type (Etype (P)) then
1258
1259             --  Set the Etype. We need to go thru Is_For_Access_Subtypes
1260             --  to avoid other problems caused by the Private_Subtype
1261             --  and it is safe to go to the Base_Type because this is the
1262             --  same as converting the access value to its Base_Type.
1263
1264             declare
1265                DT : Entity_Id := Designated_Type (Etype (P));
1266
1267             begin
1268                if Ekind (DT) = E_Private_Subtype
1269                  and then Is_For_Access_Subtype (DT)
1270                then
1271                   DT := Base_Type (DT);
1272                end if;
1273
1274                Set_Etype (N, DT);
1275             end;
1276
1277          elsif Etype (P) /= Any_Type then
1278             Error_Msg_N ("prefix of dereference must be an access type", N);
1279             return;
1280          end if;
1281
1282       else
1283          Get_First_Interp (P, I, It);
1284          while Present (It.Nam) loop
1285             T := It.Typ;
1286
1287             if Is_Access_Type (T) then
1288                Add_One_Interp (N, Designated_Type (T), Designated_Type (T));
1289             end if;
1290
1291             Get_Next_Interp (I, It);
1292          end loop;
1293
1294          --  Error if no interpretation of the prefix has an access type
1295
1296          if Etype (N) = Any_Type then
1297             Error_Msg_N
1298               ("access type required in prefix of explicit dereference", P);
1299             Set_Etype (N, Any_Type);
1300             return;
1301          end if;
1302       end if;
1303
1304       if Is_Function_Type
1305         and then Nkind (Parent (N)) /= N_Indexed_Component
1306
1307         and then (Nkind (Parent (N)) /= N_Function_Call
1308                    or else N /= Name (Parent (N)))
1309
1310         and then (Nkind (Parent (N)) /= N_Procedure_Call_Statement
1311                    or else N /= Name (Parent (N)))
1312
1313         and then Nkind (Parent (N)) /= N_Subprogram_Renaming_Declaration
1314         and then (Nkind (Parent (N)) /= N_Attribute_Reference
1315                     or else
1316                       (Attribute_Name (Parent (N)) /= Name_Address
1317                         and then
1318                        Attribute_Name (Parent (N)) /= Name_Access))
1319       then
1320          --  Name is a function call with no actuals, in a context that
1321          --  requires deproceduring (including as an actual in an enclosing
1322          --  function or procedure call). There are some pathological cases
1323          --  where the prefix might include functions that return access to
1324          --  subprograms and others that return a regular type. Disambiguation
1325          --  of those has to take place in Resolve.
1326          --  See e.g. 7117-014 and E317-001.
1327
1328          New_N :=
1329            Make_Function_Call (Loc,
1330            Name => Make_Explicit_Dereference (Loc, P),
1331            Parameter_Associations => New_List);
1332
1333          --  If the prefix is overloaded, remove operations that have formals,
1334          --  we know that this is a parameterless call.
1335
1336          if Is_Overloaded (P) then
1337             Get_First_Interp (P, I, It);
1338             while Present (It.Nam) loop
1339                T := It.Typ;
1340
1341                if No (First_Formal (Base_Type (Designated_Type (T)))) then
1342                   Set_Etype (P, T);
1343                else
1344                   Remove_Interp (I);
1345                end if;
1346
1347                Get_Next_Interp (I, It);
1348             end loop;
1349          end if;
1350
1351          Rewrite (N, New_N);
1352          Analyze (N);
1353
1354       elsif not Is_Function_Type
1355         and then Is_Overloaded (N)
1356       then
1357          --  The prefix may include access to subprograms and other access
1358          --  types. If the context selects the interpretation that is a call,
1359          --  we cannot rewrite the node yet, but we include the result of
1360          --  the call interpretation.
1361
1362          Get_First_Interp (N, I, It);
1363          while Present (It.Nam) loop
1364             if Ekind (Base_Type (It.Typ)) = E_Subprogram_Type
1365                and then Etype (Base_Type (It.Typ)) /= Standard_Void_Type
1366             then
1367                Add_One_Interp (N, Etype (It.Typ), Etype (It.Typ));
1368             end if;
1369
1370             Get_Next_Interp (I, It);
1371          end loop;
1372       end if;
1373
1374       --  A value of remote access-to-class-wide must not be dereferenced
1375       --  (RM E.2.2(16)).
1376
1377       Validate_Remote_Access_To_Class_Wide_Type (N);
1378    end Analyze_Explicit_Dereference;
1379
1380    ------------------------
1381    -- Analyze_Expression --
1382    ------------------------
1383
1384    procedure Analyze_Expression (N : Node_Id) is
1385    begin
1386       Analyze (N);
1387       Check_Parameterless_Call (N);
1388    end Analyze_Expression;
1389
1390    ------------------------------------
1391    -- Analyze_Indexed_Component_Form --
1392    ------------------------------------
1393
1394    procedure Analyze_Indexed_Component_Form (N : Node_Id) is
1395       P     : constant Node_Id := Prefix (N);
1396       Exprs : constant List_Id := Expressions (N);
1397       Exp   : Node_Id;
1398       P_T   : Entity_Id;
1399       E     : Node_Id;
1400       U_N   : Entity_Id;
1401
1402       procedure Process_Function_Call;
1403       --  Prefix in indexed component form is an overloadable entity,
1404       --  so the node is a function call. Reformat it as such.
1405
1406       procedure Process_Indexed_Component;
1407       --  Prefix in indexed component form is actually an indexed component.
1408       --  This routine processes it, knowing that the prefix is already
1409       --  resolved.
1410
1411       procedure Process_Indexed_Component_Or_Slice;
1412       --  An indexed component with a single index may designate a slice if
1413       --  the index is a subtype mark. This routine disambiguates these two
1414       --  cases by resolving the prefix to see if it is a subtype mark.
1415
1416       procedure Process_Overloaded_Indexed_Component;
1417       --  If the prefix of an indexed component is overloaded, the proper
1418       --  interpretation is selected by the index types and the context.
1419
1420       ---------------------------
1421       -- Process_Function_Call --
1422       ---------------------------
1423
1424       procedure Process_Function_Call is
1425          Actual : Node_Id;
1426
1427       begin
1428          Change_Node (N, N_Function_Call);
1429          Set_Name (N, P);
1430          Set_Parameter_Associations (N, Exprs);
1431
1432          Actual := First (Parameter_Associations (N));
1433          while Present (Actual) loop
1434             Analyze (Actual);
1435             Check_Parameterless_Call (Actual);
1436             Next_Actual (Actual);
1437          end loop;
1438
1439          Analyze_Call (N);
1440       end Process_Function_Call;
1441
1442       -------------------------------
1443       -- Process_Indexed_Component --
1444       -------------------------------
1445
1446       procedure Process_Indexed_Component is
1447          Exp          : Node_Id;
1448          Array_Type   : Entity_Id;
1449          Index        : Node_Id;
1450          Pent         : Entity_Id := Empty;
1451
1452       begin
1453          Exp := First (Exprs);
1454
1455          if Is_Overloaded (P) then
1456             Process_Overloaded_Indexed_Component;
1457
1458          else
1459             Array_Type := Etype (P);
1460
1461             if Is_Entity_Name (P) then
1462                Pent := Entity (P);
1463             elsif Nkind (P) = N_Selected_Component
1464               and then Is_Entity_Name (Selector_Name (P))
1465             then
1466                Pent := Entity (Selector_Name (P));
1467             end if;
1468
1469             --  Prefix must be appropriate for an array type, taking into
1470             --  account a possible implicit dereference.
1471
1472             if Is_Access_Type (Array_Type) then
1473                Array_Type := Designated_Type (Array_Type);
1474                Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
1475                Process_Implicit_Dereference_Prefix (Pent, P);
1476             end if;
1477
1478             if Is_Array_Type (Array_Type) then
1479                null;
1480
1481             elsif Present (Pent) and then Ekind (Pent) = E_Entry_Family then
1482                Analyze (Exp);
1483                Set_Etype (N, Any_Type);
1484
1485                if not Has_Compatible_Type
1486                  (Exp, Entry_Index_Type (Pent))
1487                then
1488                   Error_Msg_N ("invalid index type in entry name", N);
1489
1490                elsif Present (Next (Exp)) then
1491                   Error_Msg_N ("too many subscripts in entry reference", N);
1492
1493                else
1494                   Set_Etype (N,  Etype (P));
1495                end if;
1496
1497                return;
1498
1499             elsif Is_Record_Type (Array_Type)
1500               and then Remote_AST_I_Dereference (P)
1501             then
1502                return;
1503
1504             elsif Array_Type = Any_Type then
1505                Set_Etype (N, Any_Type);
1506                return;
1507
1508             --  Here we definitely have a bad indexing
1509
1510             else
1511                if Nkind (Parent (N)) = N_Requeue_Statement
1512                  and then Present (Pent) and then Ekind (Pent) = E_Entry
1513                then
1514                   Error_Msg_N
1515                     ("REQUEUE does not permit parameters", First (Exprs));
1516
1517                elsif Is_Entity_Name (P)
1518                  and then Etype (P) = Standard_Void_Type
1519                then
1520                   Error_Msg_NE ("incorrect use of&", P, Entity (P));
1521
1522                else
1523                   Error_Msg_N ("array type required in indexed component", P);
1524                end if;
1525
1526                Set_Etype (N, Any_Type);
1527                return;
1528             end if;
1529
1530             Index := First_Index (Array_Type);
1531             while Present (Index) and then Present (Exp) loop
1532                if not Has_Compatible_Type (Exp, Etype (Index)) then
1533                   Wrong_Type (Exp, Etype (Index));
1534                   Set_Etype (N, Any_Type);
1535                   return;
1536                end if;
1537
1538                Next_Index (Index);
1539                Next (Exp);
1540             end loop;
1541
1542             Set_Etype (N, Component_Type (Array_Type));
1543
1544             if Present (Index) then
1545                Error_Msg_N
1546                  ("too few subscripts in array reference", First (Exprs));
1547
1548             elsif Present (Exp) then
1549                Error_Msg_N ("too many subscripts in array reference", Exp);
1550             end if;
1551          end if;
1552       end Process_Indexed_Component;
1553
1554       ----------------------------------------
1555       -- Process_Indexed_Component_Or_Slice --
1556       ----------------------------------------
1557
1558       procedure Process_Indexed_Component_Or_Slice is
1559       begin
1560          Exp := First (Exprs);
1561          while Present (Exp) loop
1562             Analyze_Expression (Exp);
1563             Next (Exp);
1564          end loop;
1565
1566          Exp := First (Exprs);
1567
1568          --  If one index is present, and it is a subtype name, then the
1569          --  node denotes a slice (note that the case of an explicit range
1570          --  for a slice was already built as an N_Slice node in the first
1571          --  place, so that case is not handled here).
1572
1573          --  We use a replace rather than a rewrite here because this is one
1574          --  of the cases in which the tree built by the parser is plain wrong.
1575
1576          if No (Next (Exp))
1577            and then Is_Entity_Name (Exp)
1578            and then Is_Type (Entity (Exp))
1579          then
1580             Replace (N,
1581                Make_Slice (Sloc (N),
1582                  Prefix => P,
1583                  Discrete_Range => New_Copy (Exp)));
1584             Analyze (N);
1585
1586          --  Otherwise (more than one index present, or single index is not
1587          --  a subtype name), then we have the indexed component case.
1588
1589          else
1590             Process_Indexed_Component;
1591          end if;
1592       end Process_Indexed_Component_Or_Slice;
1593
1594       ------------------------------------------
1595       -- Process_Overloaded_Indexed_Component --
1596       ------------------------------------------
1597
1598       procedure Process_Overloaded_Indexed_Component is
1599          Exp   : Node_Id;
1600          I     : Interp_Index;
1601          It    : Interp;
1602          Typ   : Entity_Id;
1603          Index : Node_Id;
1604          Found : Boolean;
1605
1606       begin
1607          Set_Etype (N, Any_Type);
1608
1609          Get_First_Interp (P, I, It);
1610          while Present (It.Nam) loop
1611             Typ := It.Typ;
1612
1613             if Is_Access_Type (Typ) then
1614                Typ := Designated_Type (Typ);
1615                Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
1616             end if;
1617
1618             if Is_Array_Type (Typ) then
1619
1620                --  Got a candidate: verify that index types are compatible
1621
1622                Index := First_Index (Typ);
1623                Found := True;
1624                Exp := First (Exprs);
1625                while Present (Index) and then Present (Exp) loop
1626                   if Has_Compatible_Type (Exp, Etype (Index)) then
1627                      null;
1628                   else
1629                      Found := False;
1630                      Remove_Interp (I);
1631                      exit;
1632                   end if;
1633
1634                   Next_Index (Index);
1635                   Next (Exp);
1636                end loop;
1637
1638                if Found and then No (Index) and then No (Exp) then
1639                   Add_One_Interp (N,
1640                      Etype (Component_Type (Typ)),
1641                      Etype (Component_Type (Typ)));
1642                end if;
1643             end if;
1644
1645             Get_Next_Interp (I, It);
1646          end loop;
1647
1648          if Etype (N) = Any_Type then
1649             Error_Msg_N ("no legal interpetation for indexed component", N);
1650             Set_Is_Overloaded (N, False);
1651          end if;
1652
1653          End_Interp_List;
1654       end Process_Overloaded_Indexed_Component;
1655
1656    --  Start of processing for Analyze_Indexed_Component_Form
1657
1658    begin
1659       --  Get name of array, function or type
1660
1661       Analyze (P);
1662       if Nkind (N) = N_Function_Call
1663         or else Nkind (N) = N_Procedure_Call_Statement
1664       then
1665          --  If P is an explicit dereference whose prefix is of a
1666          --  remote access-to-subprogram type, then N has already
1667          --  been rewritten as a subprogram call and analyzed.
1668
1669          return;
1670       end if;
1671
1672       pragma Assert (Nkind (N) = N_Indexed_Component);
1673
1674       P_T := Base_Type (Etype (P));
1675
1676       if Is_Entity_Name (P)
1677         or else Nkind (P) = N_Operator_Symbol
1678       then
1679          U_N := Entity (P);
1680
1681          if Ekind (U_N) in Type_Kind then
1682
1683             --  Reformat node as a type conversion
1684
1685             E := Remove_Head (Exprs);
1686
1687             if Present (First (Exprs)) then
1688                Error_Msg_N
1689                 ("argument of type conversion must be single expression", N);
1690             end if;
1691
1692             Change_Node (N, N_Type_Conversion);
1693             Set_Subtype_Mark (N, P);
1694             Set_Etype (N, U_N);
1695             Set_Expression (N, E);
1696
1697             --  After changing the node, call for the specific Analysis
1698             --  routine directly, to avoid a double call to the expander.
1699
1700             Analyze_Type_Conversion (N);
1701             return;
1702          end if;
1703
1704          if Is_Overloadable (U_N) then
1705             Process_Function_Call;
1706
1707          elsif Ekind (Etype (P)) = E_Subprogram_Type
1708            or else (Is_Access_Type (Etype (P))
1709                       and then
1710                     Ekind (Designated_Type (Etype (P))) = E_Subprogram_Type)
1711          then
1712             --  Call to access_to-subprogram with possible implicit dereference
1713
1714             Process_Function_Call;
1715
1716          elsif Is_Generic_Subprogram (U_N) then
1717
1718             --  A common beginner's (or C++ templates fan) error
1719
1720             Error_Msg_N ("generic subprogram cannot be called", N);
1721             Set_Etype (N, Any_Type);
1722             return;
1723
1724          else
1725             Process_Indexed_Component_Or_Slice;
1726          end if;
1727
1728       --  If not an entity name, prefix is an expression that may denote
1729       --  an array or an access-to-subprogram.
1730
1731       else
1732          if Ekind (P_T) = E_Subprogram_Type
1733            or else (Is_Access_Type (P_T)
1734                      and then
1735                     Ekind (Designated_Type (P_T)) = E_Subprogram_Type)
1736          then
1737             Process_Function_Call;
1738
1739          elsif Nkind (P) = N_Selected_Component
1740            and then Is_Overloadable (Entity (Selector_Name (P)))
1741          then
1742             Process_Function_Call;
1743
1744          else
1745             --  Indexed component, slice, or a call to a member of a family
1746             --  entry, which will be converted to an entry call later.
1747
1748             Process_Indexed_Component_Or_Slice;
1749          end if;
1750       end if;
1751    end Analyze_Indexed_Component_Form;
1752
1753    ------------------------
1754    -- Analyze_Logical_Op --
1755    ------------------------
1756
1757    procedure Analyze_Logical_Op (N : Node_Id) is
1758       L     : constant Node_Id := Left_Opnd (N);
1759       R     : constant Node_Id := Right_Opnd (N);
1760       Op_Id : Entity_Id := Entity (N);
1761
1762    begin
1763       Set_Etype (N, Any_Type);
1764       Candidate_Type := Empty;
1765
1766       Analyze_Expression (L);
1767       Analyze_Expression (R);
1768
1769       if Present (Op_Id) then
1770
1771          if Ekind (Op_Id) = E_Operator then
1772             Find_Boolean_Types (L, R, Op_Id, N);
1773          else
1774             Add_One_Interp (N, Op_Id, Etype (Op_Id));
1775          end if;
1776
1777       else
1778          Op_Id := Get_Name_Entity_Id (Chars (N));
1779          while Present (Op_Id) loop
1780             if Ekind (Op_Id) = E_Operator then
1781                Find_Boolean_Types (L, R, Op_Id, N);
1782             else
1783                Analyze_User_Defined_Binary_Op (N, Op_Id);
1784             end if;
1785
1786             Op_Id := Homonym (Op_Id);
1787          end loop;
1788       end if;
1789
1790       Operator_Check (N);
1791    end Analyze_Logical_Op;
1792
1793    ---------------------------
1794    -- Analyze_Membership_Op --
1795    ---------------------------
1796
1797    procedure Analyze_Membership_Op (N : Node_Id) is
1798       L     : constant Node_Id := Left_Opnd (N);
1799       R     : constant Node_Id := Right_Opnd (N);
1800
1801       Index : Interp_Index;
1802       It    : Interp;
1803       Found : Boolean := False;
1804       I_F   : Interp_Index;
1805       T_F   : Entity_Id;
1806
1807       procedure Try_One_Interp (T1 : Entity_Id);
1808       --  Routine to try one proposed interpretation. Note that the context
1809       --  of the operation plays no role in resolving the arguments, so that
1810       --  if there is more than one interpretation of the operands that is
1811       --  compatible with a membership test, the operation is ambiguous.
1812
1813       --------------------
1814       -- Try_One_Interp --
1815       --------------------
1816
1817       procedure Try_One_Interp (T1 : Entity_Id) is
1818       begin
1819          if Has_Compatible_Type (R, T1) then
1820             if Found
1821               and then Base_Type (T1) /= Base_Type (T_F)
1822             then
1823                It := Disambiguate (L, I_F, Index, Any_Type);
1824
1825                if It = No_Interp then
1826                   Ambiguous_Operands (N);
1827                   Set_Etype (L, Any_Type);
1828                   return;
1829
1830                else
1831                   T_F := It.Typ;
1832                end if;
1833
1834             else
1835                Found := True;
1836                T_F   := T1;
1837                I_F   := Index;
1838             end if;
1839
1840             Set_Etype (L, T_F);
1841          end if;
1842
1843       end Try_One_Interp;
1844
1845    --  Start of processing for Analyze_Membership_Op
1846
1847    begin
1848       Analyze_Expression (L);
1849
1850       if Nkind (R) = N_Range
1851         or else (Nkind (R) = N_Attribute_Reference
1852                   and then Attribute_Name (R) = Name_Range)
1853       then
1854          Analyze (R);
1855
1856          if not Is_Overloaded (L) then
1857             Try_One_Interp (Etype (L));
1858
1859          else
1860             Get_First_Interp (L, Index, It);
1861             while Present (It.Typ) loop
1862                Try_One_Interp (It.Typ);
1863                Get_Next_Interp (Index, It);
1864             end loop;
1865          end if;
1866
1867       --  If not a range, it can only be a subtype mark, or else there
1868       --  is a more basic error, to be diagnosed in Find_Type.
1869
1870       else
1871          Find_Type (R);
1872
1873          if Is_Entity_Name (R) then
1874             Check_Fully_Declared (Entity (R), R);
1875          end if;
1876       end if;
1877
1878       --  Compatibility between expression and subtype mark or range is
1879       --  checked during resolution. The result of the operation is Boolean
1880       --  in any case.
1881
1882       Set_Etype (N, Standard_Boolean);
1883
1884       if Comes_From_Source (N)
1885         and then Is_CPP_Class (Etype (Etype (Right_Opnd (N))))
1886       then
1887          Error_Msg_N ("membership test not applicable to cpp-class types", N);
1888       end if;
1889    end Analyze_Membership_Op;
1890
1891    ----------------------
1892    -- Analyze_Negation --
1893    ----------------------
1894
1895    procedure Analyze_Negation (N : Node_Id) is
1896       R     : constant Node_Id := Right_Opnd (N);
1897       Op_Id : Entity_Id := Entity (N);
1898
1899    begin
1900       Set_Etype (N, Any_Type);
1901       Candidate_Type := Empty;
1902
1903       Analyze_Expression (R);
1904
1905       if Present (Op_Id) then
1906          if Ekind (Op_Id) = E_Operator then
1907             Find_Negation_Types (R, Op_Id, N);
1908          else
1909             Add_One_Interp (N, Op_Id, Etype (Op_Id));
1910          end if;
1911
1912       else
1913          Op_Id := Get_Name_Entity_Id (Chars (N));
1914          while Present (Op_Id) loop
1915             if Ekind (Op_Id) = E_Operator then
1916                Find_Negation_Types (R, Op_Id, N);
1917             else
1918                Analyze_User_Defined_Unary_Op (N, Op_Id);
1919             end if;
1920
1921             Op_Id := Homonym (Op_Id);
1922          end loop;
1923       end if;
1924
1925       Operator_Check (N);
1926    end Analyze_Negation;
1927
1928    ------------------
1929    -- Analyze_Null --
1930    ------------------
1931
1932    procedure Analyze_Null (N : Node_Id) is
1933    begin
1934       Set_Etype (N, Any_Access);
1935    end Analyze_Null;
1936
1937    ----------------------
1938    -- Analyze_One_Call --
1939    ----------------------
1940
1941    procedure Analyze_One_Call
1942       (N          : Node_Id;
1943        Nam        : Entity_Id;
1944        Report     : Boolean;
1945        Success    : out Boolean;
1946        Skip_First : Boolean := False)
1947    is
1948       Actuals    : constant List_Id   := Parameter_Associations (N);
1949       Prev_T     : constant Entity_Id := Etype (N);
1950       Formal     : Entity_Id;
1951       Actual     : Node_Id;
1952       Is_Indexed : Boolean := False;
1953       Subp_Type  : constant Entity_Id := Etype (Nam);
1954       Norm_OK    : Boolean;
1955
1956       procedure Indicate_Name_And_Type;
1957       --  If candidate interpretation matches, indicate name and type of
1958       --  result on call node.
1959
1960       ----------------------------
1961       -- Indicate_Name_And_Type --
1962       ----------------------------
1963
1964       procedure Indicate_Name_And_Type is
1965       begin
1966          Add_One_Interp (N, Nam, Etype (Nam));
1967          Success := True;
1968
1969          --  If the prefix of the call is a name, indicate the entity
1970          --  being called. If it is not a name,  it is an expression that
1971          --  denotes an access to subprogram or else an entry or family. In
1972          --  the latter case, the name is a selected component, and the entity
1973          --  being called is noted on the selector.
1974
1975          if not Is_Type (Nam) then
1976             if Is_Entity_Name (Name (N))
1977               or else Nkind (Name (N)) = N_Operator_Symbol
1978             then
1979                Set_Entity (Name (N), Nam);
1980
1981             elsif Nkind (Name (N)) = N_Selected_Component then
1982                Set_Entity (Selector_Name (Name (N)),  Nam);
1983             end if;
1984          end if;
1985
1986          if Debug_Flag_E and not Report then
1987             Write_Str (" Overloaded call ");
1988             Write_Int (Int (N));
1989             Write_Str (" compatible with ");
1990             Write_Int (Int (Nam));
1991             Write_Eol;
1992          end if;
1993       end Indicate_Name_And_Type;
1994
1995    --  Start of processing for Analyze_One_Call
1996
1997    begin
1998       Success := False;
1999
2000       --  If the subprogram has no formals, or if all the formals have
2001       --  defaults, and the return type is an array type, the node may
2002       --  denote an indexing of the result of a parameterless call.
2003
2004       if Needs_No_Actuals (Nam)
2005         and then Present (Actuals)
2006       then
2007          if Is_Array_Type (Subp_Type) then
2008             Is_Indexed := Try_Indexed_Call (N, Nam, Subp_Type);
2009
2010          elsif Is_Access_Type (Subp_Type)
2011            and then Is_Array_Type (Designated_Type (Subp_Type))
2012          then
2013             Is_Indexed :=
2014               Try_Indexed_Call (N, Nam, Designated_Type (Subp_Type));
2015
2016          --  The prefix can also be a parameterless function that returns an
2017          --  access to subprogram. in which case this is an indirect call.
2018
2019          elsif Is_Access_Type (Subp_Type)
2020            and then Ekind (Designated_Type (Subp_Type))  = E_Subprogram_Type
2021          then
2022             Is_Indexed := Try_Indirect_Call (N, Nam, Subp_Type);
2023          end if;
2024
2025       end if;
2026
2027       Normalize_Actuals (N, Nam, (Report and not Is_Indexed), Norm_OK);
2028
2029       if not Norm_OK then
2030
2031          --  Mismatch in number or names of parameters
2032
2033          if Debug_Flag_E then
2034             Write_Str (" normalization fails in call ");
2035             Write_Int (Int (N));
2036             Write_Str (" with subprogram ");
2037             Write_Int (Int (Nam));
2038             Write_Eol;
2039          end if;
2040
2041       --  If the context expects a function call, discard any interpretation
2042       --  that is a procedure. If the node is not overloaded, leave as is for
2043       --  better error reporting when type mismatch is found.
2044
2045       elsif Nkind (N) = N_Function_Call
2046         and then Is_Overloaded (Name (N))
2047         and then Ekind (Nam) = E_Procedure
2048       then
2049          return;
2050
2051       --  Ditto for function calls in a procedure context
2052
2053       elsif Nkind (N) = N_Procedure_Call_Statement
2054          and then Is_Overloaded (Name (N))
2055          and then Etype (Nam) /= Standard_Void_Type
2056       then
2057          return;
2058
2059       elsif No (Actuals) then
2060
2061          --  If Normalize succeeds, then there are default parameters for
2062          --  all formals.
2063
2064          Indicate_Name_And_Type;
2065
2066       elsif Ekind (Nam) = E_Operator then
2067          if Nkind (N) = N_Procedure_Call_Statement then
2068             return;
2069          end if;
2070
2071          --  This can occur when the prefix of the call is an operator
2072          --  name or an expanded name whose selector is an operator name.
2073
2074          Analyze_Operator_Call (N, Nam);
2075
2076          if Etype (N) /= Prev_T then
2077
2078             --  There may be a user-defined operator that hides the
2079             --  current interpretation. We must check for this independently
2080             --  of the analysis of the call with the user-defined operation,
2081             --  because the parameter names may be wrong and yet the hiding
2082             --  takes place. Fixes b34014o.
2083
2084             if Is_Overloaded (Name (N)) then
2085                declare
2086                   I  : Interp_Index;
2087                   It : Interp;
2088
2089                begin
2090                   Get_First_Interp (Name (N), I, It);
2091                   while Present (It.Nam) loop
2092                      if Ekind (It.Nam) /= E_Operator
2093                         and then Hides_Op (It.Nam, Nam)
2094                         and then
2095                           Has_Compatible_Type
2096                             (First_Actual (N), Etype (First_Formal (It.Nam)))
2097                         and then (No (Next_Actual (First_Actual (N)))
2098                            or else Has_Compatible_Type
2099                             (Next_Actual (First_Actual (N)),
2100                              Etype (Next_Formal (First_Formal (It.Nam)))))
2101                      then
2102                         Set_Etype (N, Prev_T);
2103                         return;
2104                      end if;
2105
2106                      Get_Next_Interp (I, It);
2107                   end loop;
2108                end;
2109             end if;
2110
2111             --  If operator matches formals, record its name on the call.
2112             --  If the operator is overloaded, Resolve will select the
2113             --  correct one from the list of interpretations. The call
2114             --  node itself carries the first candidate.
2115
2116             Set_Entity (Name (N), Nam);
2117             Success := True;
2118
2119          elsif Report and then Etype (N) = Any_Type then
2120             Error_Msg_N ("incompatible arguments for operator", N);
2121          end if;
2122
2123       else
2124          --  Normalize_Actuals has chained the named associations in the
2125          --  correct order of the formals.
2126
2127          Actual := First_Actual (N);
2128          Formal := First_Formal (Nam);
2129
2130          --  If we are analyzing a call rewritten from object notation,
2131          --  skip first actual, which may be rewritten later as an
2132          --  explicit dereference.
2133
2134          if Skip_First then
2135             Next_Actual (Actual);
2136             Next_Formal (Formal);
2137          end if;
2138
2139          while Present (Actual) and then Present (Formal) loop
2140             if Nkind (Parent (Actual)) /= N_Parameter_Association
2141               or else Chars (Selector_Name (Parent (Actual))) = Chars (Formal)
2142             then
2143                if Has_Compatible_Type (Actual, Etype (Formal)) then
2144                   Next_Actual (Actual);
2145                   Next_Formal (Formal);
2146
2147                else
2148                   if Debug_Flag_E then
2149                      Write_Str (" type checking fails in call ");
2150                      Write_Int (Int (N));
2151                      Write_Str (" with formal ");
2152                      Write_Int (Int (Formal));
2153                      Write_Str (" in subprogram ");
2154                      Write_Int (Int (Nam));
2155                      Write_Eol;
2156                   end if;
2157
2158                   if Report and not Is_Indexed then
2159
2160                      --  Ada 2005 (AI-251): Complete the error notification
2161                      --  to help new Ada 2005 users
2162
2163                      if Is_Class_Wide_Type (Etype (Formal))
2164                        and then Is_Interface (Etype (Etype (Formal)))
2165                        and then not Interface_Present_In_Ancestor
2166                                       (Typ   => Etype (Actual),
2167                                        Iface => Etype (Etype (Formal)))
2168                      then
2169                         Error_Msg_NE
2170                           ("(Ada 2005) does not implement interface }",
2171                            Actual, Etype (Etype (Formal)));
2172                      end if;
2173
2174                      Wrong_Type (Actual, Etype (Formal));
2175
2176                      if Nkind (Actual) = N_Op_Eq
2177                        and then Nkind (Left_Opnd (Actual)) = N_Identifier
2178                      then
2179                         Formal := First_Formal (Nam);
2180                         while Present (Formal) loop
2181                            if Chars (Left_Opnd (Actual)) = Chars (Formal) then
2182                               Error_Msg_N
2183                                 ("possible misspelling of `='>`!", Actual);
2184                               exit;
2185                            end if;
2186
2187                            Next_Formal (Formal);
2188                         end loop;
2189                      end if;
2190
2191                      if All_Errors_Mode then
2192                         Error_Msg_Sloc := Sloc (Nam);
2193
2194                         if Is_Overloadable (Nam)
2195                           and then Present (Alias (Nam))
2196                           and then not Comes_From_Source (Nam)
2197                         then
2198                            Error_Msg_NE
2199                              ("  =='> in call to &#(inherited)!", Actual, Nam);
2200
2201                         elsif Ekind (Nam) = E_Subprogram_Type then
2202                            declare
2203                               Access_To_Subprogram_Typ :
2204                                 constant Entity_Id :=
2205                                   Defining_Identifier
2206                                     (Associated_Node_For_Itype (Nam));
2207                            begin
2208                               Error_Msg_NE (
2209                                 "  =='> in call to dereference of &#!",
2210                                 Actual, Access_To_Subprogram_Typ);
2211                            end;
2212
2213                         else
2214                            Error_Msg_NE ("  =='> in call to &#!", Actual, Nam);
2215
2216                         end if;
2217                      end if;
2218                   end if;
2219
2220                   return;
2221                end if;
2222
2223             else
2224                --  Normalize_Actuals has verified that a default value exists
2225                --  for this formal. Current actual names a subsequent formal.
2226
2227                Next_Formal (Formal);
2228             end if;
2229          end loop;
2230
2231          --  On exit, all actuals match
2232
2233          Indicate_Name_And_Type;
2234       end if;
2235    end Analyze_One_Call;
2236
2237    ---------------------------
2238    -- Analyze_Operator_Call --
2239    ---------------------------
2240
2241    procedure Analyze_Operator_Call (N : Node_Id; Op_Id : Entity_Id) is
2242       Op_Name : constant Name_Id := Chars (Op_Id);
2243       Act1    : constant Node_Id := First_Actual (N);
2244       Act2    : constant Node_Id := Next_Actual (Act1);
2245
2246    begin
2247       --  Binary operator case
2248
2249       if Present (Act2) then
2250
2251          --  If more than two operands, then not binary operator after all
2252
2253          if Present (Next_Actual (Act2)) then
2254             return;
2255
2256          elsif     Op_Name = Name_Op_Add
2257            or else Op_Name = Name_Op_Subtract
2258            or else Op_Name = Name_Op_Multiply
2259            or else Op_Name = Name_Op_Divide
2260            or else Op_Name = Name_Op_Mod
2261            or else Op_Name = Name_Op_Rem
2262            or else Op_Name = Name_Op_Expon
2263          then
2264             Find_Arithmetic_Types (Act1, Act2, Op_Id, N);
2265
2266          elsif     Op_Name =  Name_Op_And
2267            or else Op_Name = Name_Op_Or
2268            or else Op_Name = Name_Op_Xor
2269          then
2270             Find_Boolean_Types (Act1, Act2, Op_Id, N);
2271
2272          elsif     Op_Name = Name_Op_Lt
2273            or else Op_Name = Name_Op_Le
2274            or else Op_Name = Name_Op_Gt
2275            or else Op_Name = Name_Op_Ge
2276          then
2277             Find_Comparison_Types (Act1, Act2, Op_Id,  N);
2278
2279          elsif     Op_Name = Name_Op_Eq
2280            or else Op_Name = Name_Op_Ne
2281          then
2282             Find_Equality_Types (Act1, Act2, Op_Id,  N);
2283
2284          elsif     Op_Name = Name_Op_Concat then
2285             Find_Concatenation_Types (Act1, Act2, Op_Id, N);
2286
2287          --  Is this else null correct, or should it be an abort???
2288
2289          else
2290             null;
2291          end if;
2292
2293       --  Unary operator case
2294
2295       else
2296          if Op_Name = Name_Op_Subtract or else
2297             Op_Name = Name_Op_Add      or else
2298             Op_Name = Name_Op_Abs
2299          then
2300             Find_Unary_Types (Act1, Op_Id, N);
2301
2302          elsif
2303             Op_Name = Name_Op_Not
2304          then
2305             Find_Negation_Types (Act1, Op_Id, N);
2306
2307          --  Is this else null correct, or should it be an abort???
2308
2309          else
2310             null;
2311          end if;
2312       end if;
2313    end Analyze_Operator_Call;
2314
2315    -------------------------------------------
2316    -- Analyze_Overloaded_Selected_Component --
2317    -------------------------------------------
2318
2319    procedure Analyze_Overloaded_Selected_Component (N : Node_Id) is
2320       Nam   : constant Node_Id := Prefix (N);
2321       Sel   : constant Node_Id := Selector_Name (N);
2322       Comp  : Entity_Id;
2323       I     : Interp_Index;
2324       It    : Interp;
2325       T     : Entity_Id;
2326
2327    begin
2328       Set_Etype (Sel, Any_Type);
2329
2330       Get_First_Interp (Nam, I, It);
2331       while Present (It.Typ) loop
2332          if Is_Access_Type (It.Typ) then
2333             T := Designated_Type (It.Typ);
2334             Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
2335          else
2336             T := It.Typ;
2337          end if;
2338
2339          if Is_Record_Type (T) then
2340             Comp := First_Entity (T);
2341             while Present (Comp) loop
2342                if Chars (Comp) = Chars (Sel)
2343                  and then Is_Visible_Component (Comp)
2344                then
2345                   Set_Entity (Sel, Comp);
2346                   Set_Etype (Sel, Etype (Comp));
2347                   Add_One_Interp (N, Etype (Comp), Etype (Comp));
2348
2349                   --  This also specifies a candidate to resolve the name.
2350                   --  Further overloading will be resolved from context.
2351
2352                   Set_Etype (Nam, It.Typ);
2353                end if;
2354
2355                Next_Entity (Comp);
2356             end loop;
2357
2358          elsif Is_Concurrent_Type (T) then
2359             Comp := First_Entity (T);
2360             while Present (Comp)
2361               and then Comp /= First_Private_Entity (T)
2362             loop
2363                if Chars (Comp) = Chars (Sel) then
2364                   if Is_Overloadable (Comp) then
2365                      Add_One_Interp (Sel, Comp, Etype (Comp));
2366                   else
2367                      Set_Entity_With_Style_Check (Sel, Comp);
2368                      Generate_Reference (Comp, Sel);
2369                   end if;
2370
2371                   Set_Etype (Sel, Etype (Comp));
2372                   Set_Etype (N,   Etype (Comp));
2373                   Set_Etype (Nam, It.Typ);
2374
2375                   --  For access type case, introduce explicit deference for
2376                   --  more uniform treatment of entry calls.
2377
2378                   if Is_Access_Type (Etype (Nam)) then
2379                      Insert_Explicit_Dereference (Nam);
2380                      Error_Msg_NW
2381                        (Warn_On_Dereference, "?implicit dereference", N);
2382                   end if;
2383                end if;
2384
2385                Next_Entity (Comp);
2386             end loop;
2387
2388             Set_Is_Overloaded (N, Is_Overloaded (Sel));
2389          end if;
2390
2391          Get_Next_Interp (I, It);
2392       end loop;
2393
2394       if Etype (N) = Any_Type then
2395          Error_Msg_NE ("undefined selector& for overloaded prefix", N, Sel);
2396          Set_Entity (Sel, Any_Id);
2397          Set_Etype  (Sel, Any_Type);
2398       end if;
2399    end Analyze_Overloaded_Selected_Component;
2400
2401    ----------------------------------
2402    -- Analyze_Qualified_Expression --
2403    ----------------------------------
2404
2405    procedure Analyze_Qualified_Expression (N : Node_Id) is
2406       Mark : constant Entity_Id := Subtype_Mark (N);
2407       T    : Entity_Id;
2408
2409    begin
2410       Set_Etype (N, Any_Type);
2411       Find_Type (Mark);
2412       T := Entity (Mark);
2413
2414       if T = Any_Type then
2415          return;
2416       end if;
2417
2418       Check_Fully_Declared (T, N);
2419       Analyze_Expression (Expression (N));
2420       Set_Etype  (N, T);
2421    end Analyze_Qualified_Expression;
2422
2423    -------------------
2424    -- Analyze_Range --
2425    -------------------
2426
2427    procedure Analyze_Range (N : Node_Id) is
2428       L        : constant Node_Id := Low_Bound (N);
2429       H        : constant Node_Id := High_Bound (N);
2430       I1, I2   : Interp_Index;
2431       It1, It2 : Interp;
2432
2433       procedure Check_Common_Type (T1, T2 : Entity_Id);
2434       --  Verify the compatibility of two types,  and choose the
2435       --  non universal one if the other is universal.
2436
2437       procedure Check_High_Bound (T : Entity_Id);
2438       --  Test one interpretation of the low bound against all those
2439       --  of the high bound.
2440
2441       procedure Check_Universal_Expression (N : Node_Id);
2442       --  In Ada83, reject bounds of a universal range that are not
2443       --  literals or entity names.
2444
2445       -----------------------
2446       -- Check_Common_Type --
2447       -----------------------
2448
2449       procedure Check_Common_Type (T1, T2 : Entity_Id) is
2450       begin
2451          if Covers (T1, T2) or else Covers (T2, T1) then
2452             if T1 = Universal_Integer
2453               or else T1 = Universal_Real
2454               or else T1 = Any_Character
2455             then
2456                Add_One_Interp (N, Base_Type (T2), Base_Type (T2));
2457
2458             elsif T1 = T2 then
2459                Add_One_Interp (N, T1, T1);
2460
2461             else
2462                Add_One_Interp (N, Base_Type (T1), Base_Type (T1));
2463             end if;
2464          end if;
2465       end Check_Common_Type;
2466
2467       ----------------------
2468       -- Check_High_Bound --
2469       ----------------------
2470
2471       procedure Check_High_Bound (T : Entity_Id) is
2472       begin
2473          if not Is_Overloaded (H) then
2474             Check_Common_Type (T, Etype (H));
2475          else
2476             Get_First_Interp (H, I2, It2);
2477             while Present (It2.Typ) loop
2478                Check_Common_Type (T, It2.Typ);
2479                Get_Next_Interp (I2, It2);
2480             end loop;
2481          end if;
2482       end Check_High_Bound;
2483
2484       -----------------------------
2485       -- Is_Universal_Expression --
2486       -----------------------------
2487
2488       procedure Check_Universal_Expression (N : Node_Id) is
2489       begin
2490          if Etype (N) = Universal_Integer
2491            and then Nkind (N) /= N_Integer_Literal
2492            and then not Is_Entity_Name (N)
2493            and then Nkind (N) /= N_Attribute_Reference
2494          then
2495             Error_Msg_N ("illegal bound in discrete range", N);
2496          end if;
2497       end Check_Universal_Expression;
2498
2499    --  Start of processing for Analyze_Range
2500
2501    begin
2502       Set_Etype (N, Any_Type);
2503       Analyze_Expression (L);
2504       Analyze_Expression (H);
2505
2506       if Etype (L) = Any_Type or else Etype (H) = Any_Type then
2507          return;
2508
2509       else
2510          if not Is_Overloaded (L) then
2511             Check_High_Bound (Etype (L));
2512          else
2513             Get_First_Interp (L, I1, It1);
2514             while Present (It1.Typ) loop
2515                Check_High_Bound (It1.Typ);
2516                Get_Next_Interp (I1, It1);
2517             end loop;
2518          end if;
2519
2520          --  If result is Any_Type, then we did not find a compatible pair
2521
2522          if Etype (N) = Any_Type then
2523             Error_Msg_N ("incompatible types in range ", N);
2524          end if;
2525       end if;
2526
2527       if Ada_Version = Ada_83
2528         and then
2529           (Nkind (Parent (N)) = N_Loop_Parameter_Specification
2530              or else Nkind (Parent (N)) = N_Constrained_Array_Definition)
2531       then
2532          Check_Universal_Expression (L);
2533          Check_Universal_Expression (H);
2534       end if;
2535    end Analyze_Range;
2536
2537    -----------------------
2538    -- Analyze_Reference --
2539    -----------------------
2540
2541    procedure Analyze_Reference (N : Node_Id) is
2542       P        : constant Node_Id := Prefix (N);
2543       Acc_Type : Entity_Id;
2544    begin
2545       Analyze (P);
2546       Acc_Type := Create_Itype (E_Allocator_Type, N);
2547       Set_Etype                    (Acc_Type,  Acc_Type);
2548       Init_Size_Align              (Acc_Type);
2549       Set_Directly_Designated_Type (Acc_Type, Etype (P));
2550       Set_Etype (N, Acc_Type);
2551    end Analyze_Reference;
2552
2553    --------------------------------
2554    -- Analyze_Selected_Component --
2555    --------------------------------
2556
2557    --  Prefix is a record type or a task or protected type. In the
2558    --  later case, the selector must denote a visible entry.
2559
2560    procedure Analyze_Selected_Component (N : Node_Id) is
2561       Name        : constant Node_Id := Prefix (N);
2562       Sel         : constant Node_Id := Selector_Name (N);
2563       Comp        : Entity_Id;
2564       Entity_List : Entity_Id;
2565       Prefix_Type : Entity_Id;
2566       Pent        : Entity_Id := Empty;
2567       Act_Decl    : Node_Id;
2568       In_Scope    : Boolean;
2569       Parent_N    : Node_Id;
2570
2571    --  Start of processing for Analyze_Selected_Component
2572
2573    begin
2574       Set_Etype (N, Any_Type);
2575
2576       if Is_Overloaded (Name) then
2577          Analyze_Overloaded_Selected_Component (N);
2578          return;
2579
2580       elsif Etype (Name) = Any_Type then
2581          Set_Entity (Sel, Any_Id);
2582          Set_Etype (Sel, Any_Type);
2583          return;
2584
2585       else
2586          Prefix_Type := Etype (Name);
2587       end if;
2588
2589       if Is_Access_Type (Prefix_Type) then
2590
2591          --  A RACW object can never be used as prefix of a selected
2592          --  component since that means it is dereferenced without
2593          --  being a controlling operand of a dispatching operation
2594          --  (RM E.2.2(15)).
2595
2596          if Is_Remote_Access_To_Class_Wide_Type (Prefix_Type)
2597            and then Comes_From_Source (N)
2598          then
2599             Error_Msg_N
2600               ("invalid dereference of a remote access to class-wide value",
2601                N);
2602
2603          --  Normal case of selected component applied to access type
2604
2605          else
2606             Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
2607
2608             if Is_Entity_Name (Name) then
2609                Pent := Entity (Name);
2610             elsif Nkind (Name) = N_Selected_Component
2611               and then Is_Entity_Name (Selector_Name (Name))
2612             then
2613                Pent := Entity (Selector_Name (Name));
2614             end if;
2615
2616             Process_Implicit_Dereference_Prefix (Pent, Name);
2617          end if;
2618
2619          Prefix_Type := Designated_Type (Prefix_Type);
2620
2621          --  (Ada 2005): if the prefix is the limited view of a type, and
2622          --  the context already includes the full view, use the full view
2623          --  in what follows, either to retrieve a component of to find
2624          --  a primitive operation.
2625
2626          if Is_Incomplete_Type (Prefix_Type)
2627            and then From_With_Type (Prefix_Type)
2628            and then Present (Non_Limited_View (Prefix_Type))
2629          then
2630             Prefix_Type := Non_Limited_View (Prefix_Type);
2631          end if;
2632       end if;
2633
2634       if Ekind (Prefix_Type) = E_Private_Subtype then
2635          Prefix_Type := Base_Type (Prefix_Type);
2636       end if;
2637
2638       Entity_List := Prefix_Type;
2639
2640       --  For class-wide types, use the entity list of the root type. This
2641       --  indirection is specially important for private extensions because
2642       --  only the root type get switched (not the class-wide type).
2643
2644       if Is_Class_Wide_Type (Prefix_Type) then
2645          Entity_List := Root_Type (Prefix_Type);
2646       end if;
2647
2648       Comp := First_Entity (Entity_List);
2649
2650       --  If the selector has an original discriminant, the node appears in
2651       --  an instance. Replace the discriminant with the corresponding one
2652       --  in the current discriminated type. For nested generics, this must
2653       --  be done transitively, so note the new original discriminant.
2654
2655       if Nkind (Sel) = N_Identifier
2656         and then Present (Original_Discriminant (Sel))
2657       then
2658          Comp := Find_Corresponding_Discriminant (Sel, Prefix_Type);
2659
2660          --  Mark entity before rewriting, for completeness and because
2661          --  subsequent semantic checks might examine the original node.
2662
2663          Set_Entity (Sel, Comp);
2664          Rewrite (Selector_Name (N),
2665            New_Occurrence_Of (Comp, Sloc (N)));
2666          Set_Original_Discriminant (Selector_Name (N), Comp);
2667          Set_Etype (N, Etype (Comp));
2668
2669          if Is_Access_Type (Etype (Name)) then
2670             Insert_Explicit_Dereference (Name);
2671             Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
2672          end if;
2673
2674       elsif Is_Record_Type (Prefix_Type) then
2675
2676          --  Find component with given name
2677
2678          while Present (Comp) loop
2679             if Chars (Comp) = Chars (Sel)
2680               and then Is_Visible_Component (Comp)
2681             then
2682                Set_Entity_With_Style_Check (Sel, Comp);
2683                Set_Etype (Sel, Etype (Comp));
2684
2685                if Ekind (Comp) = E_Discriminant then
2686                   if Is_Unchecked_Union (Base_Type (Prefix_Type)) then
2687                      Error_Msg_N
2688                        ("cannot reference discriminant of Unchecked_Union",
2689                         Sel);
2690                   end if;
2691
2692                   if Is_Generic_Type (Prefix_Type)
2693                        or else
2694                      Is_Generic_Type (Root_Type (Prefix_Type))
2695                   then
2696                      Set_Original_Discriminant (Sel, Comp);
2697                   end if;
2698                end if;
2699
2700                --  Resolve the prefix early otherwise it is not possible to
2701                --  build the actual subtype of the component: it may need
2702                --  to duplicate this prefix and duplication is only allowed
2703                --  on fully resolved expressions.
2704
2705                Resolve (Name);
2706
2707                --  Ada 2005 (AI-50217): Check wrong use of incomplete types or
2708                --  subtypes in a package specification.
2709                --  Example:
2710
2711                --    limited with Pkg;
2712                --    package Pkg is
2713                --       type Acc_Inc is access Pkg.T;
2714                --       X : Acc_Inc;
2715                --       N : Natural := X.all.Comp;  --  ERROR, limited view
2716                --    end Pkg;                       --  Comp is not visible
2717
2718                if Nkind (Name) = N_Explicit_Dereference
2719                  and then From_With_Type (Etype (Prefix (Name)))
2720                  and then not Is_Potentially_Use_Visible (Etype (Name))
2721                  and then Nkind (Parent (Cunit_Entity (Current_Sem_Unit))) =
2722                             N_Package_Specification
2723                then
2724                   Error_Msg_NE
2725                     ("premature usage of incomplete}", Prefix (Name),
2726                      Etype (Prefix (Name)));
2727                end if;
2728
2729                --  We never need an actual subtype for the case of a selection
2730                --  for a indexed component of a non-packed array, since in
2731                --  this case gigi generates all the checks and can find the
2732                --  necessary bounds information.
2733
2734                --  We also do not need an actual subtype for the case of
2735                --  a first, last, length, or range attribute applied to a
2736                --  non-packed array, since gigi can again get the bounds in
2737                --  these cases (gigi cannot handle the packed case, since it
2738                --  has the bounds of the packed array type, not the original
2739                --  bounds of the type). However, if the prefix is itself a
2740                --  selected component, as in a.b.c (i), gigi may regard a.b.c
2741                --  as a dynamic-sized temporary, so we do generate an actual
2742                --  subtype for this case.
2743
2744                Parent_N := Parent (N);
2745
2746                if not Is_Packed (Etype (Comp))
2747                  and then
2748                    ((Nkind (Parent_N) = N_Indexed_Component
2749                       and then Nkind (Name) /= N_Selected_Component)
2750                      or else
2751                       (Nkind (Parent_N) = N_Attribute_Reference
2752                          and then (Attribute_Name (Parent_N) = Name_First
2753                                      or else
2754                                    Attribute_Name (Parent_N) = Name_Last
2755                                      or else
2756                                    Attribute_Name (Parent_N) = Name_Length
2757                                      or else
2758                                    Attribute_Name (Parent_N) = Name_Range)))
2759                then
2760                   Set_Etype (N, Etype (Comp));
2761
2762                --  If full analysis is not enabled, we do not generate an
2763                --  actual subtype, because in the absence of expansion
2764                --  reference to a formal of a protected type, for example,
2765                --  will not be properly transformed, and will lead to
2766                --  out-of-scope references in gigi.
2767
2768                --  In all other cases, we currently build an actual subtype.
2769                --  It seems likely that many of these cases can be avoided,
2770                --  but right now, the front end makes direct references to the
2771                --  bounds (e.g. in generating a length check), and if we do
2772                --  not make an actual subtype, we end up getting a direct
2773                --  reference to a discriminant, which will not do.
2774
2775                elsif Full_Analysis then
2776                   Act_Decl :=
2777                     Build_Actual_Subtype_Of_Component (Etype (Comp), N);
2778                   Insert_Action (N, Act_Decl);
2779
2780                   if No (Act_Decl) then
2781                      Set_Etype (N, Etype (Comp));
2782
2783                   else
2784                      --  Component type depends on discriminants. Enter the
2785                      --  main attributes of the subtype.
2786
2787                      declare
2788                         Subt : constant Entity_Id :=
2789                                  Defining_Identifier (Act_Decl);
2790
2791                      begin
2792                         Set_Etype (Subt, Base_Type (Etype (Comp)));
2793                         Set_Ekind (Subt, Ekind (Etype (Comp)));
2794                         Set_Etype (N, Subt);
2795                      end;
2796                   end if;
2797
2798                --  If Full_Analysis not enabled, just set the Etype
2799
2800                else
2801                   Set_Etype (N, Etype (Comp));
2802                end if;
2803
2804                return;
2805             end if;
2806
2807             Next_Entity (Comp);
2808          end loop;
2809
2810          --  Ada 2005 (AI-252)
2811
2812          if Ada_Version >= Ada_05
2813            and then Is_Tagged_Type (Prefix_Type)
2814            and then Try_Object_Operation (N)
2815          then
2816             return;
2817
2818             --  If the transformation fails, it will be necessary to redo the
2819             --  analysis with all errors enabled, to indicate candidate
2820             --  interpretations and reasons for each failure ???
2821
2822          end if;
2823
2824       elsif Is_Private_Type (Prefix_Type) then
2825
2826          --  Allow access only to discriminants of the type. If the type has
2827          --  no full view, gigi uses the parent type for the components, so we
2828          --  do the same here.
2829
2830          if No (Full_View (Prefix_Type)) then
2831             Entity_List := Root_Type (Base_Type (Prefix_Type));
2832             Comp := First_Entity (Entity_List);
2833          end if;
2834
2835          while Present (Comp) loop
2836             if Chars (Comp) = Chars (Sel) then
2837                if Ekind (Comp) = E_Discriminant then
2838                   Set_Entity_With_Style_Check (Sel, Comp);
2839                   Generate_Reference (Comp, Sel);
2840
2841                   Set_Etype (Sel, Etype (Comp));
2842                   Set_Etype (N,   Etype (Comp));
2843
2844                   if Is_Generic_Type (Prefix_Type)
2845                     or else
2846                      Is_Generic_Type (Root_Type (Prefix_Type))
2847                   then
2848                      Set_Original_Discriminant (Sel, Comp);
2849                   end if;
2850
2851                else
2852                   Error_Msg_NE
2853                     ("invisible selector for }",
2854                      N, First_Subtype (Prefix_Type));
2855                   Set_Entity (Sel, Any_Id);
2856                   Set_Etype (N, Any_Type);
2857                end if;
2858
2859                return;
2860             end if;
2861
2862             Next_Entity (Comp);
2863          end loop;
2864
2865       elsif Is_Concurrent_Type (Prefix_Type) then
2866
2867          --  Prefix is concurrent type. Find visible operation with given name
2868          --  For a task, this can only include entries or discriminants if the
2869          --  task type is not an enclosing scope. If it is an enclosing scope
2870          --  (e.g. in an inner task) then all entities are visible, but the
2871          --  prefix must denote the enclosing scope, i.e. can only be a direct
2872          --  name or an expanded name.
2873
2874          Set_Etype (Sel,  Any_Type);
2875          In_Scope := In_Open_Scopes (Prefix_Type);
2876
2877          while Present (Comp) loop
2878             if Chars (Comp) = Chars (Sel) then
2879                if Is_Overloadable (Comp) then
2880                   Add_One_Interp (Sel, Comp, Etype (Comp));
2881
2882                elsif Ekind (Comp) = E_Discriminant
2883                  or else Ekind (Comp) = E_Entry_Family
2884                  or else (In_Scope
2885                    and then Is_Entity_Name (Name))
2886                then
2887                   Set_Entity_With_Style_Check (Sel, Comp);
2888                   Generate_Reference (Comp, Sel);
2889
2890                else
2891                   goto Next_Comp;
2892                end if;
2893
2894                Set_Etype (Sel, Etype (Comp));
2895                Set_Etype (N,   Etype (Comp));
2896
2897                if Ekind (Comp) = E_Discriminant then
2898                   Set_Original_Discriminant (Sel, Comp);
2899                end if;
2900
2901                --  For access type case, introduce explicit deference for more
2902                --  uniform treatment of entry calls.
2903
2904                if Is_Access_Type (Etype (Name)) then
2905                   Insert_Explicit_Dereference (Name);
2906                   Error_Msg_NW
2907                     (Warn_On_Dereference, "?implicit dereference", N);
2908                end if;
2909             end if;
2910
2911             <<Next_Comp>>
2912                Next_Entity (Comp);
2913                exit when not In_Scope
2914                  and then
2915                    Comp = First_Private_Entity (Base_Type (Prefix_Type));
2916          end loop;
2917
2918          Set_Is_Overloaded (N, Is_Overloaded (Sel));
2919
2920       else
2921          --  Invalid prefix
2922
2923          Error_Msg_NE ("invalid prefix in selected component&", N, Sel);
2924       end if;
2925
2926       --  If N still has no type, the component is not defined in the prefix
2927
2928       if Etype (N) = Any_Type then
2929
2930          --  If the prefix is a single concurrent object, use its name in the
2931          --  error message, rather than that of its anonymous type.
2932
2933          if Is_Concurrent_Type (Prefix_Type)
2934            and then Is_Internal_Name (Chars (Prefix_Type))
2935            and then not Is_Derived_Type (Prefix_Type)
2936            and then Is_Entity_Name (Name)
2937          then
2938
2939             Error_Msg_Node_2 := Entity (Name);
2940             Error_Msg_NE ("no selector& for&", N, Sel);
2941
2942             Check_Misspelled_Selector (Entity_List, Sel);
2943
2944          elsif Is_Generic_Type (Prefix_Type)
2945            and then Ekind (Prefix_Type) = E_Record_Type_With_Private
2946            and then Prefix_Type /= Etype (Prefix_Type)
2947            and then Is_Record_Type (Etype (Prefix_Type))
2948          then
2949             --  If this is a derived formal type, the parent may have
2950             --  different visibility at this point. Try for an inherited
2951             --  component before reporting an error.
2952
2953             Set_Etype (Prefix (N), Etype (Prefix_Type));
2954             Analyze_Selected_Component (N);
2955             return;
2956
2957          elsif Ekind (Prefix_Type) = E_Record_Subtype_With_Private
2958            and then Is_Generic_Actual_Type (Prefix_Type)
2959            and then Present (Full_View (Prefix_Type))
2960          then
2961             --  Similarly, if this the actual for a formal derived type, the
2962             --  component inherited from the generic parent may not be visible
2963             --  in the actual, but the selected component is legal.
2964
2965             declare
2966                Comp : Entity_Id;
2967
2968             begin
2969                Comp :=
2970                  First_Component (Generic_Parent_Type (Parent (Prefix_Type)));
2971                while Present (Comp) loop
2972                   if Chars (Comp) = Chars (Sel) then
2973                      Set_Entity_With_Style_Check (Sel, Comp);
2974                      Set_Etype (Sel, Etype (Comp));
2975                      Set_Etype (N,   Etype (Comp));
2976                      return;
2977                   end if;
2978
2979                   Next_Component (Comp);
2980                end loop;
2981
2982                pragma Assert (Etype (N) /= Any_Type);
2983             end;
2984
2985          else
2986             if Ekind (Prefix_Type) = E_Record_Subtype then
2987
2988                --  Check whether this is a component of the base type
2989                --  which is absent from a statically constrained subtype.
2990                --  This will raise constraint error at run-time, but is
2991                --  not a compile-time error. When the selector is illegal
2992                --  for base type as well fall through and generate a
2993                --  compilation error anyway.
2994
2995                Comp := First_Component (Base_Type (Prefix_Type));
2996                while Present (Comp) loop
2997                   if Chars (Comp) = Chars (Sel)
2998                     and then Is_Visible_Component (Comp)
2999                   then
3000                      Set_Entity_With_Style_Check (Sel, Comp);
3001                      Generate_Reference (Comp, Sel);
3002                      Set_Etype (Sel, Etype (Comp));
3003                      Set_Etype (N,   Etype (Comp));
3004
3005                      --  Emit appropriate message. Gigi will replace the
3006                      --  node subsequently with the appropriate Raise.
3007
3008                      Apply_Compile_Time_Constraint_Error
3009                        (N, "component not present in }?",
3010                         CE_Discriminant_Check_Failed,
3011                         Ent => Prefix_Type, Rep => False);
3012                      Set_Raises_Constraint_Error (N);
3013                      return;
3014                   end if;
3015
3016                   Next_Component (Comp);
3017                end loop;
3018
3019             end if;
3020
3021             Error_Msg_Node_2 := First_Subtype (Prefix_Type);
3022             Error_Msg_NE ("no selector& for}", N, Sel);
3023
3024             Check_Misspelled_Selector (Entity_List, Sel);
3025
3026          end if;
3027
3028          Set_Entity (Sel, Any_Id);
3029          Set_Etype (Sel, Any_Type);
3030       end if;
3031    end Analyze_Selected_Component;
3032
3033    ---------------------------
3034    -- Analyze_Short_Circuit --
3035    ---------------------------
3036
3037    procedure Analyze_Short_Circuit (N : Node_Id) is
3038       L   : constant Node_Id := Left_Opnd  (N);
3039       R   : constant Node_Id := Right_Opnd (N);
3040       Ind : Interp_Index;
3041       It  : Interp;
3042
3043    begin
3044       Analyze_Expression (L);
3045       Analyze_Expression (R);
3046       Set_Etype (N, Any_Type);
3047
3048       if not Is_Overloaded (L) then
3049
3050          if Root_Type (Etype (L)) = Standard_Boolean
3051            and then Has_Compatible_Type (R, Etype (L))
3052          then
3053             Add_One_Interp (N, Etype (L), Etype (L));
3054          end if;
3055
3056       else
3057          Get_First_Interp (L, Ind, It);
3058          while Present (It.Typ) loop
3059             if Root_Type (It.Typ) = Standard_Boolean
3060               and then Has_Compatible_Type (R, It.Typ)
3061             then
3062                Add_One_Interp (N, It.Typ, It.Typ);
3063             end if;
3064
3065             Get_Next_Interp (Ind, It);
3066          end loop;
3067       end if;
3068
3069       --  Here we have failed to find an interpretation. Clearly we
3070       --  know that it is not the case that both operands can have
3071       --  an interpretation of Boolean, but this is by far the most
3072       --  likely intended interpretation. So we simply resolve both
3073       --  operands as Booleans, and at least one of these resolutions
3074       --  will generate an error message, and we do not need to give
3075       --  a further error message on the short circuit operation itself.
3076
3077       if Etype (N) = Any_Type then
3078          Resolve (L, Standard_Boolean);
3079          Resolve (R, Standard_Boolean);
3080          Set_Etype (N, Standard_Boolean);
3081       end if;
3082    end Analyze_Short_Circuit;
3083
3084    -------------------
3085    -- Analyze_Slice --
3086    -------------------
3087
3088    procedure Analyze_Slice (N : Node_Id) is
3089       P          : constant Node_Id := Prefix (N);
3090       D          : constant Node_Id := Discrete_Range (N);
3091       Array_Type : Entity_Id;
3092
3093       procedure Analyze_Overloaded_Slice;
3094       --  If the prefix is overloaded, select those interpretations that
3095       --  yield a one-dimensional array type.
3096
3097       ------------------------------
3098       -- Analyze_Overloaded_Slice --
3099       ------------------------------
3100
3101       procedure Analyze_Overloaded_Slice is
3102          I   : Interp_Index;
3103          It  : Interp;
3104          Typ : Entity_Id;
3105
3106       begin
3107          Set_Etype (N, Any_Type);
3108
3109          Get_First_Interp (P, I, It);
3110          while Present (It.Nam) loop
3111             Typ := It.Typ;
3112
3113             if Is_Access_Type (Typ) then
3114                Typ := Designated_Type (Typ);
3115                Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
3116             end if;
3117
3118             if Is_Array_Type (Typ)
3119               and then Number_Dimensions (Typ) = 1
3120               and then Has_Compatible_Type (D, Etype (First_Index (Typ)))
3121             then
3122                Add_One_Interp (N, Typ, Typ);
3123             end if;
3124
3125             Get_Next_Interp (I, It);
3126          end loop;
3127
3128          if Etype (N) = Any_Type then
3129             Error_Msg_N ("expect array type in prefix of slice",  N);
3130          end if;
3131       end Analyze_Overloaded_Slice;
3132
3133    --  Start of processing for Analyze_Slice
3134
3135    begin
3136       Analyze (P);
3137       Analyze (D);
3138
3139       if Is_Overloaded (P) then
3140          Analyze_Overloaded_Slice;
3141
3142       else
3143          Array_Type := Etype (P);
3144          Set_Etype (N, Any_Type);
3145
3146          if Is_Access_Type (Array_Type) then
3147             Array_Type := Designated_Type (Array_Type);
3148             Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
3149          end if;
3150
3151          if not Is_Array_Type (Array_Type) then
3152             Wrong_Type (P, Any_Array);
3153
3154          elsif Number_Dimensions (Array_Type) > 1 then
3155             Error_Msg_N
3156               ("type is not one-dimensional array in slice prefix", N);
3157
3158          elsif not
3159            Has_Compatible_Type (D, Etype (First_Index (Array_Type)))
3160          then
3161             Wrong_Type (D, Etype (First_Index (Array_Type)));
3162
3163          else
3164             Set_Etype (N, Array_Type);
3165          end if;
3166       end if;
3167    end Analyze_Slice;
3168
3169    -----------------------------
3170    -- Analyze_Type_Conversion --
3171    -----------------------------
3172
3173    procedure Analyze_Type_Conversion (N : Node_Id) is
3174       Expr : constant Node_Id := Expression (N);
3175       T    : Entity_Id;
3176
3177    begin
3178       --  If Conversion_OK is set, then the Etype is already set, and the
3179       --  only processing required is to analyze the expression. This is
3180       --  used to construct certain "illegal" conversions which are not
3181       --  allowed by Ada semantics, but can be handled OK by Gigi, see
3182       --  Sinfo for further details.
3183
3184       if Conversion_OK (N) then
3185          Analyze (Expr);
3186          return;
3187       end if;
3188
3189       --  Otherwise full type analysis is required, as well as some semantic
3190       --  checks to make sure the argument of the conversion is appropriate.
3191
3192       Find_Type (Subtype_Mark (N));
3193       T := Entity (Subtype_Mark (N));
3194       Set_Etype (N, T);
3195       Check_Fully_Declared (T, N);
3196       Analyze_Expression (Expr);
3197       Validate_Remote_Type_Type_Conversion (N);
3198
3199       --  Only remaining step is validity checks on the argument. These
3200       --  are skipped if the conversion does not come from the source.
3201
3202       if not Comes_From_Source (N) then
3203          return;
3204
3205       --  If there was an error in a generic unit, no need to replicate the
3206       --  error message. Conversely, constant-folding in the generic may
3207       --  transform the argument of a conversion into a string literal, which
3208       --  is legal. Therefore the following tests are not performed in an
3209       --  instance.
3210
3211       elsif In_Instance then
3212          return;
3213
3214       elsif Nkind (Expr) = N_Null then
3215          Error_Msg_N ("argument of conversion cannot be null", N);
3216          Error_Msg_N ("\use qualified expression instead", N);
3217          Set_Etype (N, Any_Type);
3218
3219       elsif Nkind (Expr) = N_Aggregate then
3220          Error_Msg_N ("argument of conversion cannot be aggregate", N);
3221          Error_Msg_N ("\use qualified expression instead", N);
3222
3223       elsif Nkind (Expr) = N_Allocator then
3224          Error_Msg_N ("argument of conversion cannot be an allocator", N);
3225          Error_Msg_N ("\use qualified expression instead", N);
3226
3227       elsif Nkind (Expr) = N_String_Literal then
3228          Error_Msg_N ("argument of conversion cannot be string literal", N);
3229          Error_Msg_N ("\use qualified expression instead", N);
3230
3231       elsif Nkind (Expr) = N_Character_Literal then
3232          if Ada_Version = Ada_83 then
3233             Resolve (Expr, T);
3234          else
3235             Error_Msg_N ("argument of conversion cannot be character literal",
3236               N);
3237             Error_Msg_N ("\use qualified expression instead", N);
3238          end if;
3239
3240       elsif Nkind (Expr) = N_Attribute_Reference
3241         and then
3242           (Attribute_Name (Expr) = Name_Access            or else
3243            Attribute_Name (Expr) = Name_Unchecked_Access  or else
3244            Attribute_Name (Expr) = Name_Unrestricted_Access)
3245       then
3246          Error_Msg_N ("argument of conversion cannot be access", N);
3247          Error_Msg_N ("\use qualified expression instead", N);
3248       end if;
3249    end Analyze_Type_Conversion;
3250
3251    ----------------------
3252    -- Analyze_Unary_Op --
3253    ----------------------
3254
3255    procedure Analyze_Unary_Op (N : Node_Id) is
3256       R     : constant Node_Id := Right_Opnd (N);
3257       Op_Id : Entity_Id := Entity (N);
3258
3259    begin
3260       Set_Etype (N, Any_Type);
3261       Candidate_Type := Empty;
3262
3263       Analyze_Expression (R);
3264
3265       if Present (Op_Id) then
3266          if Ekind (Op_Id) = E_Operator then
3267             Find_Unary_Types (R, Op_Id,  N);
3268          else
3269             Add_One_Interp (N, Op_Id, Etype (Op_Id));
3270          end if;
3271
3272       else
3273          Op_Id := Get_Name_Entity_Id (Chars (N));
3274          while Present (Op_Id) loop
3275             if Ekind (Op_Id) = E_Operator then
3276                if No (Next_Entity (First_Entity (Op_Id))) then
3277                   Find_Unary_Types (R, Op_Id,  N);
3278                end if;
3279
3280             elsif Is_Overloadable (Op_Id) then
3281                Analyze_User_Defined_Unary_Op (N, Op_Id);
3282             end if;
3283
3284             Op_Id := Homonym (Op_Id);
3285          end loop;
3286       end if;
3287
3288       Operator_Check (N);
3289    end Analyze_Unary_Op;
3290
3291    ----------------------------------
3292    -- Analyze_Unchecked_Expression --
3293    ----------------------------------
3294
3295    procedure Analyze_Unchecked_Expression (N : Node_Id) is
3296    begin
3297       Analyze (Expression (N), Suppress => All_Checks);
3298       Set_Etype (N, Etype (Expression (N)));
3299       Save_Interps (Expression (N), N);
3300    end Analyze_Unchecked_Expression;
3301
3302    ---------------------------------------
3303    -- Analyze_Unchecked_Type_Conversion --
3304    ---------------------------------------
3305
3306    procedure Analyze_Unchecked_Type_Conversion (N : Node_Id) is
3307    begin
3308       Find_Type (Subtype_Mark (N));
3309       Analyze_Expression (Expression (N));
3310       Set_Etype (N, Entity (Subtype_Mark (N)));
3311    end Analyze_Unchecked_Type_Conversion;
3312
3313    ------------------------------------
3314    -- Analyze_User_Defined_Binary_Op --
3315    ------------------------------------
3316
3317    procedure Analyze_User_Defined_Binary_Op
3318      (N     : Node_Id;
3319       Op_Id : Entity_Id)
3320    is
3321    begin
3322       --  Only do analysis if the operator Comes_From_Source, since otherwise
3323       --  the operator was generated by the expander, and all such operators
3324       --  always refer to the operators in package Standard.
3325
3326       if Comes_From_Source (N) then
3327          declare
3328             F1 : constant Entity_Id := First_Formal (Op_Id);
3329             F2 : constant Entity_Id := Next_Formal (F1);
3330
3331          begin
3332             --  Verify that Op_Id is a visible binary function. Note that since
3333             --  we know Op_Id is overloaded, potentially use visible means use
3334             --  visible for sure (RM 9.4(11)).
3335
3336             if Ekind (Op_Id) = E_Function
3337               and then Present (F2)
3338               and then (Is_Immediately_Visible (Op_Id)
3339                          or else Is_Potentially_Use_Visible (Op_Id))
3340               and then Has_Compatible_Type (Left_Opnd (N), Etype (F1))
3341               and then Has_Compatible_Type (Right_Opnd (N), Etype (F2))
3342             then
3343                Add_One_Interp (N, Op_Id, Etype (Op_Id));
3344
3345                if Debug_Flag_E then
3346                   Write_Str ("user defined operator ");
3347                   Write_Name (Chars (Op_Id));
3348                   Write_Str (" on node ");
3349                   Write_Int (Int (N));
3350                   Write_Eol;
3351                end if;
3352             end if;
3353          end;
3354       end if;
3355    end Analyze_User_Defined_Binary_Op;
3356
3357    -----------------------------------
3358    -- Analyze_User_Defined_Unary_Op --
3359    -----------------------------------
3360
3361    procedure Analyze_User_Defined_Unary_Op
3362      (N     : Node_Id;
3363       Op_Id : Entity_Id)
3364    is
3365    begin
3366       --  Only do analysis if the operator Comes_From_Source, since otherwise
3367       --  the operator was generated by the expander, and all such operators
3368       --  always refer to the operators in package Standard.
3369
3370       if Comes_From_Source (N) then
3371          declare
3372             F : constant Entity_Id := First_Formal (Op_Id);
3373
3374          begin
3375             --  Verify that Op_Id is a visible unary function. Note that since
3376             --  we know Op_Id is overloaded, potentially use visible means use
3377             --  visible for sure (RM 9.4(11)).
3378
3379             if Ekind (Op_Id) = E_Function
3380               and then No (Next_Formal (F))
3381               and then (Is_Immediately_Visible (Op_Id)
3382                          or else Is_Potentially_Use_Visible (Op_Id))
3383               and then Has_Compatible_Type (Right_Opnd (N), Etype (F))
3384             then
3385                Add_One_Interp (N, Op_Id, Etype (Op_Id));
3386             end if;
3387          end;
3388       end if;
3389    end Analyze_User_Defined_Unary_Op;
3390
3391    ---------------------------
3392    -- Check_Arithmetic_Pair --
3393    ---------------------------
3394
3395    procedure Check_Arithmetic_Pair
3396      (T1, T2 : Entity_Id;
3397       Op_Id  : Entity_Id;
3398       N      : Node_Id)
3399    is
3400       Op_Name : constant Name_Id   := Chars (Op_Id);
3401
3402       function Has_Fixed_Op (Typ : Entity_Id; Op : Entity_Id) return Boolean;
3403       --  Check whether the fixed-point type Typ has a user-defined operator
3404       --  (multiplication or division) that should hide the corresponding
3405       --  predefined operator. Used to implement Ada 2005 AI-264, to make
3406       --  such operators more visible and therefore useful.
3407
3408       function Specific_Type (T1, T2 : Entity_Id) return Entity_Id;
3409       --  Get specific type (i.e. non-universal type if there is one)
3410
3411       ------------------
3412       -- Has_Fixed_Op --
3413       ------------------
3414
3415       function Has_Fixed_Op (Typ : Entity_Id; Op : Entity_Id) return Boolean is
3416          Ent : Entity_Id;
3417          F1  : Entity_Id;
3418          F2  : Entity_Id;
3419
3420       begin
3421          --  The operation is treated as primitive if it is declared in the
3422          --  same scope as the type, and therefore on the same entity chain.
3423
3424          Ent := Next_Entity (Typ);
3425          while Present (Ent) loop
3426             if Chars (Ent) = Chars (Op) then
3427                F1 := First_Formal (Ent);
3428                F2 := Next_Formal (F1);
3429
3430                --  The operation counts as primitive if either operand or
3431                --  result are of the given type, and both operands are fixed
3432                --  point types.
3433
3434                if (Etype (F1) = Typ
3435                     and then Is_Fixed_Point_Type (Etype (F2)))
3436
3437                  or else
3438                    (Etype (F2) = Typ
3439                      and then Is_Fixed_Point_Type (Etype (F1)))
3440
3441                  or else
3442                    (Etype (Ent) = Typ
3443                      and then Is_Fixed_Point_Type (Etype (F1))
3444                      and then Is_Fixed_Point_Type (Etype (F2)))
3445                then
3446                   return True;
3447                end if;
3448             end if;
3449
3450             Next_Entity (Ent);
3451          end loop;
3452
3453          return False;
3454       end Has_Fixed_Op;
3455
3456       -------------------
3457       -- Specific_Type --
3458       -------------------
3459
3460       function Specific_Type (T1, T2 : Entity_Id) return Entity_Id is
3461       begin
3462          if T1 = Universal_Integer or else T1 = Universal_Real then
3463             return Base_Type (T2);
3464          else
3465             return Base_Type (T1);
3466          end if;
3467       end Specific_Type;
3468
3469    --  Start of processing for Check_Arithmetic_Pair
3470
3471    begin
3472       if Op_Name = Name_Op_Add or else Op_Name = Name_Op_Subtract then
3473
3474          if Is_Numeric_Type (T1)
3475            and then Is_Numeric_Type (T2)
3476            and then (Covers (T1, T2) or else Covers (T2, T1))
3477          then
3478             Add_One_Interp (N, Op_Id, Specific_Type (T1, T2));
3479          end if;
3480
3481       elsif Op_Name = Name_Op_Multiply or else Op_Name = Name_Op_Divide then
3482
3483          if Is_Fixed_Point_Type (T1)
3484            and then (Is_Fixed_Point_Type (T2)
3485                        or else T2 = Universal_Real)
3486          then
3487             --  If Treat_Fixed_As_Integer is set then the Etype is already set
3488             --  and no further processing is required (this is the case of an
3489             --  operator constructed by Exp_Fixd for a fixed point operation)
3490             --  Otherwise add one interpretation with universal fixed result
3491             --  If the operator is given in  functional notation, it comes
3492             --  from source and Fixed_As_Integer cannot apply.
3493
3494             if (Nkind (N) not in N_Op
3495                  or else not Treat_Fixed_As_Integer (N))
3496               and then
3497                 (not (Ada_Version >= Ada_05 and then Has_Fixed_Op (T1, Op_Id))
3498                   or else Nkind (Parent (N)) = N_Type_Conversion)
3499             then
3500                Add_One_Interp (N, Op_Id, Universal_Fixed);
3501             end if;
3502
3503          elsif Is_Fixed_Point_Type (T2)
3504            and then (Nkind (N) not in N_Op
3505                       or else not Treat_Fixed_As_Integer (N))
3506            and then T1 = Universal_Real
3507            and then
3508              (not (Ada_Version >= Ada_05 and then Has_Fixed_Op (T1, Op_Id))
3509                or else Nkind (Parent (N)) = N_Type_Conversion)
3510          then
3511             Add_One_Interp (N, Op_Id, Universal_Fixed);
3512
3513          elsif Is_Numeric_Type (T1)
3514            and then Is_Numeric_Type (T2)
3515            and then (Covers (T1, T2) or else Covers (T2, T1))
3516          then
3517             Add_One_Interp (N, Op_Id, Specific_Type (T1, T2));
3518
3519          elsif Is_Fixed_Point_Type (T1)
3520            and then (Base_Type (T2) = Base_Type (Standard_Integer)
3521                        or else T2 = Universal_Integer)
3522          then
3523             Add_One_Interp (N, Op_Id, T1);
3524
3525          elsif T2 = Universal_Real
3526            and then Base_Type (T1) = Base_Type (Standard_Integer)
3527            and then Op_Name = Name_Op_Multiply
3528          then
3529             Add_One_Interp (N, Op_Id, Any_Fixed);
3530
3531          elsif T1 = Universal_Real
3532            and then Base_Type (T2) = Base_Type (Standard_Integer)
3533          then
3534             Add_One_Interp (N, Op_Id, Any_Fixed);
3535
3536          elsif Is_Fixed_Point_Type (T2)
3537            and then (Base_Type (T1) = Base_Type (Standard_Integer)
3538                        or else T1 = Universal_Integer)
3539            and then Op_Name = Name_Op_Multiply
3540          then
3541             Add_One_Interp (N, Op_Id, T2);
3542
3543          elsif T1 = Universal_Real and then T2 = Universal_Integer then
3544             Add_One_Interp (N, Op_Id, T1);
3545
3546          elsif T2 = Universal_Real
3547            and then T1 = Universal_Integer
3548            and then Op_Name = Name_Op_Multiply
3549          then
3550             Add_One_Interp (N, Op_Id, T2);
3551          end if;
3552
3553       elsif Op_Name = Name_Op_Mod or else Op_Name = Name_Op_Rem then
3554
3555          --  Note: The fixed-point operands case with Treat_Fixed_As_Integer
3556          --  set does not require any special processing, since the Etype is
3557          --  already set (case of operation constructed by Exp_Fixed).
3558
3559          if Is_Integer_Type (T1)
3560            and then (Covers (T1, T2) or else Covers (T2, T1))
3561          then
3562             Add_One_Interp (N, Op_Id, Specific_Type (T1, T2));
3563          end if;
3564
3565       elsif Op_Name = Name_Op_Expon then
3566          if Is_Numeric_Type (T1)
3567            and then not Is_Fixed_Point_Type (T1)
3568            and then (Base_Type (T2) = Base_Type (Standard_Integer)
3569                       or else T2 = Universal_Integer)
3570          then
3571             Add_One_Interp (N, Op_Id, Base_Type (T1));
3572          end if;
3573
3574       else pragma Assert (Nkind (N) in N_Op_Shift);
3575
3576          --  If not one of the predefined operators, the node may be one
3577          --  of the intrinsic functions. Its kind is always specific, and
3578          --  we can use it directly, rather than the name of the operation.
3579
3580          if Is_Integer_Type (T1)
3581            and then (Base_Type (T2) = Base_Type (Standard_Integer)
3582                       or else T2 = Universal_Integer)
3583          then
3584             Add_One_Interp (N, Op_Id, Base_Type (T1));
3585          end if;
3586       end if;
3587    end Check_Arithmetic_Pair;
3588
3589    -------------------------------
3590    -- Check_Misspelled_Selector --
3591    -------------------------------
3592
3593    procedure Check_Misspelled_Selector
3594      (Prefix : Entity_Id;
3595       Sel    : Node_Id)
3596    is
3597       Max_Suggestions   : constant := 2;
3598       Nr_Of_Suggestions : Natural := 0;
3599
3600       Suggestion_1 : Entity_Id := Empty;
3601       Suggestion_2 : Entity_Id := Empty;
3602
3603       Comp : Entity_Id;
3604
3605    begin
3606       --  All the components of the prefix of selector Sel are matched
3607       --  against  Sel and a count is maintained of possible misspellings.
3608       --  When at the end of the analysis there are one or two (not more!)
3609       --  possible misspellings, these misspellings will be suggested as
3610       --  possible correction.
3611
3612       if not (Is_Private_Type (Prefix) or else Is_Record_Type (Prefix)) then
3613
3614          --  Concurrent types should be handled as well ???
3615
3616          return;
3617       end if;
3618
3619       Get_Name_String (Chars (Sel));
3620
3621       declare
3622          S  : constant String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
3623
3624       begin
3625          Comp  := First_Entity (Prefix);
3626          while Nr_Of_Suggestions <= Max_Suggestions
3627             and then Present (Comp)
3628          loop
3629             if Is_Visible_Component (Comp) then
3630                Get_Name_String (Chars (Comp));
3631
3632                if Is_Bad_Spelling_Of (Name_Buffer (1 .. Name_Len), S) then
3633                   Nr_Of_Suggestions := Nr_Of_Suggestions + 1;
3634
3635                   case Nr_Of_Suggestions is
3636                      when 1      => Suggestion_1 := Comp;
3637                      when 2      => Suggestion_2 := Comp;
3638                      when others => exit;
3639                   end case;
3640                end if;
3641             end if;
3642
3643             Comp := Next_Entity (Comp);
3644          end loop;
3645
3646          --  Report at most two suggestions
3647
3648          if Nr_Of_Suggestions = 1 then
3649             Error_Msg_NE ("\possible misspelling of&", Sel, Suggestion_1);
3650
3651          elsif Nr_Of_Suggestions = 2 then
3652             Error_Msg_Node_2 := Suggestion_2;
3653             Error_Msg_NE ("\possible misspelling of& or&",
3654               Sel, Suggestion_1);
3655          end if;
3656       end;
3657    end Check_Misspelled_Selector;
3658
3659    ----------------------
3660    -- Defined_In_Scope --
3661    ----------------------
3662
3663    function Defined_In_Scope (T : Entity_Id; S : Entity_Id) return Boolean
3664    is
3665       S1 : constant Entity_Id := Scope (Base_Type (T));
3666    begin
3667       return S1 = S
3668         or else (S1 = System_Aux_Id and then S = Scope (S1));
3669    end Defined_In_Scope;
3670
3671    -------------------
3672    -- Diagnose_Call --
3673    -------------------
3674
3675    procedure Diagnose_Call (N : Node_Id; Nam : Node_Id) is
3676       Actual           : Node_Id;
3677       X                : Interp_Index;
3678       It               : Interp;
3679       Success          : Boolean;
3680       Err_Mode         : Boolean;
3681       New_Nam          : Node_Id;
3682       Void_Interp_Seen : Boolean := False;
3683
3684    begin
3685       if Ada_Version >= Ada_05 then
3686          Actual := First_Actual (N);
3687          while Present (Actual) loop
3688
3689             --  Ada 2005 (AI-50217): Post an error in case of premature
3690             --  usage of an entity from the limited view.
3691
3692             if not Analyzed (Etype (Actual))
3693              and then From_With_Type (Etype (Actual))
3694             then
3695                Error_Msg_Qual_Level := 1;
3696                Error_Msg_NE
3697                 ("missing with_clause for scope of imported type&",
3698                   Actual, Etype (Actual));
3699                Error_Msg_Qual_Level := 0;
3700             end if;
3701
3702             Next_Actual (Actual);
3703          end loop;
3704       end if;
3705
3706       --   Analyze each candidate call again, with full error reporting
3707       --   for each.
3708
3709       Error_Msg_N
3710         ("no candidate interpretations match the actuals:!", Nam);
3711       Err_Mode := All_Errors_Mode;
3712       All_Errors_Mode := True;
3713
3714       --  If this is a call to an operation of a concurrent type,
3715       --  the failed interpretations have been removed from the
3716       --  name. Recover them to provide full diagnostics.
3717
3718       if Nkind (Parent (Nam)) = N_Selected_Component then
3719          Set_Entity (Nam, Empty);
3720          New_Nam := New_Copy_Tree (Parent (Nam));
3721          Set_Is_Overloaded (New_Nam, False);
3722          Set_Is_Overloaded (Selector_Name (New_Nam), False);
3723          Set_Parent (New_Nam, Parent (Parent (Nam)));
3724          Analyze_Selected_Component (New_Nam);
3725          Get_First_Interp (Selector_Name (New_Nam), X, It);
3726       else
3727          Get_First_Interp (Nam, X, It);
3728       end if;
3729
3730       while Present (It.Nam) loop
3731          if Etype (It.Nam) = Standard_Void_Type then
3732             Void_Interp_Seen := True;
3733          end if;
3734
3735          Analyze_One_Call (N, It.Nam, True, Success);
3736          Get_Next_Interp (X, It);
3737       end loop;
3738
3739       if Nkind (N) = N_Function_Call then
3740          Get_First_Interp (Nam, X, It);
3741          while Present (It.Nam) loop
3742             if Ekind (It.Nam) = E_Function
3743               or else Ekind (It.Nam) = E_Operator
3744             then
3745                return;
3746             else
3747                Get_Next_Interp (X, It);
3748             end if;
3749          end loop;
3750
3751          --  If all interpretations are procedures, this deserves a
3752          --  more precise message. Ditto if this appears as the prefix
3753          --  of a selected component, which may be a lexical error.
3754
3755          Error_Msg_N
3756            ("\context requires function call, found procedure name", Nam);
3757
3758          if Nkind (Parent (N)) = N_Selected_Component
3759            and then N = Prefix (Parent (N))
3760          then
3761             Error_Msg_N (
3762               "\period should probably be semicolon", Parent (N));
3763          end if;
3764
3765       elsif Nkind (N) = N_Procedure_Call_Statement
3766         and then not Void_Interp_Seen
3767       then
3768          Error_Msg_N (
3769          "\function name found in procedure call", Nam);
3770       end if;
3771
3772       All_Errors_Mode := Err_Mode;
3773    end Diagnose_Call;
3774
3775    ---------------------------
3776    -- Find_Arithmetic_Types --
3777    ---------------------------
3778
3779    procedure Find_Arithmetic_Types
3780      (L, R  : Node_Id;
3781       Op_Id : Entity_Id;
3782       N     : Node_Id)
3783    is
3784       Index1 : Interp_Index;
3785       Index2 : Interp_Index;
3786       It1    : Interp;
3787       It2    : Interp;
3788
3789       procedure Check_Right_Argument (T : Entity_Id);
3790       --  Check right operand of operator
3791
3792       --------------------------
3793       -- Check_Right_Argument --
3794       --------------------------
3795
3796       procedure Check_Right_Argument (T : Entity_Id) is
3797       begin
3798          if not Is_Overloaded (R) then
3799             Check_Arithmetic_Pair (T, Etype (R), Op_Id,  N);
3800          else
3801             Get_First_Interp (R, Index2, It2);
3802             while Present (It2.Typ) loop
3803                Check_Arithmetic_Pair (T, It2.Typ, Op_Id, N);
3804                Get_Next_Interp (Index2, It2);
3805             end loop;
3806          end if;
3807       end Check_Right_Argument;
3808
3809    --  Start processing for Find_Arithmetic_Types
3810
3811    begin
3812       if not Is_Overloaded (L) then
3813          Check_Right_Argument (Etype (L));
3814
3815       else
3816          Get_First_Interp (L, Index1, It1);
3817          while Present (It1.Typ) loop
3818             Check_Right_Argument (It1.Typ);
3819             Get_Next_Interp (Index1, It1);
3820          end loop;
3821       end if;
3822
3823    end Find_Arithmetic_Types;
3824
3825    ------------------------
3826    -- Find_Boolean_Types --
3827    ------------------------
3828
3829    procedure Find_Boolean_Types
3830      (L, R  : Node_Id;
3831       Op_Id : Entity_Id;
3832       N     : Node_Id)
3833    is
3834       Index : Interp_Index;
3835       It    : Interp;
3836
3837       procedure Check_Numeric_Argument (T : Entity_Id);
3838       --  Special case for logical operations one of whose operands is an
3839       --  integer literal. If both are literal the result is any modular type.
3840
3841       ----------------------------
3842       -- Check_Numeric_Argument --
3843       ----------------------------
3844
3845       procedure Check_Numeric_Argument (T : Entity_Id) is
3846       begin
3847          if T = Universal_Integer then
3848             Add_One_Interp (N, Op_Id, Any_Modular);
3849
3850          elsif Is_Modular_Integer_Type (T) then
3851             Add_One_Interp (N, Op_Id, T);
3852          end if;
3853       end Check_Numeric_Argument;
3854
3855    --  Start of processing for Find_Boolean_Types
3856
3857    begin
3858       if not Is_Overloaded (L) then
3859          if Etype (L) = Universal_Integer
3860            or else Etype (L) = Any_Modular
3861          then
3862             if not Is_Overloaded (R) then
3863                Check_Numeric_Argument (Etype (R));
3864
3865             else
3866                Get_First_Interp (R, Index, It);
3867                while Present (It.Typ) loop
3868                   Check_Numeric_Argument (It.Typ);
3869                   Get_Next_Interp (Index, It);
3870                end loop;
3871             end if;
3872
3873          --  If operands are aggregates, we must assume that they may be
3874          --  boolean arrays, and leave disambiguation for the second pass.
3875          --  If only one is an aggregate, verify that the other one has an
3876          --  interpretation as a boolean array
3877
3878          elsif Nkind (L) = N_Aggregate then
3879             if Nkind (R) = N_Aggregate then
3880                Add_One_Interp (N, Op_Id, Etype (L));
3881
3882             elsif not Is_Overloaded (R) then
3883                if Valid_Boolean_Arg (Etype (R)) then
3884                   Add_One_Interp (N, Op_Id, Etype (R));
3885                end if;
3886
3887             else
3888                Get_First_Interp (R, Index, It);
3889                while Present (It.Typ) loop
3890                   if Valid_Boolean_Arg (It.Typ) then
3891                      Add_One_Interp (N, Op_Id, It.Typ);
3892                   end if;
3893
3894                   Get_Next_Interp (Index, It);
3895                end loop;
3896             end if;
3897
3898          elsif Valid_Boolean_Arg (Etype (L))
3899            and then Has_Compatible_Type (R, Etype (L))
3900          then
3901             Add_One_Interp (N, Op_Id, Etype (L));
3902          end if;
3903
3904       else
3905          Get_First_Interp (L, Index, It);
3906          while Present (It.Typ) loop
3907             if Valid_Boolean_Arg (It.Typ)
3908               and then Has_Compatible_Type (R, It.Typ)
3909             then
3910                Add_One_Interp (N, Op_Id, It.Typ);
3911             end if;
3912
3913             Get_Next_Interp (Index, It);
3914          end loop;
3915       end if;
3916    end Find_Boolean_Types;
3917
3918    ---------------------------
3919    -- Find_Comparison_Types --
3920    ---------------------------
3921
3922    procedure Find_Comparison_Types
3923      (L, R  : Node_Id;
3924       Op_Id : Entity_Id;
3925       N     : Node_Id)
3926    is
3927       Index : Interp_Index;
3928       It    : Interp;
3929       Found : Boolean := False;
3930       I_F   : Interp_Index;
3931       T_F   : Entity_Id;
3932       Scop  : Entity_Id := Empty;
3933
3934       procedure Try_One_Interp (T1 : Entity_Id);
3935       --  Routine to try one proposed interpretation. Note that the context
3936       --  of the operator plays no role in resolving the arguments, so that
3937       --  if there is more than one interpretation of the operands that is
3938       --  compatible with comparison, the operation is ambiguous.
3939
3940       --------------------
3941       -- Try_One_Interp --
3942       --------------------
3943
3944       procedure Try_One_Interp (T1 : Entity_Id) is
3945       begin
3946
3947          --  If the operator is an expanded name, then the type of the operand
3948          --  must be defined in the corresponding scope. If the type is
3949          --  universal, the context will impose the correct type.
3950
3951          if Present (Scop)
3952             and then not Defined_In_Scope (T1, Scop)
3953             and then T1 /= Universal_Integer
3954             and then T1 /= Universal_Real
3955             and then T1 /= Any_String
3956             and then T1 /= Any_Composite
3957          then
3958             return;
3959          end if;
3960
3961          if Valid_Comparison_Arg (T1)
3962            and then Has_Compatible_Type (R, T1)
3963          then
3964             if Found
3965               and then Base_Type (T1) /= Base_Type (T_F)
3966             then
3967                It := Disambiguate (L, I_F, Index, Any_Type);
3968
3969                if It = No_Interp then
3970                   Ambiguous_Operands (N);
3971                   Set_Etype (L, Any_Type);
3972                   return;
3973
3974                else
3975                   T_F := It.Typ;
3976                end if;
3977
3978             else
3979                Found := True;
3980                T_F   := T1;
3981                I_F   := Index;
3982             end if;
3983
3984             Set_Etype (L, T_F);
3985             Find_Non_Universal_Interpretations (N, R, Op_Id, T1);
3986
3987          end if;
3988       end Try_One_Interp;
3989
3990    --  Start processing for Find_Comparison_Types
3991
3992    begin
3993       --  If left operand is aggregate, the right operand has to
3994       --  provide a usable type for it.
3995
3996       if Nkind (L) = N_Aggregate
3997         and then Nkind (R) /= N_Aggregate
3998       then
3999          Find_Comparison_Types (R, L, Op_Id, N);
4000          return;
4001       end if;
4002
4003       if Nkind (N) = N_Function_Call
4004          and then Nkind (Name (N)) = N_Expanded_Name
4005       then
4006          Scop := Entity (Prefix (Name (N)));
4007
4008          --  The prefix may be a package renaming, and the subsequent test
4009          --  requires the original package.
4010
4011          if Ekind (Scop) = E_Package
4012            and then Present (Renamed_Entity (Scop))
4013          then
4014             Scop := Renamed_Entity (Scop);
4015             Set_Entity (Prefix (Name (N)), Scop);
4016          end if;
4017       end if;
4018
4019       if not Is_Overloaded (L) then
4020          Try_One_Interp (Etype (L));
4021
4022       else
4023          Get_First_Interp (L, Index, It);
4024          while Present (It.Typ) loop
4025             Try_One_Interp (It.Typ);
4026             Get_Next_Interp (Index, It);
4027          end loop;
4028       end if;
4029    end Find_Comparison_Types;
4030
4031    ----------------------------------------
4032    -- Find_Non_Universal_Interpretations --
4033    ----------------------------------------
4034
4035    procedure Find_Non_Universal_Interpretations
4036      (N     : Node_Id;
4037       R     : Node_Id;
4038       Op_Id : Entity_Id;
4039       T1    : Entity_Id)
4040    is
4041       Index : Interp_Index;
4042       It    : Interp;
4043
4044    begin
4045       if T1 = Universal_Integer
4046         or else T1 = Universal_Real
4047       then
4048          if not Is_Overloaded (R) then
4049             Add_One_Interp
4050               (N, Op_Id, Standard_Boolean, Base_Type (Etype (R)));
4051          else
4052             Get_First_Interp (R, Index, It);
4053             while Present (It.Typ) loop
4054                if Covers (It.Typ, T1) then
4055                   Add_One_Interp
4056                     (N, Op_Id, Standard_Boolean, Base_Type (It.Typ));
4057                end if;
4058
4059                Get_Next_Interp (Index, It);
4060             end loop;
4061          end if;
4062       else
4063          Add_One_Interp (N, Op_Id, Standard_Boolean, Base_Type (T1));
4064       end if;
4065    end Find_Non_Universal_Interpretations;
4066
4067    ------------------------------
4068    -- Find_Concatenation_Types --
4069    ------------------------------
4070
4071    procedure Find_Concatenation_Types
4072      (L, R  : Node_Id;
4073       Op_Id : Entity_Id;
4074       N     : Node_Id)
4075    is
4076       Op_Type : constant Entity_Id := Etype (Op_Id);
4077
4078    begin
4079       if Is_Array_Type (Op_Type)
4080         and then not Is_Limited_Type (Op_Type)
4081
4082         and then (Has_Compatible_Type (L, Op_Type)
4083                     or else
4084                   Has_Compatible_Type (L, Component_Type (Op_Type)))
4085
4086         and then (Has_Compatible_Type (R, Op_Type)
4087                     or else
4088                   Has_Compatible_Type (R, Component_Type (Op_Type)))
4089       then
4090          Add_One_Interp (N, Op_Id, Op_Type);
4091       end if;
4092    end Find_Concatenation_Types;
4093
4094    -------------------------
4095    -- Find_Equality_Types --
4096    -------------------------
4097
4098    procedure Find_Equality_Types
4099      (L, R  : Node_Id;
4100       Op_Id : Entity_Id;
4101       N     : Node_Id)
4102    is
4103       Index : Interp_Index;
4104       It    : Interp;
4105       Found : Boolean := False;
4106       I_F   : Interp_Index;
4107       T_F   : Entity_Id;
4108       Scop  : Entity_Id := Empty;
4109
4110       procedure Try_One_Interp (T1 : Entity_Id);
4111       --  The context of the operator plays no role in resolving the
4112       --  arguments,  so that if there is more than one interpretation
4113       --  of the operands that is compatible with equality, the construct
4114       --  is ambiguous and an error can be emitted now, after trying to
4115       --  disambiguate, i.e. applying preference rules.
4116
4117       --------------------
4118       -- Try_One_Interp --
4119       --------------------
4120
4121       procedure Try_One_Interp (T1 : Entity_Id) is
4122       begin
4123          --  If the operator is an expanded name, then the type of the operand
4124          --  must be defined in the corresponding scope. If the type is
4125          --  universal, the context will impose the correct type. An anonymous
4126          --  type for a 'Access reference is also universal in this sense, as
4127          --  the actual type is obtained from context.
4128          --  In Ada 2005, the equality operator for anonymous access types
4129          --  is declared in Standard, and preference rules apply to it.
4130
4131          if Present (Scop) then
4132             if Defined_In_Scope (T1, Scop)
4133               or else T1 = Universal_Integer
4134               or else T1 = Universal_Real
4135               or else T1 = Any_Access
4136               or else T1 = Any_String
4137               or else T1 = Any_Composite
4138               or else (Ekind (T1) = E_Access_Subprogram_Type
4139                           and then not Comes_From_Source (T1))
4140             then
4141                null;
4142
4143             elsif Ekind (T1) = E_Anonymous_Access_Type
4144               and then Scop = Standard_Standard
4145             then
4146                null;
4147
4148             else
4149                --  The scope does not contain an operator for the type
4150
4151                return;
4152             end if;
4153          end if;
4154
4155          --  Ada 2005 (AI-230): Keep restriction imposed by Ada 83 and 95:
4156          --  Do not allow anonymous access types in equality operators.
4157
4158          if Ada_Version < Ada_05
4159            and then Ekind (T1) = E_Anonymous_Access_Type
4160          then
4161             return;
4162          end if;
4163
4164          if T1 /= Standard_Void_Type
4165            and then not Is_Limited_Type (T1)
4166            and then not Is_Limited_Composite (T1)
4167            and then Has_Compatible_Type (R, T1)
4168          then
4169             if Found
4170               and then Base_Type (T1) /= Base_Type (T_F)
4171             then
4172                It := Disambiguate (L, I_F, Index, Any_Type);
4173
4174                if It = No_Interp then
4175                   Ambiguous_Operands (N);
4176                   Set_Etype (L, Any_Type);
4177                   return;
4178
4179                else
4180                   T_F := It.Typ;
4181                end if;
4182
4183             else
4184                Found := True;
4185                T_F   := T1;
4186                I_F   := Index;
4187             end if;
4188
4189             if not Analyzed (L) then
4190                Set_Etype (L, T_F);
4191             end if;
4192
4193             Find_Non_Universal_Interpretations (N, R, Op_Id, T1);
4194
4195             --  Case of operator was not visible, Etype still set to Any_Type
4196
4197             if Etype (N) = Any_Type then
4198                Found := False;
4199             end if;
4200
4201          elsif Scop = Standard_Standard
4202            and then Ekind (T1) = E_Anonymous_Access_Type
4203          then
4204             Found := True;
4205          end if;
4206       end Try_One_Interp;
4207
4208    --  Start of processing for Find_Equality_Types
4209
4210    begin
4211       --  If left operand is aggregate, the right operand has to
4212       --  provide a usable type for it.
4213
4214       if Nkind (L) = N_Aggregate
4215         and then Nkind (R) /= N_Aggregate
4216       then
4217          Find_Equality_Types (R, L, Op_Id, N);
4218          return;
4219       end if;
4220
4221       if Nkind (N) = N_Function_Call
4222          and then Nkind (Name (N)) = N_Expanded_Name
4223       then
4224          Scop := Entity (Prefix (Name (N)));
4225
4226          --  The prefix may be a package renaming, and the subsequent test
4227          --  requires the original package.
4228
4229          if Ekind (Scop) = E_Package
4230            and then Present (Renamed_Entity (Scop))
4231          then
4232             Scop := Renamed_Entity (Scop);
4233             Set_Entity (Prefix (Name (N)), Scop);
4234          end if;
4235       end if;
4236
4237       if not Is_Overloaded (L) then
4238          Try_One_Interp (Etype (L));
4239
4240       else
4241          Get_First_Interp (L, Index, It);
4242          while Present (It.Typ) loop
4243             Try_One_Interp (It.Typ);
4244             Get_Next_Interp (Index, It);
4245          end loop;
4246       end if;
4247    end Find_Equality_Types;
4248
4249    -------------------------
4250    -- Find_Negation_Types --
4251    -------------------------
4252
4253    procedure Find_Negation_Types
4254      (R     : Node_Id;
4255       Op_Id : Entity_Id;
4256       N     : Node_Id)
4257    is
4258       Index : Interp_Index;
4259       It    : Interp;
4260
4261    begin
4262       if not Is_Overloaded (R) then
4263          if Etype (R) = Universal_Integer then
4264             Add_One_Interp (N, Op_Id, Any_Modular);
4265          elsif Valid_Boolean_Arg (Etype (R)) then
4266             Add_One_Interp (N, Op_Id, Etype (R));
4267          end if;
4268
4269       else
4270          Get_First_Interp (R, Index, It);
4271          while Present (It.Typ) loop
4272             if Valid_Boolean_Arg (It.Typ) then
4273                Add_One_Interp (N, Op_Id, It.Typ);
4274             end if;
4275
4276             Get_Next_Interp (Index, It);
4277          end loop;
4278       end if;
4279    end Find_Negation_Types;
4280
4281    ----------------------
4282    -- Find_Unary_Types --
4283    ----------------------
4284
4285    procedure Find_Unary_Types
4286      (R     : Node_Id;
4287       Op_Id : Entity_Id;
4288       N     : Node_Id)
4289    is
4290       Index : Interp_Index;
4291       It    : Interp;
4292
4293    begin
4294       if not Is_Overloaded (R) then
4295          if Is_Numeric_Type (Etype (R)) then
4296             Add_One_Interp (N, Op_Id, Base_Type (Etype (R)));
4297          end if;
4298
4299       else
4300          Get_First_Interp (R, Index, It);
4301          while Present (It.Typ) loop
4302             if Is_Numeric_Type (It.Typ) then
4303                Add_One_Interp (N, Op_Id, Base_Type (It.Typ));
4304             end if;
4305
4306             Get_Next_Interp (Index, It);
4307          end loop;
4308       end if;
4309    end Find_Unary_Types;
4310
4311    ------------------
4312    -- Junk_Operand --
4313    ------------------
4314
4315    function Junk_Operand (N : Node_Id) return Boolean is
4316       Enode : Node_Id;
4317
4318    begin
4319       if Error_Posted (N) then
4320          return False;
4321       end if;
4322
4323       --  Get entity to be tested
4324
4325       if Is_Entity_Name (N)
4326         and then Present (Entity (N))
4327       then
4328          Enode := N;
4329
4330       --  An odd case, a procedure name gets converted to a very peculiar
4331       --  function call, and here is where we detect this happening.
4332
4333       elsif Nkind (N) = N_Function_Call
4334         and then Is_Entity_Name (Name (N))
4335         and then Present (Entity (Name (N)))
4336       then
4337          Enode := Name (N);
4338
4339       --  Another odd case, there are at least some cases of selected
4340       --  components where the selected component is not marked as having
4341       --  an entity, even though the selector does have an entity
4342
4343       elsif Nkind (N) = N_Selected_Component
4344         and then Present (Entity (Selector_Name (N)))
4345       then
4346          Enode := Selector_Name (N);
4347
4348       else
4349          return False;
4350       end if;
4351
4352       --  Now test the entity we got to see if it is a bad case
4353
4354       case Ekind (Entity (Enode)) is
4355
4356          when E_Package =>
4357             Error_Msg_N
4358               ("package name cannot be used as operand", Enode);
4359
4360          when Generic_Unit_Kind =>
4361             Error_Msg_N
4362               ("generic unit name cannot be used as operand", Enode);
4363
4364          when Type_Kind =>
4365             Error_Msg_N
4366               ("subtype name cannot be used as operand", Enode);
4367
4368          when Entry_Kind =>
4369             Error_Msg_N
4370               ("entry name cannot be used as operand", Enode);
4371
4372          when E_Procedure =>
4373             Error_Msg_N
4374               ("procedure name cannot be used as operand", Enode);
4375
4376          when E_Exception =>
4377             Error_Msg_N
4378               ("exception name cannot be used as operand", Enode);
4379
4380          when E_Block | E_Label | E_Loop =>
4381             Error_Msg_N
4382               ("label name cannot be used as operand", Enode);
4383
4384          when others =>
4385             return False;
4386
4387       end case;
4388
4389       return True;
4390    end Junk_Operand;
4391
4392    --------------------
4393    -- Operator_Check --
4394    --------------------
4395
4396    procedure Operator_Check (N : Node_Id) is
4397    begin
4398       Remove_Abstract_Operations (N);
4399
4400       --  Test for case of no interpretation found for operator
4401
4402       if Etype (N) = Any_Type then
4403          declare
4404             L     : Node_Id;
4405             R     : Node_Id;
4406             Op_Id : Entity_Id := Empty;
4407
4408          begin
4409             R := Right_Opnd (N);
4410
4411             if Nkind (N) in N_Binary_Op then
4412                L := Left_Opnd (N);
4413             else
4414                L := Empty;
4415             end if;
4416
4417             --  If either operand has no type, then don't complain further,
4418             --  since this simply means that we have a propagated error.
4419
4420             if R = Error
4421               or else Etype (R) = Any_Type
4422               or else (Nkind (N) in N_Binary_Op and then Etype (L) = Any_Type)
4423             then
4424                return;
4425
4426             --  We explicitly check for the case of concatenation of component
4427             --  with component to avoid reporting spurious matching array types
4428             --  that might happen to be lurking in distant packages (such as
4429             --  run-time packages). This also prevents inconsistencies in the
4430             --  messages for certain ACVC B tests, which can vary depending on
4431             --  types declared in run-time interfaces. Another improvement when
4432             --  aggregates are present is to look for a well-typed operand.
4433
4434             elsif Present (Candidate_Type)
4435               and then (Nkind (N) /= N_Op_Concat
4436                          or else Is_Array_Type (Etype (L))
4437                          or else Is_Array_Type (Etype (R)))
4438             then
4439
4440                if Nkind (N) = N_Op_Concat then
4441                   if Etype (L) /= Any_Composite
4442                     and then Is_Array_Type (Etype (L))
4443                   then
4444                      Candidate_Type := Etype (L);
4445
4446                   elsif Etype (R) /= Any_Composite
4447                     and then Is_Array_Type (Etype (R))
4448                   then
4449                      Candidate_Type := Etype (R);
4450                   end if;
4451                end if;
4452
4453                Error_Msg_NE
4454                  ("operator for} is not directly visible!",
4455                   N, First_Subtype (Candidate_Type));
4456                Error_Msg_N ("use clause would make operation legal!",  N);
4457                return;
4458
4459             --  If either operand is a junk operand (e.g. package name), then
4460             --  post appropriate error messages, but do not complain further.
4461
4462             --  Note that the use of OR in this test instead of OR ELSE is
4463             --  quite deliberate, we may as well check both operands in the
4464             --  binary operator case.
4465
4466             elsif Junk_Operand (R)
4467               or (Nkind (N) in N_Binary_Op and then Junk_Operand (L))
4468             then
4469                return;
4470
4471             --  If we have a logical operator, one of whose operands is
4472             --  Boolean, then we know that the other operand cannot resolve to
4473             --  Boolean (since we got no interpretations), but in that case we
4474             --  pretty much know that the other operand should be Boolean, so
4475             --  resolve it that way (generating an error)
4476
4477             elsif Nkind (N) = N_Op_And
4478                     or else
4479                   Nkind (N) = N_Op_Or
4480                     or else
4481                   Nkind (N) = N_Op_Xor
4482             then
4483                if Etype (L) = Standard_Boolean then
4484                   Resolve (R, Standard_Boolean);
4485                   return;
4486                elsif Etype (R) = Standard_Boolean then
4487                   Resolve (L, Standard_Boolean);
4488                   return;
4489                end if;
4490
4491             --  For an arithmetic operator or comparison operator, if one
4492             --  of the operands is numeric, then we know the other operand
4493             --  is not the same numeric type. If it is a non-numeric type,
4494             --  then probably it is intended to match the other operand.
4495
4496             elsif Nkind (N) = N_Op_Add      or else
4497                   Nkind (N) = N_Op_Divide   or else
4498                   Nkind (N) = N_Op_Ge       or else
4499                   Nkind (N) = N_Op_Gt       or else
4500                   Nkind (N) = N_Op_Le       or else
4501                   Nkind (N) = N_Op_Lt       or else
4502                   Nkind (N) = N_Op_Mod      or else
4503                   Nkind (N) = N_Op_Multiply or else
4504                   Nkind (N) = N_Op_Rem      or else
4505                   Nkind (N) = N_Op_Subtract
4506             then
4507                if Is_Numeric_Type (Etype (L))
4508                  and then not Is_Numeric_Type (Etype (R))
4509                then
4510                   Resolve (R, Etype (L));
4511                   return;
4512
4513                elsif Is_Numeric_Type (Etype (R))
4514                  and then not Is_Numeric_Type (Etype (L))
4515                then
4516                   Resolve (L, Etype (R));
4517                   return;
4518                end if;
4519
4520             --  Comparisons on A'Access are common enough to deserve a
4521             --  special message.
4522
4523             elsif (Nkind (N) = N_Op_Eq  or else
4524                    Nkind (N) = N_Op_Ne)
4525                and then Ekind (Etype (L)) = E_Access_Attribute_Type
4526                and then Ekind (Etype (R)) = E_Access_Attribute_Type
4527             then
4528                Error_Msg_N
4529                  ("two access attributes cannot be compared directly", N);
4530                Error_Msg_N
4531                  ("\they must be converted to an explicit type for comparison",
4532                    N);
4533                return;
4534
4535             --  Another one for C programmers
4536
4537             elsif Nkind (N) = N_Op_Concat
4538               and then Valid_Boolean_Arg (Etype (L))
4539               and then Valid_Boolean_Arg (Etype (R))
4540             then
4541                Error_Msg_N ("invalid operands for concatenation", N);
4542                Error_Msg_N ("\maybe AND was meant", N);
4543                return;
4544
4545             --  A special case for comparison of access parameter with null
4546
4547             elsif Nkind (N) = N_Op_Eq
4548               and then Is_Entity_Name (L)
4549               and then Nkind (Parent (Entity (L))) = N_Parameter_Specification
4550               and then Nkind (Parameter_Type (Parent (Entity (L)))) =
4551                                                   N_Access_Definition
4552               and then Nkind (R) = N_Null
4553             then
4554                Error_Msg_N ("access parameter is not allowed to be null", L);
4555                Error_Msg_N ("\(call would raise Constraint_Error)", L);
4556                return;
4557             end if;
4558
4559             --  If we fall through then just give general message. Note that in
4560             --  the following messages, if the operand is overloaded we choose
4561             --  an arbitrary type to complain about, but that is probably more
4562             --  useful than not giving a type at all.
4563
4564             if Nkind (N) in N_Unary_Op then
4565                Error_Msg_Node_2 := Etype (R);
4566                Error_Msg_N ("operator& not defined for}", N);
4567                return;
4568
4569             else
4570                if Nkind (N) in N_Binary_Op then
4571                   if not Is_Overloaded (L)
4572                     and then not Is_Overloaded (R)
4573                     and then Base_Type (Etype (L)) = Base_Type (Etype (R))
4574                   then
4575                      Error_Msg_Node_2 := First_Subtype (Etype (R));
4576                      Error_Msg_N ("there is no applicable operator& for}", N);
4577
4578                   else
4579                      --  Another attempt to find a fix: one of the candidate
4580                      --  interpretations may not be use-visible. This has
4581                      --  already been checked for predefined operators, so
4582                      --  we examine only user-defined functions.
4583
4584                      Op_Id := Get_Name_Entity_Id (Chars (N));
4585
4586                      while Present (Op_Id) loop
4587                         if Ekind (Op_Id) /= E_Operator
4588                           and then Is_Overloadable (Op_Id)
4589                         then
4590                            if not Is_Immediately_Visible (Op_Id)
4591                              and then not In_Use (Scope (Op_Id))
4592                              and then not Is_Abstract (Op_Id)
4593                              and then not Is_Hidden (Op_Id)
4594                              and then Ekind (Scope (Op_Id)) = E_Package
4595                              and then
4596                                Has_Compatible_Type
4597                                  (L, Etype (First_Formal (Op_Id)))
4598                              and then Present
4599                               (Next_Formal (First_Formal (Op_Id)))
4600                              and then
4601                                Has_Compatible_Type
4602                                  (R,
4603                                   Etype (Next_Formal (First_Formal (Op_Id))))
4604                            then
4605                               Error_Msg_N
4606                                 ("No legal interpretation for operator&", N);
4607                               Error_Msg_NE
4608                                 ("\use clause on& would make operation legal",
4609                                    N, Scope (Op_Id));
4610                               exit;
4611                            end if;
4612                         end if;
4613
4614                         Op_Id := Homonym (Op_Id);
4615                      end loop;
4616
4617                      if No (Op_Id) then
4618                         Error_Msg_N ("invalid operand types for operator&", N);
4619
4620                         if Nkind (N) /= N_Op_Concat then
4621                            Error_Msg_NE ("\left operand has}!",  N, Etype (L));
4622                            Error_Msg_NE ("\right operand has}!", N, Etype (R));
4623                         end if;
4624                      end if;
4625                   end if;
4626                end if;
4627             end if;
4628          end;
4629       end if;
4630    end Operator_Check;
4631
4632    -----------------------------------------
4633    -- Process_Implicit_Dereference_Prefix --
4634    -----------------------------------------
4635
4636    procedure Process_Implicit_Dereference_Prefix
4637      (E : Entity_Id;
4638       P : Entity_Id)
4639    is
4640       Ref : Node_Id;
4641
4642    begin
4643       if Present (E)
4644         and then (Operating_Mode = Check_Semantics or else not Expander_Active)
4645       then
4646          --  We create a dummy reference to E to ensure that the reference
4647          --  is not considered as part of an assignment (an implicit
4648          --  dereference can never assign to its prefix). The Comes_From_Source
4649          --  attribute needs to be propagated for accurate warnings.
4650
4651          Ref := New_Reference_To (E, Sloc (P));
4652          Set_Comes_From_Source (Ref, Comes_From_Source (P));
4653          Generate_Reference (E, Ref);
4654       end if;
4655    end Process_Implicit_Dereference_Prefix;
4656
4657    --------------------------------
4658    -- Remove_Abstract_Operations --
4659    --------------------------------
4660
4661    procedure Remove_Abstract_Operations (N : Node_Id) is
4662       I            : Interp_Index;
4663       It           : Interp;
4664       Abstract_Op  : Entity_Id := Empty;
4665
4666       --  AI-310: If overloaded, remove abstract non-dispatching operations. We
4667       --  activate this if either extensions are enabled, or if the abstract
4668       --  operation in question comes from a predefined file. This latter test
4669       --  allows us to use abstract to make operations invisible to users. In
4670       --  particular, if type Address is non-private and abstract subprograms
4671       --  are used to hide its operators, they will be truly hidden.
4672
4673       type Operand_Position is (First_Op, Second_Op);
4674       Univ_Type : constant Entity_Id := Universal_Interpretation (N);
4675
4676       procedure Remove_Address_Interpretations (Op : Operand_Position);
4677       --  Ambiguities may arise when the operands are literal and the address
4678       --  operations in s-auxdec are visible. In that case, remove the
4679       --  interpretation of a literal as Address, to retain the semantics of
4680       --  Address as a private type.
4681
4682       ------------------------------------
4683       -- Remove_Address_Interpretations --
4684       ------------------------------------
4685
4686       procedure Remove_Address_Interpretations (Op : Operand_Position) is
4687          Formal : Entity_Id;
4688
4689       begin
4690          if Is_Overloaded (N) then
4691             Get_First_Interp (N, I, It);
4692             while Present (It.Nam) loop
4693                Formal := First_Entity (It.Nam);
4694
4695                if Op = Second_Op then
4696                   Formal := Next_Entity (Formal);
4697                end if;
4698
4699                if Is_Descendent_Of_Address (Etype (Formal)) then
4700                   Remove_Interp (I);
4701                end if;
4702
4703                Get_Next_Interp (I, It);
4704             end loop;
4705          end if;
4706       end Remove_Address_Interpretations;
4707
4708    --  Start of processing for Remove_Abstract_Operations
4709
4710    begin
4711       if Is_Overloaded (N) then
4712          Get_First_Interp (N, I, It);
4713
4714          while Present (It.Nam) loop
4715             if not Is_Type (It.Nam)
4716               and then Is_Abstract (It.Nam)
4717               and then not Is_Dispatching_Operation (It.Nam)
4718             then
4719                Abstract_Op := It.Nam;
4720
4721                --  In Ada 2005, this operation does not participate in Overload
4722                --  resolution. If the operation is defined in in a predefined
4723                --  unit, it is one of the operations declared abstract in some
4724                --  variants of System, and it must be removed as well.
4725
4726                if Ada_Version >= Ada_05
4727                    or else Is_Predefined_File_Name
4728                              (Unit_File_Name (Get_Source_Unit (It.Nam)))
4729                    or else Is_Descendent_Of_Address (It.Typ)
4730                then
4731                   Remove_Interp (I);
4732                   exit;
4733                end if;
4734             end if;
4735
4736             Get_Next_Interp (I, It);
4737          end loop;
4738
4739          if No (Abstract_Op) then
4740
4741             --  If some interpretation yields an integer type, it is still
4742             --  possible that there are address interpretations. Remove them
4743             --  if one operand is a literal, to avoid spurious ambiguities
4744             --  on systems where Address is a visible integer type.
4745
4746             if Is_Overloaded (N)
4747               and then  Nkind (N) in N_Op
4748               and then Is_Integer_Type (Etype (N))
4749             then
4750                if Nkind (N) in N_Binary_Op then
4751                   if Nkind (Right_Opnd (N)) = N_Integer_Literal then
4752                      Remove_Address_Interpretations (Second_Op);
4753
4754                   elsif Nkind (Right_Opnd (N)) = N_Integer_Literal then
4755                      Remove_Address_Interpretations (First_Op);
4756                   end if;
4757                end if;
4758             end if;
4759
4760          elsif Nkind (N) in N_Op then
4761
4762             --  Remove interpretations that treat literals as addresses. This
4763             --  is never appropriate, even when Address is defined as a visible
4764             --  Integer type. The reason is that we would really prefer Address
4765             --  to behave as a private type, even in this case, which is there
4766             --  only to accomodate oddities of VMS address sizes. If Address is
4767             --  a visible integer type, we get lots of overload ambiguities.
4768
4769             if Nkind (N) in N_Binary_Op then
4770                declare
4771                   U1 : constant Boolean :=
4772                      Present (Universal_Interpretation (Right_Opnd (N)));
4773                   U2 : constant Boolean :=
4774                      Present (Universal_Interpretation (Left_Opnd (N)));
4775
4776                begin
4777                   if U1 then
4778                      Remove_Address_Interpretations (Second_Op);
4779                   end if;
4780
4781                   if U2 then
4782                      Remove_Address_Interpretations (First_Op);
4783                   end if;
4784
4785                   if not (U1 and U2) then
4786
4787                      --  Remove corresponding predefined operator, which is
4788                      --  always added to the overload set.
4789
4790                      Get_First_Interp (N, I, It);
4791                      while Present (It.Nam) loop
4792                         if Scope (It.Nam) = Standard_Standard
4793                           and then Base_Type (It.Typ) =
4794                                    Base_Type (Etype (Abstract_Op))
4795                         then
4796                            Remove_Interp (I);
4797                         end if;
4798
4799                         Get_Next_Interp (I, It);
4800                      end loop;
4801
4802                   elsif Is_Overloaded (N)
4803                     and then Present (Univ_Type)
4804                   then
4805                      --  If both operands have a universal interpretation,
4806                      --  it is still necessary to remove interpretations that
4807                      --  yield Address. Any remaining ambiguities will be
4808                      --  removed in Disambiguate.
4809
4810                      Get_First_Interp (N, I, It);
4811                      while Present (It.Nam) loop
4812                         if Is_Descendent_Of_Address (It.Typ) then
4813                            Remove_Interp (I);
4814
4815                         elsif not Is_Type (It.Nam) then
4816                            Set_Entity (N, It.Nam);
4817                         end if;
4818
4819                         Get_Next_Interp (I, It);
4820                      end loop;
4821                   end if;
4822                end;
4823             end if;
4824
4825          elsif Nkind (N) = N_Function_Call
4826            and then
4827              (Nkind (Name (N)) = N_Operator_Symbol
4828                 or else
4829                   (Nkind (Name (N)) = N_Expanded_Name
4830                      and then
4831                        Nkind (Selector_Name (Name (N))) = N_Operator_Symbol))
4832          then
4833
4834             declare
4835                Arg1 : constant Node_Id := First (Parameter_Associations (N));
4836                U1   : constant Boolean :=
4837                         Present (Universal_Interpretation (Arg1));
4838                U2   : constant Boolean :=
4839                         Present (Next (Arg1)) and then
4840                         Present (Universal_Interpretation (Next (Arg1)));
4841
4842             begin
4843                if U1 then
4844                   Remove_Address_Interpretations (First_Op);
4845                end if;
4846
4847                if U2 then
4848                   Remove_Address_Interpretations (Second_Op);
4849                end if;
4850
4851                if not (U1 and U2) then
4852                   Get_First_Interp (N, I, It);
4853                   while Present (It.Nam) loop
4854                      if Scope (It.Nam) = Standard_Standard
4855                        and then It.Typ = Base_Type (Etype (Abstract_Op))
4856                      then
4857                         Remove_Interp (I);
4858                      end if;
4859
4860                      Get_Next_Interp (I, It);
4861                   end loop;
4862                end if;
4863             end;
4864          end if;
4865
4866          --  If the removal has left no valid interpretations, emit
4867          --  error message now and label node as illegal.
4868
4869          if Present (Abstract_Op) then
4870             Get_First_Interp (N, I, It);
4871
4872             if No (It.Nam) then
4873
4874                --  Removal of abstract operation left no viable candidate
4875
4876                Set_Etype (N, Any_Type);
4877                Error_Msg_Sloc := Sloc (Abstract_Op);
4878                Error_Msg_NE
4879                  ("cannot call abstract operation& declared#", N, Abstract_Op);
4880             end if;
4881          end if;
4882       end if;
4883    end Remove_Abstract_Operations;
4884
4885    -----------------------
4886    -- Try_Indirect_Call --
4887    -----------------------
4888
4889    function Try_Indirect_Call
4890      (N   : Node_Id;
4891       Nam : Entity_Id;
4892       Typ : Entity_Id) return Boolean
4893    is
4894       Actual  : Node_Id;
4895       Formal  : Entity_Id;
4896       Call_OK : Boolean;
4897
4898    begin
4899       Normalize_Actuals (N, Designated_Type (Typ), False, Call_OK);
4900
4901       Actual := First_Actual (N);
4902       Formal := First_Formal (Designated_Type (Typ));
4903       while Present (Actual) and then Present (Formal) loop
4904          if not Has_Compatible_Type (Actual, Etype (Formal)) then
4905             return False;
4906          end if;
4907
4908          Next (Actual);
4909          Next_Formal (Formal);
4910       end loop;
4911
4912       if No (Actual) and then No (Formal) then
4913          Add_One_Interp (N, Nam, Etype (Designated_Type (Typ)));
4914
4915          --  Nam is a candidate interpretation for the name in the call,
4916          --  if it is not an indirect call.
4917
4918          if not Is_Type (Nam)
4919             and then Is_Entity_Name (Name (N))
4920          then
4921             Set_Entity (Name (N), Nam);
4922          end if;
4923
4924          return True;
4925       else
4926          return False;
4927       end if;
4928    end Try_Indirect_Call;
4929
4930    ----------------------
4931    -- Try_Indexed_Call --
4932    ----------------------
4933
4934    function Try_Indexed_Call
4935      (N   : Node_Id;
4936       Nam : Entity_Id;
4937       Typ : Entity_Id) return Boolean
4938    is
4939       Actuals : constant List_Id   := Parameter_Associations (N);
4940       Actual : Node_Id;
4941       Index  : Entity_Id;
4942
4943    begin
4944       Actual := First (Actuals);
4945       Index := First_Index (Typ);
4946       while Present (Actual) and then Present (Index) loop
4947
4948          --  If the parameter list has a named association, the expression
4949          --  is definitely a call and not an indexed component.
4950
4951          if Nkind (Actual) = N_Parameter_Association then
4952             return False;
4953          end if;
4954
4955          if not Has_Compatible_Type (Actual, Etype (Index)) then
4956             return False;
4957          end if;
4958
4959          Next (Actual);
4960          Next_Index (Index);
4961       end loop;
4962
4963       if No (Actual) and then No (Index) then
4964          Add_One_Interp (N, Nam, Component_Type (Typ));
4965
4966          --  Nam is a candidate interpretation for the name in the call,
4967          --  if it is not an indirect call.
4968
4969          if not Is_Type (Nam)
4970             and then Is_Entity_Name (Name (N))
4971          then
4972             Set_Entity (Name (N), Nam);
4973          end if;
4974
4975          return True;
4976       else
4977          return False;
4978       end if;
4979    end Try_Indexed_Call;
4980
4981    --------------------------
4982    -- Try_Object_Operation --
4983    --------------------------
4984
4985    function Try_Object_Operation (N : Node_Id) return Boolean is
4986       K              : constant Node_Kind  := Nkind (Parent (N));
4987       Loc            : constant Source_Ptr := Sloc (N);
4988       Candidate      : Entity_Id := Empty;
4989       Is_Subprg_Call : constant Boolean    := K = N_Procedure_Call_Statement
4990                                                or else K = N_Function_Call;
4991       Obj            : constant Node_Id    := Prefix (N);
4992       Subprog        : constant Node_Id    := Selector_Name (N);
4993       Success        : Boolean := False;
4994
4995       Report_Error : Boolean := False;
4996       --  If no candidate interpretation matches the context, redo the
4997       --  analysis with error enabled to provide additional information.
4998
4999       Actual          : Node_Id;
5000       New_Call_Node   : Node_Id := Empty;
5001       Node_To_Replace : Node_Id;
5002       Obj_Type        : Entity_Id := Etype (Obj);
5003
5004       procedure Complete_Object_Operation
5005         (Call_Node       : Node_Id;
5006          Node_To_Replace : Node_Id;
5007          Subprog         : Node_Id);
5008       --  Make Subprog the name of Call_Node, replace Node_To_Replace with
5009       --  Call_Node, insert the object (or its dereference) as the first actual
5010       --  in the call, and complete the analysis of the call.
5011
5012       procedure Transform_Object_Operation
5013         (Call_Node       : out Node_Id;
5014          Node_To_Replace : out Node_Id;
5015          Subprog         : Node_Id);
5016       --  Transform Obj.Operation (X, Y,,) into Operation (Obj, X, Y ..)
5017       --  Call_Node is the resulting subprogram call,
5018       --  Node_To_Replace is either N or the parent of N, and Subprog
5019       --  is a reference to the subprogram we are trying to match.
5020
5021       function Try_Class_Wide_Operation
5022         (Call_Node       : Node_Id;
5023          Node_To_Replace : Node_Id) return Boolean;
5024       --  Traverse all ancestor types looking for a class-wide subprogram
5025       --  for which the current operation is a valid non-dispatching call.
5026
5027       function Try_Primitive_Operation
5028         (Call_Node       : Node_Id;
5029          Node_To_Replace : Node_Id) return Boolean;
5030       --  Traverse the list of primitive subprograms looking for a dispatching
5031       --  operation for which the current node is a valid call .
5032
5033       -------------------------------
5034       -- Complete_Object_Operation --
5035       -------------------------------
5036
5037       procedure Complete_Object_Operation
5038         (Call_Node       : Node_Id;
5039          Node_To_Replace : Node_Id;
5040          Subprog         : Node_Id)
5041       is
5042          Formal_Type  : constant Entity_Id :=
5043                           Etype (First_Formal (Entity (Subprog)));
5044          First_Actual : Node_Id;
5045
5046       begin
5047          First_Actual := First (Parameter_Associations (Call_Node));
5048          Set_Name (Call_Node, Subprog);
5049
5050          --  For cross-reference purposes, treat the new node as being in
5051          --  the source if the original one is.
5052
5053          Set_Comes_From_Source (Subprog, Comes_From_Source (N));
5054          Set_Comes_From_Source (Call_Node, Comes_From_Source (N));
5055
5056          if Nkind (N) = N_Selected_Component
5057            and then not Inside_A_Generic
5058          then
5059             Set_Entity (Selector_Name (N), Entity (Subprog));
5060          end if;
5061
5062          --  If need be, rewrite first actual as an explicit dereference
5063
5064          if not Is_Access_Type (Formal_Type)
5065            and then Is_Access_Type (Etype (Obj))
5066          then
5067             Rewrite (First_Actual,
5068               Make_Explicit_Dereference (Sloc (Obj), Obj));
5069             Analyze (First_Actual);
5070
5071          --  Conversely, if the formal is an access parameter and the
5072          --  object is not, replace the actual with a 'Access reference.
5073          --   Its analysis will check that the object is aliased.
5074
5075          elsif Is_Access_Type (Formal_Type)
5076            and then not Is_Access_Type (Etype (Obj))
5077          then
5078             Rewrite (First_Actual,
5079               Make_Attribute_Reference (Loc,
5080                 Attribute_Name => Name_Access,
5081                 Prefix => Relocate_Node (Obj)));
5082             Analyze (First_Actual);
5083
5084          else
5085             Rewrite (First_Actual, Obj);
5086          end if;
5087
5088          Rewrite (Node_To_Replace, Call_Node);
5089          Analyze (Node_To_Replace);
5090       end Complete_Object_Operation;
5091
5092       --------------------------------
5093       -- Transform_Object_Operation --
5094       --------------------------------
5095
5096       procedure Transform_Object_Operation
5097         (Call_Node       : out Node_Id;
5098          Node_To_Replace : out Node_Id;
5099          Subprog         : Node_Id)
5100       is
5101          Parent_Node : constant Node_Id := Parent (N);
5102
5103          Dummy : constant Node_Id := New_Copy (Obj);
5104          --  Placeholder used as a first parameter in the call, replaced
5105          --  eventually by the proper object.
5106
5107          Actuals : List_Id;
5108          Actual  : Node_Id;
5109
5110       begin
5111          --  Common case covering 1) Call to a procedure and 2) Call to a
5112          --  function that has some additional actuals.
5113
5114          if (Nkind (Parent_Node) = N_Function_Call
5115                or else
5116              Nkind (Parent_Node) = N_Procedure_Call_Statement)
5117
5118             --  N is a selected component node containing the name of the
5119             --  subprogram. If N is not the name of the parent node we must
5120             --  not replace the parent node by the new construct. This case
5121             --  occurs when N is a parameterless call to a subprogram that
5122             --  is an actual parameter of a call to another subprogram. For
5123             --  example:
5124             --            Some_Subprogram (..., Obj.Operation, ...)
5125
5126             and then Name (Parent_Node) = N
5127          then
5128             Node_To_Replace := Parent_Node;
5129
5130             Actuals := Parameter_Associations (Parent_Node);
5131
5132             if Present (Actuals) then
5133                Prepend (Dummy, Actuals);
5134             else
5135                Actuals := New_List (Dummy);
5136             end if;
5137
5138             if Nkind (Parent_Node) = N_Procedure_Call_Statement then
5139                Call_Node :=
5140                  Make_Procedure_Call_Statement (Loc,
5141                    Name => New_Copy_Tree (Subprog),
5142                    Parameter_Associations => Actuals);
5143
5144             else
5145                Call_Node :=
5146                  Make_Function_Call (Loc,
5147                    Name => New_Copy_Tree (Subprog),
5148                    Parameter_Associations => Actuals);
5149
5150             end if;
5151
5152          --  Before analysis, the function call appears as an indexed component
5153          --  if there are no named associations.
5154
5155          elsif Nkind (Parent_Node) =  N_Indexed_Component
5156            and then N = Prefix (Parent_Node)
5157          then
5158             Node_To_Replace := Parent_Node;
5159
5160             Actuals := Expressions (Parent_Node);
5161
5162             Actual := First (Actuals);
5163             while Present (Actual) loop
5164                Analyze (Actual);
5165                Next (Actual);
5166             end loop;
5167
5168             Prepend (Dummy, Actuals);
5169
5170             Call_Node :=
5171                Make_Function_Call (Loc,
5172                  Name => New_Copy_Tree (Subprog),
5173                  Parameter_Associations => Actuals);
5174
5175          --  Parameterless call:  Obj.F is rewritten as F (Obj)
5176
5177          else
5178             Node_To_Replace := N;
5179
5180             Call_Node :=
5181                Make_Function_Call (Loc,
5182                  Name => New_Copy_Tree (Subprog),
5183                  Parameter_Associations => New_List (Dummy));
5184          end if;
5185       end Transform_Object_Operation;
5186
5187       ------------------------------
5188       -- Try_Class_Wide_Operation --
5189       ------------------------------
5190
5191       function Try_Class_Wide_Operation
5192         (Call_Node       : Node_Id;
5193          Node_To_Replace : Node_Id) return Boolean
5194       is
5195          Anc_Type : Entity_Id;
5196          Cls_Type : Entity_Id;
5197          Hom      : Entity_Id;
5198          Hom_Ref  : Node_Id;
5199          Success  : Boolean;
5200
5201       begin
5202          --  Loop through ancestor types, traverse the homonym chain of the
5203          --  subprogram, and try out those homonyms whose first formal has the
5204          --  class-wide type of the ancestor, or an access type to it.
5205
5206          Anc_Type := Obj_Type;
5207
5208          loop
5209             Cls_Type := Class_Wide_Type (Anc_Type);
5210
5211             Hom := Current_Entity (Subprog);
5212             while Present (Hom) loop
5213                if (Ekind (Hom) = E_Procedure
5214                      or else
5215                    Ekind (Hom) = E_Function)
5216                  and then Scope (Hom) = Scope (Anc_Type)
5217                  and then Present (First_Formal (Hom))
5218                  and then
5219                    (Etype (First_Formal (Hom)) = Cls_Type
5220                      or else
5221                        (Is_Access_Type (Etype (First_Formal (Hom)))
5222                           and then
5223                             Designated_Type (Etype (First_Formal (Hom))) =
5224                                                                  Cls_Type))
5225                then
5226                   Hom_Ref := New_Reference_To (Hom, Sloc (Subprog));
5227                   Set_Etype (Call_Node, Any_Type);
5228                   Set_Parent (Call_Node, Parent (Node_To_Replace));
5229
5230                   Set_Name (Call_Node, Hom_Ref);
5231
5232                   Analyze_One_Call
5233                     (N          => Call_Node,
5234                      Nam        => Hom,
5235                      Report     => Report_Error,
5236                      Success    => Success,
5237                      Skip_First => True);
5238
5239                   if Success then
5240
5241                      --  Reformat into the proper call
5242
5243                      Complete_Object_Operation
5244                        (Call_Node       => Call_Node,
5245                         Node_To_Replace => Node_To_Replace,
5246                         Subprog         => Hom_Ref);
5247
5248                      return True;
5249                   end if;
5250                end if;
5251
5252                Hom := Homonym (Hom);
5253             end loop;
5254
5255             --  Examine other ancestor types
5256
5257             exit when Etype (Anc_Type) = Anc_Type;
5258             Anc_Type := Etype (Anc_Type);
5259          end loop;
5260
5261          --  Nothing matched
5262
5263          return False;
5264       end Try_Class_Wide_Operation;
5265
5266       -----------------------------
5267       -- Try_Primitive_Operation --
5268       -----------------------------
5269
5270       function Try_Primitive_Operation
5271         (Call_Node       : Node_Id;
5272          Node_To_Replace : Node_Id) return Boolean
5273       is
5274          Elmt        : Elmt_Id;
5275          Prim_Op     : Entity_Id;
5276          Prim_Op_Ref : Node_Id := Empty;
5277          Success     : Boolean := False;
5278          Op_Exists   : Boolean := False;
5279
5280          function Valid_First_Argument_Of (Op : Entity_Id) return Boolean;
5281          --  Verify that the prefix, dereferenced if need be, is a valid
5282          --  controlling argument in a call to Op. The remaining actuals
5283          --  are checked in the subsequent call to Analyze_One_Call.
5284
5285          -----------------------------
5286          -- Valid_First_Argument_Of --
5287          -----------------------------
5288
5289          function Valid_First_Argument_Of (Op : Entity_Id) return Boolean is
5290             Typ : constant Entity_Id := Etype (First_Formal (Op));
5291
5292          begin
5293             --  Simple case
5294
5295             return Base_Type (Obj_Type) = Typ
5296
5297             --  Prefix can be dereferenced
5298
5299               or else
5300                 (Is_Access_Type (Obj_Type)
5301                   and then Designated_Type (Obj_Type) = Typ)
5302
5303             --  Formal is an access parameter, for which the object
5304             --  can provide an access.
5305
5306               or else
5307                 (Ekind (Typ) = E_Anonymous_Access_Type
5308                   and then Designated_Type (Typ) = Base_Type (Obj_Type));
5309          end Valid_First_Argument_Of;
5310
5311       --  Start of processing for Try_Primitive_Operation
5312
5313       begin
5314          --  Look for subprograms in the list of primitive operations
5315          --  The name must be identical, and the kind of call indicates the
5316          --  expected kind of operation (function or procedure).
5317
5318          Elmt := First_Elmt (Primitive_Operations (Obj_Type));
5319          while Present (Elmt) loop
5320             Prim_Op := Node (Elmt);
5321
5322             if Chars (Prim_Op) = Chars (Subprog)
5323               and then Present (First_Formal (Prim_Op))
5324               and then Valid_First_Argument_Of (Prim_Op)
5325               and then
5326                  (Nkind (Call_Node) = N_Function_Call)
5327                    = (Ekind (Prim_Op) = E_Function)
5328             then
5329                --  Ada 2005 (AI-251): If this primitive operation corresponds
5330                --  with an immediate ancestor interface there is no need to add
5331                --  it to the list of interpretations; the corresponding aliased
5332                --  primitive is also in this list of primitive operations and
5333                --  will be used instead.
5334
5335                if Present (Abstract_Interface_Alias (Prim_Op))
5336                  and then Is_Ancestor (Find_Dispatching_Type
5337                                          (Alias (Prim_Op)), Obj_Type)
5338                then
5339                   goto Continue;
5340                end if;
5341
5342                if not Success then
5343                   Prim_Op_Ref := New_Reference_To (Prim_Op, Sloc (Subprog));
5344                   Candidate := Prim_Op;
5345
5346                   Set_Etype (Call_Node, Any_Type);
5347                   Set_Parent (Call_Node, Parent (Node_To_Replace));
5348
5349                   Set_Name (Call_Node, Prim_Op_Ref);
5350
5351                   Analyze_One_Call
5352                     (N          => Call_Node,
5353                      Nam        => Prim_Op,
5354                      Report     => Report_Error,
5355                      Success    => Success,
5356                      Skip_First => True);
5357
5358                   if Success then
5359                      Op_Exists := True;
5360
5361                      --  If the operation is a procedure call, there can only
5362                      --  be one candidate and we found it. If it is a function
5363                      --  we must collect all interpretations, because there
5364                      --  may be several primitive operations that differ only
5365                      --  in the return type.
5366
5367                      if Nkind (Call_Node) = N_Procedure_Call_Statement then
5368                         exit;
5369                      end if;
5370                   end if;
5371
5372                elsif Ekind (Prim_Op) = E_Function then
5373
5374                   --  Collect remaining function interpretations, to be
5375                   --  resolved from context.
5376
5377                   Add_One_Interp (Prim_Op_Ref, Prim_Op, Etype (Prim_Op));
5378                end if;
5379             end if;
5380
5381             <<Continue>>
5382             Next_Elmt (Elmt);
5383          end loop;
5384
5385          if Op_Exists then
5386             Complete_Object_Operation
5387               (Call_Node       => Call_Node,
5388                Node_To_Replace => Node_To_Replace,
5389                Subprog         => Prim_Op_Ref);
5390          end if;
5391
5392          return Op_Exists;
5393       end Try_Primitive_Operation;
5394
5395    --  Start of processing for Try_Object_Operation
5396
5397    begin
5398       if Is_Access_Type (Obj_Type) then
5399          Obj_Type := Designated_Type (Obj_Type);
5400       end if;
5401
5402       if Ekind (Obj_Type) = E_Private_Subtype then
5403          Obj_Type := Base_Type (Obj_Type);
5404       end if;
5405
5406       if Is_Class_Wide_Type (Obj_Type) then
5407          Obj_Type := Etype (Class_Wide_Type (Obj_Type));
5408       end if;
5409
5410       --  The type may have be obtained through a limited_with clause,
5411       --  in which case the primitive operations are available on its
5412       --  non-limited view.
5413
5414       if Ekind (Obj_Type) = E_Incomplete_Type
5415         and then From_With_Type (Obj_Type)
5416       then
5417          Obj_Type := Non_Limited_View (Obj_Type);
5418       end if;
5419
5420       if not Is_Tagged_Type (Obj_Type) then
5421          return False;
5422       end if;
5423
5424       --  Analyze the actuals if node is know to be a subprogram call
5425
5426       if Is_Subprg_Call and then N = Name (Parent (N)) then
5427          Actual := First (Parameter_Associations (Parent (N)));
5428          while Present (Actual) loop
5429             Analyze_Expression (Actual);
5430             Next (Actual);
5431          end loop;
5432       end if;
5433
5434       Analyze_Expression (Obj);
5435
5436       --  Build a subprogram call node, using a copy of Obj as its first
5437       --  actual. This is a placeholder, to be replaced by an explicit
5438       --  dereference when needed.
5439
5440       Transform_Object_Operation
5441         (Call_Node       => New_Call_Node,
5442          Node_To_Replace => Node_To_Replace,
5443          Subprog         => Subprog);
5444
5445       Set_Etype (New_Call_Node, Any_Type);
5446       Set_Parent (New_Call_Node, Parent (Node_To_Replace));
5447
5448       if Try_Primitive_Operation
5449           (Call_Node       => New_Call_Node,
5450            Node_To_Replace => Node_To_Replace)
5451
5452         or else
5453           Try_Class_Wide_Operation
5454             (Call_Node       => New_Call_Node,
5455              Node_To_Replace => Node_To_Replace)
5456       then
5457          return True;
5458
5459       elsif Present (Candidate) then
5460
5461          --  The argument list is not type correct. Re-analyze with error
5462          --  reporting enabled, and use one of the possible candidates.
5463          --  In all_errors mode, re-analyze all failed interpretations.
5464
5465          if All_Errors_Mode then
5466             Report_Error := True;
5467             if Try_Primitive_Operation
5468                 (Call_Node       => New_Call_Node,
5469                  Node_To_Replace => Node_To_Replace)
5470
5471               or else
5472                 Try_Class_Wide_Operation
5473                   (Call_Node       => New_Call_Node,
5474                    Node_To_Replace => Node_To_Replace)
5475             then
5476                null;
5477             end if;
5478
5479          else
5480             Analyze_One_Call
5481               (N          => New_Call_Node,
5482                Nam        => Candidate,
5483                Report     => True,
5484                Success    => Success,
5485                Skip_First => True);
5486          end if;
5487
5488          return True;  --  No need for further errors.
5489
5490       else
5491          --  There was no candidate operation, so report it as an error
5492          --  in the caller: Analyze_Selected_Component.
5493
5494          return False;
5495       end if;
5496    end Try_Object_Operation;
5497
5498 end Sem_Ch4;