gcc/ada/par-ch4.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P A R . C H 4                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2011, 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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 pragma Style_Checks (All_Checks);
  27 --  Turn off subprogram body ordering check. Subprograms are in order
  28 --  by RM section rather than alphabetical
  29
  30 with Stringt; use Stringt;
  31
  32 separate (Par)
  33 package body Ch4 is
  34
  35    --  Attributes that cannot have arguments
  36
  37    Is_Parameterless_Attribute : constant Attribute_Class_Array :=
  38      (Attribute_Body_Version => True,
  39       Attribute_External_Tag => True,
  40       Attribute_Img          => True,
  41       Attribute_Version      => True,
  42       Attribute_Base         => True,
  43       Attribute_Class        => True,
  44       Attribute_Stub_Type    => True,
  45       Attribute_Type_Key     => True,
  46       others                 => False);
  47    --  This map contains True for parameterless attributes that return a
  48    --  string or a type. For those attributes, a left parenthesis after
  49    --  the attribute should not be analyzed as the beginning of a parameters
  50    --  list because it may denote a slice operation (X'Img (1 .. 2)) or
  51    --  a type conversion (X'Class (Y)).
  52
  53    --  Note that this map designates the minimum set of attributes where a
  54    --  construct in parentheses that is not an argument can appear right
  55    --  after the attribute. For attributes like 'Size, we do not put them
  56    --  in the map. If someone writes X'Size (3), that's illegal in any case,
  57    --  but we get a better error message by parsing the (3) as an illegal
  58    --  argument to the attribute, rather than some meaningless junk that
  59    --  follows the attribute.
  60
  61    -----------------------
  62    -- Local Subprograms --
  63    -----------------------
  64
  65    function P_Aggregate_Or_Paren_Expr                 return Node_Id;
  66    function P_Allocator                               return Node_Id;
  67    function P_Case_Expression_Alternative             return Node_Id;
  68    function P_Record_Or_Array_Component_Association   return Node_Id;
  69    function P_Factor                                  return Node_Id;
  70    function P_Primary                                 return Node_Id;
  71    function P_Relation                                return Node_Id;
  72    function P_Term                                    return Node_Id;
  73
  74    function P_Binary_Adding_Operator                  return Node_Kind;
  75    function P_Logical_Operator                        return Node_Kind;
  76    function P_Multiplying_Operator                    return Node_Kind;
  77    function P_Relational_Operator                     return Node_Kind;
  78    function P_Unary_Adding_Operator                   return Node_Kind;
  79
  80    procedure Bad_Range_Attribute (Loc : Source_Ptr);
  81    --  Called to place complaint about bad range attribute at the given
  82    --  source location. Terminates by raising Error_Resync.
  83
  84    procedure P_Membership_Test (N : Node_Id);
  85    --  N is the node for a N_In or N_Not_In node whose right operand has not
  86    --  yet been processed. It is called just after scanning out the IN keyword.
  87    --  On return, either Right_Opnd or Alternatives is set, as appropriate.
  88
  89    function P_Range_Attribute_Reference (Prefix_Node : Node_Id) return Node_Id;
  90    --  Scan a range attribute reference. The caller has scanned out the
  91    --  prefix. The current token is known to be an apostrophe and the
  92    --  following token is known to be RANGE.
  93
  94    -------------------------
  95    -- Bad_Range_Attribute --
  96    -------------------------
  97
  98    procedure Bad_Range_Attribute (Loc : Source_Ptr) is
  99    begin
 100       Error_Msg ("range attribute cannot be used in expression!", Loc);
 101       Resync_Expression;
 102    end Bad_Range_Attribute;
 103
 104    --------------------------
 105    -- 4.1  Name (also 6.4) --
 106    --------------------------
 107
 108    --  NAME ::=
 109    --    DIRECT_NAME        | EXPLICIT_DEREFERENCE
 110    --  | INDEXED_COMPONENT  | SLICE
 111    --  | SELECTED_COMPONENT | ATTRIBUTE
 112    --  | TYPE_CONVERSION    | FUNCTION_CALL
 113    --  | CHARACTER_LITERAL
 114
 115    --  DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
 116
 117    --  PREFIX ::= NAME | IMPLICIT_DEREFERENCE
 118
 119    --  EXPLICIT_DEREFERENCE ::= NAME . all
 120
 121    --  IMPLICIT_DEREFERENCE ::= NAME
 122
 123    --  INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
 124
 125    --  SLICE ::= PREFIX (DISCRETE_RANGE)
 126
 127    --  SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
 128
 129    --  SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
 130
 131    --  ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
 132
 133    --  ATTRIBUTE_DESIGNATOR ::=
 134    --    IDENTIFIER [(static_EXPRESSION)]
 135    --  | access | delta | digits
 136
 137    --  FUNCTION_CALL ::=
 138    --    function_NAME
 139    --  | function_PREFIX ACTUAL_PARAMETER_PART
 140
 141    --  ACTUAL_PARAMETER_PART ::=
 142    --    (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
 143
 144    --  PARAMETER_ASSOCIATION ::=
 145    --    [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
 146
 147    --  EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
 148
 149    --  Note: syntactically a procedure call looks just like a function call,
 150    --  so this routine is in practice used to scan out procedure calls as well.
 151
 152    --  On return, Expr_Form is set to either EF_Name or EF_Simple_Name
 153
 154    --  Error recovery: can raise Error_Resync
 155
 156    --  Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
 157    --  followed by either a left paren (qualified expression case), or by
 158    --  range (range attribute case). All other uses of apostrophe (i.e. all
 159    --  other attributes) are handled in this routine.
 160
 161    --  Error recovery: can raise Error_Resync
 162
 163    function P_Name return Node_Id is
 164       Scan_State  : Saved_Scan_State;
 165       Name_Node   : Node_Id;
 166       Prefix_Node : Node_Id;
 167       Ident_Node  : Node_Id;
 168       Expr_Node   : Node_Id;
 169       Range_Node  : Node_Id;
 170       Arg_Node    : Node_Id;
 171
 172       Arg_List  : List_Id := No_List; -- kill junk warning
 173       Attr_Name : Name_Id := No_Name; -- kill junk warning
 174
 175    begin
 176       --  Case of not a name
 177
 178       if Token not in Token_Class_Name then
 179
 180          --  If it looks like start of expression, complain and scan expression
 181
 182          if Token in Token_Class_Literal
 183            or else Token = Tok_Left_Paren
 184          then
 185             Error_Msg_SC ("name expected");
 186             return P_Expression;
 187
 188          --  Otherwise some other junk, not much we can do
 189
 190          else
 191             Error_Msg_AP ("name expected");
 192             raise Error_Resync;
 193          end if;
 194       end if;
 195
 196       --  Loop through designators in qualified name
 197
 198       Name_Node := Token_Node;
 199
 200       loop
 201          Scan; -- past designator
 202          exit when Token /= Tok_Dot;
 203          Save_Scan_State (Scan_State); -- at dot
 204          Scan; -- past dot
 205
 206          --  If we do not have another designator after the dot, then join
 207          --  the normal circuit to handle a dot extension (may be .all or
 208          --  character literal case). Otherwise loop back to scan the next
 209          --  designator.
 210
 211          if Token not in Token_Class_Desig then
 212             goto Scan_Name_Extension_Dot;
 213          else
 214             Prefix_Node := Name_Node;
 215             Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
 216             Set_Prefix (Name_Node, Prefix_Node);
 217             Set_Selector_Name (Name_Node, Token_Node);
 218          end if;
 219       end loop;
 220
 221       --  We have now scanned out a qualified designator. If the last token is
 222       --  an operator symbol, then we certainly do not have the Snam case, so
 223       --  we can just use the normal name extension check circuit
 224
 225       if Prev_Token = Tok_Operator_Symbol then
 226          goto Scan_Name_Extension;
 227       end if;
 228
 229       --  We have scanned out a qualified simple name, check for name extension
 230       --  Note that we know there is no dot here at this stage, so the only
 231       --  possible cases of name extension are apostrophe and left paren.
 232
 233       if Token = Tok_Apostrophe then
 234          Save_Scan_State (Scan_State); -- at apostrophe
 235          Scan; -- past apostrophe
 236
 237          --  Qualified expression in Ada 2012 mode (treated as a name)
 238
 239          if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
 240             goto Scan_Name_Extension_Apostrophe;
 241
 242          --  If left paren not in Ada 2012, then it is not part of the name,
 243          --  since qualified expressions are not names in prior versions of
 244          --  Ada, so return with Token backed up to point to the apostrophe.
 245          --  The treatment for the range attribute is similar (we do not
 246          --  consider x'range to be a name in this grammar).
 247
 248          elsif Token = Tok_Left_Paren or else Token = Tok_Range then
 249             Restore_Scan_State (Scan_State); -- to apostrophe
 250             Expr_Form := EF_Simple_Name;
 251             return Name_Node;
 252
 253          --  Otherwise we have the case of a name extended by an attribute
 254
 255          else
 256             goto Scan_Name_Extension_Apostrophe;
 257          end if;
 258
 259       --  Check case of qualified simple name extended by a left parenthesis
 260
 261       elsif Token = Tok_Left_Paren then
 262          Scan; -- past left paren
 263          goto Scan_Name_Extension_Left_Paren;
 264
 265       --  Otherwise the qualified simple name is not extended, so return
 266
 267       else
 268          Expr_Form := EF_Simple_Name;
 269          return Name_Node;
 270       end if;
 271
 272       --  Loop scanning past name extensions. A label is used for control
 273       --  transfer for this loop for ease of interfacing with the finite state
 274       --  machine in the parenthesis scanning circuit, and also to allow for
 275       --  passing in control to the appropriate point from the above code.
 276
 277       <<Scan_Name_Extension>>
 278
 279          --  Character literal used as name cannot be extended. Also this
 280          --  cannot be a call, since the name for a call must be a designator.
 281          --  Return in these cases, or if there is no name extension
 282
 283          if Token not in Token_Class_Namext
 284            or else Prev_Token = Tok_Char_Literal
 285          then
 286             Expr_Form := EF_Name;
 287             return Name_Node;
 288          end if;
 289
 290       --  Merge here when we know there is a name extension
 291
 292       <<Scan_Name_Extension_OK>>
 293
 294          if Token = Tok_Left_Paren then
 295             Scan; -- past left paren
 296             goto Scan_Name_Extension_Left_Paren;
 297
 298          elsif Token = Tok_Apostrophe then
 299             Save_Scan_State (Scan_State); -- at apostrophe
 300             Scan; -- past apostrophe
 301             goto Scan_Name_Extension_Apostrophe;
 302
 303          else -- Token = Tok_Dot
 304             Save_Scan_State (Scan_State); -- at dot
 305             Scan; -- past dot
 306             goto Scan_Name_Extension_Dot;
 307          end if;
 308
 309       --  Case of name extended by dot (selection), dot is already skipped
 310       --  and the scan state at the point of the dot is saved in Scan_State.
 311
 312       <<Scan_Name_Extension_Dot>>
 313
 314          --  Explicit dereference case
 315
 316          if Token = Tok_All then
 317             Prefix_Node := Name_Node;
 318             Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
 319             Set_Prefix (Name_Node, Prefix_Node);
 320             Scan; -- past ALL
 321             goto Scan_Name_Extension;
 322
 323          --  Selected component case
 324
 325          elsif Token in Token_Class_Name then
 326             Prefix_Node := Name_Node;
 327             Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
 328             Set_Prefix (Name_Node, Prefix_Node);
 329             Set_Selector_Name (Name_Node, Token_Node);
 330             Scan; -- past selector
 331             goto Scan_Name_Extension;
 332
 333          --  Reserved identifier as selector
 334
 335          elsif Is_Reserved_Identifier then
 336             Scan_Reserved_Identifier (Force_Msg => False);
 337             Prefix_Node := Name_Node;
 338             Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
 339             Set_Prefix (Name_Node, Prefix_Node);
 340             Set_Selector_Name (Name_Node, Token_Node);
 341             Scan; -- past identifier used as selector
 342             goto Scan_Name_Extension;
 343
 344          --  If dot is at end of line and followed by nothing legal,
 345          --  then assume end of name and quit (dot will be taken as
 346          --  an erroneous form of some other punctuation by our caller).
 347
 348          elsif Token_Is_At_Start_Of_Line then
 349             Restore_Scan_State (Scan_State);
 350             return Name_Node;
 351
 352          --  Here if nothing legal after the dot
 353
 354          else
 355             Error_Msg_AP ("selector expected");
 356             raise Error_Resync;
 357          end if;
 358
 359       --  Here for an apostrophe as name extension. The scan position at the
 360       --  apostrophe has already been saved, and the apostrophe scanned out.
 361
 362       <<Scan_Name_Extension_Apostrophe>>
 363
 364          Scan_Apostrophe : declare
 365             function Apostrophe_Should_Be_Semicolon return Boolean;
 366             --  Checks for case where apostrophe should probably be
 367             --  a semicolon, and if so, gives appropriate message,
 368             --  resets the scan pointer to the apostrophe, changes
 369             --  the current token to Tok_Semicolon, and returns True.
 370             --  Otherwise returns False.
 371
 372             ------------------------------------
 373             -- Apostrophe_Should_Be_Semicolon --
 374             ------------------------------------
 375
 376             function Apostrophe_Should_Be_Semicolon return Boolean is
 377             begin
 378                if Token_Is_At_Start_Of_Line then
 379                   Restore_Scan_State (Scan_State); -- to apostrophe
 380                   Error_Msg_SC ("|""''"" should be "";""");
 381                   Token := Tok_Semicolon;
 382                   return True;
 383                else
 384                   return False;
 385                end if;
 386             end Apostrophe_Should_Be_Semicolon;
 387
 388          --  Start of processing for Scan_Apostrophe
 389
 390          begin
 391             --  Check for qualified expression case in Ada 2012 mode
 392
 393             if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
 394                Name_Node := P_Qualified_Expression (Name_Node);
 395                goto Scan_Name_Extension;
 396
 397             --  If range attribute after apostrophe, then return with Token
 398             --  pointing to the apostrophe. Note that in this case the prefix
 399             --  need not be a simple name (cases like A.all'range). Similarly
 400             --  if there is a left paren after the apostrophe, then we also
 401             --  return with Token pointing to the apostrophe (this is the
 402             --  aggregate case, or some error case).
 403
 404             elsif Token = Tok_Range or else Token = Tok_Left_Paren then
 405                Restore_Scan_State (Scan_State); -- to apostrophe
 406                Expr_Form := EF_Name;
 407                return Name_Node;
 408
 409             --  Here for cases where attribute designator is an identifier
 410
 411             elsif Token = Tok_Identifier then
 412                Attr_Name := Token_Name;
 413
 414                if not Is_Attribute_Name (Attr_Name) then
 415                   if Apostrophe_Should_Be_Semicolon then
 416                      Expr_Form := EF_Name;
 417                      return Name_Node;
 418
 419                   --  Here for a bad attribute name
 420
 421                   else
 422                      Signal_Bad_Attribute;
 423                      Scan; -- past bad identifier
 424
 425                      if Token = Tok_Left_Paren then
 426                         Scan; -- past left paren
 427
 428                         loop
 429                            Discard_Junk_Node (P_Expression_If_OK);
 430                            exit when not  Comma_Present;
 431                         end loop;
 432
 433                         T_Right_Paren;
 434                      end if;
 435
 436                      return Error;
 437                   end if;
 438                end if;
 439
 440                if Style_Check then
 441                   Style.Check_Attribute_Name (False);
 442                end if;
 443
 444             --  Here for case of attribute designator is not an identifier
 445
 446             else
 447                if Token = Tok_Delta then
 448                   Attr_Name := Name_Delta;
 449
 450                elsif Token = Tok_Digits then
 451                   Attr_Name := Name_Digits;
 452
 453                elsif Token = Tok_Access then
 454                   Attr_Name := Name_Access;
 455
 456                elsif Token = Tok_Mod and then Ada_Version >= Ada_95 then
 457                   Attr_Name := Name_Mod;
 458
 459                elsif Apostrophe_Should_Be_Semicolon then
 460                   Expr_Form := EF_Name;
 461                   return Name_Node;
 462
 463                else
 464                   Error_Msg_AP ("attribute designator expected");
 465                   raise Error_Resync;
 466                end if;
 467
 468                if Style_Check then
 469                   Style.Check_Attribute_Name (True);
 470                end if;
 471             end if;
 472
 473             --  We come here with an OK attribute scanned, and the
 474             --  corresponding Attribute identifier node stored in Ident_Node.
 475
 476             Prefix_Node := Name_Node;
 477             Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
 478             Scan; -- past attribute designator
 479             Set_Prefix (Name_Node, Prefix_Node);
 480             Set_Attribute_Name (Name_Node, Attr_Name);
 481
 482             --  Scan attribute arguments/designator. We skip this if we know
 483             --  that the attribute cannot have an argument.
 484
 485             if Token = Tok_Left_Paren
 486               and then not
 487                 Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
 488             then
 489                Set_Expressions (Name_Node, New_List);
 490                Scan; -- past left paren
 491
 492                loop
 493                   declare
 494                      Expr : constant Node_Id := P_Expression_If_OK;
 495
 496                   begin
 497                      if Token = Tok_Arrow then
 498                         Error_Msg_SC
 499                           ("named parameters not permitted for attributes");
 500                         Scan; -- past junk arrow
 501
 502                      else
 503                         Append (Expr, Expressions (Name_Node));
 504                         exit when not Comma_Present;
 505                      end if;
 506                   end;
 507                end loop;
 508
 509                T_Right_Paren;
 510             end if;
 511
 512             goto Scan_Name_Extension;
 513          end Scan_Apostrophe;
 514
 515       --  Here for left parenthesis extending name (left paren skipped)
 516
 517       <<Scan_Name_Extension_Left_Paren>>
 518
 519          --  We now have to scan through a list of items, terminated by a
 520          --  right parenthesis. The scan is handled by a finite state
 521          --  machine. The possibilities are:
 522
 523          --   (discrete_range)
 524
 525          --      This is a slice. This case is handled in LP_State_Init
 526
 527          --   (expression, expression, ..)
 528
 529          --      This is interpreted as an indexed component, i.e. as a
 530          --      case of a name which can be extended in the normal manner.
 531          --      This case is handled by LP_State_Name or LP_State_Expr.
 532
 533          --      Note: conditional expressions (without an extra level of
 534          --      parentheses) are permitted in this context).
 535
 536          --   (..., identifier => expression , ...)
 537
 538          --      If there is at least one occurrence of identifier => (but
 539          --      none of the other cases apply), then we have a call.
 540
 541          --  Test for Id => case
 542
 543          if Token = Tok_Identifier then
 544             Save_Scan_State (Scan_State); -- at Id
 545             Scan; -- past Id
 546
 547             --  Test for => (allow := as an error substitute)
 548
 549             if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
 550                Restore_Scan_State (Scan_State); -- to Id
 551                Arg_List := New_List;
 552                goto LP_State_Call;
 553
 554             else
 555                Restore_Scan_State (Scan_State); -- to Id
 556             end if;
 557          end if;
 558
 559          --  Here we have an expression after all
 560
 561          Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
 562
 563          --  Check cases of discrete range for a slice
 564
 565          --  First possibility: Range_Attribute_Reference
 566
 567          if Expr_Form = EF_Range_Attr then
 568             Range_Node := Expr_Node;
 569
 570          --  Second possibility: Simple_expression .. Simple_expression
 571
 572          elsif Token = Tok_Dot_Dot then
 573             Check_Simple_Expression (Expr_Node);
 574             Range_Node := New_Node (N_Range, Token_Ptr);
 575             Set_Low_Bound (Range_Node, Expr_Node);
 576             Scan; -- past ..
 577             Expr_Node := P_Expression;
 578             Check_Simple_Expression (Expr_Node);
 579             Set_High_Bound (Range_Node, Expr_Node);
 580
 581          --  Third possibility: Type_name range Range
 582
 583          elsif Token = Tok_Range then
 584             if Expr_Form /= EF_Simple_Name then
 585                Error_Msg_SC ("subtype mark must precede RANGE");
 586                raise Error_Resync;
 587             end if;
 588
 589             Range_Node := P_Subtype_Indication (Expr_Node);
 590
 591          --  Otherwise we just have an expression. It is true that we might
 592          --  have a subtype mark without a range constraint but this case
 593          --  is syntactically indistinguishable from the expression case.
 594
 595          else
 596             Arg_List := New_List;
 597             goto LP_State_Expr;
 598          end if;
 599
 600          --  Fall through here with unmistakable Discrete range scanned,
 601          --  which means that we definitely have the case of a slice. The
 602          --  Discrete range is in Range_Node.
 603
 604          if Token = Tok_Comma then
 605             Error_Msg_SC ("slice cannot have more than one dimension");
 606             raise Error_Resync;
 607
 608          elsif Token /= Tok_Right_Paren then
 609             if Token = Tok_Arrow then
 610
 611                --  This may be an aggregate that is missing a qualification
 612
 613                Error_Msg_SC
 614                  ("context of aggregate must be a qualified expression");
 615                raise Error_Resync;
 616
 617             else
 618                T_Right_Paren;
 619                raise Error_Resync;
 620             end if;
 621
 622          else
 623             Scan; -- past right paren
 624             Prefix_Node := Name_Node;
 625             Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
 626             Set_Prefix (Name_Node, Prefix_Node);
 627             Set_Discrete_Range (Name_Node, Range_Node);
 628
 629             --  An operator node is legal as a prefix to other names,
 630             --  but not for a slice.
 631
 632             if Nkind (Prefix_Node) = N_Operator_Symbol then
 633                Error_Msg_N ("illegal prefix for slice", Prefix_Node);
 634             end if;
 635
 636             --  If we have a name extension, go scan it
 637
 638             if Token in Token_Class_Namext then
 639                goto Scan_Name_Extension_OK;
 640
 641             --  Otherwise return (a slice is a name, but is not a call)
 642
 643             else
 644                Expr_Form := EF_Name;
 645                return Name_Node;
 646             end if;
 647          end if;
 648
 649       --  In LP_State_Expr, we have scanned one or more expressions, and
 650       --  so we have a call or an indexed component which is a name. On
 651       --  entry we have the expression just scanned in Expr_Node and
 652       --  Arg_List contains the list of expressions encountered so far
 653
 654       <<LP_State_Expr>>
 655          Append (Expr_Node, Arg_List);
 656
 657          if Token = Tok_Arrow then
 658             Error_Msg
 659               ("expect identifier in parameter association",
 660                 Sloc (Expr_Node));
 661             Scan;  --   past arrow
 662
 663          elsif not Comma_Present then
 664             T_Right_Paren;
 665             Prefix_Node := Name_Node;
 666             Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
 667             Set_Prefix (Name_Node, Prefix_Node);
 668             Set_Expressions (Name_Node, Arg_List);
 669             goto Scan_Name_Extension;
 670          end if;
 671
 672          --  Comma present (and scanned out), test for identifier => case
 673          --  Test for identifier => case
 674
 675          if Token = Tok_Identifier then
 676             Save_Scan_State (Scan_State); -- at Id
 677             Scan; -- past Id
 678
 679             --  Test for => (allow := as error substitute)
 680
 681             if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
 682                Restore_Scan_State (Scan_State); -- to Id
 683                goto LP_State_Call;
 684
 685             --  Otherwise it's just an expression after all, so backup
 686
 687             else
 688                Restore_Scan_State (Scan_State); -- to Id
 689             end if;
 690          end if;
 691
 692          --  Here we have an expression after all, so stay in this state
 693
 694          Expr_Node := P_Expression_If_OK;
 695          goto LP_State_Expr;
 696
 697       --  LP_State_Call corresponds to the situation in which at least
 698       --  one instance of Id => Expression has been encountered, so we
 699       --  know that we do not have a name, but rather a call. We enter
 700       --  it with the scan pointer pointing to the next argument to scan,
 701       --  and Arg_List containing the list of arguments scanned so far.
 702
 703       <<LP_State_Call>>
 704
 705          --  Test for case of Id => Expression (named parameter)
 706
 707          if Token = Tok_Identifier then
 708             Save_Scan_State (Scan_State); -- at Id
 709             Ident_Node := Token_Node;
 710             Scan; -- past Id
 711
 712             --  Deal with => (allow := as erroneous substitute)
 713
 714             if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
 715                Arg_Node := New_Node (N_Parameter_Association, Prev_Token_Ptr);
 716                Set_Selector_Name (Arg_Node, Ident_Node);
 717                T_Arrow;
 718                Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
 719                Append (Arg_Node, Arg_List);
 720
 721                --  If a comma follows, go back and scan next entry
 722
 723                if Comma_Present then
 724                   goto LP_State_Call;
 725
 726                --  Otherwise we have the end of a call
 727
 728                else
 729                   Prefix_Node := Name_Node;
 730                   Name_Node := New_Node (N_Function_Call, Sloc (Prefix_Node));
 731                   Set_Name (Name_Node, Prefix_Node);
 732                   Set_Parameter_Associations (Name_Node, Arg_List);
 733                   T_Right_Paren;
 734
 735                   if Token in Token_Class_Namext then
 736                      goto Scan_Name_Extension_OK;
 737
 738                   --  This is a case of a call which cannot be a name
 739
 740                   else
 741                      Expr_Form := EF_Name;
 742                      return Name_Node;
 743                   end if;
 744                end if;
 745
 746             --  Not named parameter: Id started an expression after all
 747
 748             else
 749                Restore_Scan_State (Scan_State); -- to Id
 750             end if;
 751          end if;
 752
 753          --  Here if entry did not start with Id => which means that it
 754          --  is a positional parameter, which is not allowed, since we
 755          --  have seen at least one named parameter already.
 756
 757          Error_Msg_SC
 758             ("positional parameter association " &
 759               "not allowed after named one");
 760
 761          Expr_Node := P_Expression_If_OK;
 762
 763          --  Leaving the '>' in an association is not unusual, so suggest
 764          --  a possible fix.
 765
 766          if Nkind (Expr_Node) = N_Op_Eq then
 767             Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
 768          end if;
 769
 770          --  We go back to scanning out expressions, so that we do not get
 771          --  multiple error messages when several positional parameters
 772          --  follow a named parameter.
 773
 774          goto LP_State_Expr;
 775
 776          --  End of treatment for name extensions starting with left paren
 777
 778       --  End of loop through name extensions
 779
 780    end P_Name;
 781
 782    --  This function parses a restricted form of Names which are either
 783    --  designators, or designators preceded by a sequence of prefixes
 784    --  that are direct names.
 785
 786    --  Error recovery: cannot raise Error_Resync
 787
 788    function P_Function_Name return Node_Id is
 789       Designator_Node : Node_Id;
 790       Prefix_Node     : Node_Id;
 791       Selector_Node   : Node_Id;
 792       Dot_Sloc        : Source_Ptr := No_Location;
 793
 794    begin
 795       --  Prefix_Node is set to the gathered prefix so far, Empty means that
 796       --  no prefix has been scanned. This allows us to build up the result
 797       --  in the required right recursive manner.
 798
 799       Prefix_Node := Empty;
 800
 801       --  Loop through prefixes
 802
 803       loop
 804          Designator_Node := Token_Node;
 805
 806          if Token not in Token_Class_Desig then
 807             return P_Identifier; -- let P_Identifier issue the error message
 808
 809          else -- Token in Token_Class_Desig
 810             Scan; -- past designator
 811             exit when Token /= Tok_Dot;
 812          end if;
 813
 814          --  Here at a dot, with token just before it in Designator_Node
 815
 816          if No (Prefix_Node) then
 817             Prefix_Node := Designator_Node;
 818          else
 819             Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 820             Set_Prefix (Selector_Node, Prefix_Node);
 821             Set_Selector_Name (Selector_Node, Designator_Node);
 822             Prefix_Node := Selector_Node;
 823          end if;
 824
 825          Dot_Sloc := Token_Ptr;
 826          Scan; -- past dot
 827       end loop;
 828
 829       --  Fall out of the loop having just scanned a designator
 830
 831       if No (Prefix_Node) then
 832          return Designator_Node;
 833       else
 834          Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 835          Set_Prefix (Selector_Node, Prefix_Node);
 836          Set_Selector_Name (Selector_Node, Designator_Node);
 837          return Selector_Node;
 838       end if;
 839
 840    exception
 841       when Error_Resync =>
 842          return Error;
 843    end P_Function_Name;
 844
 845    --  This function parses a restricted form of Names which are either
 846    --  identifiers, or identifiers preceded by a sequence of prefixes
 847    --  that are direct names.
 848
 849    --  Error recovery: cannot raise Error_Resync
 850
 851    function P_Qualified_Simple_Name return Node_Id is
 852       Designator_Node : Node_Id;
 853       Prefix_Node     : Node_Id;
 854       Selector_Node   : Node_Id;
 855       Dot_Sloc        : Source_Ptr := No_Location;
 856
 857    begin
 858       --  Prefix node is set to the gathered prefix so far, Empty means that
 859       --  no prefix has been scanned. This allows us to build up the result
 860       --  in the required right recursive manner.
 861
 862       Prefix_Node := Empty;
 863
 864       --  Loop through prefixes
 865
 866       loop
 867          Designator_Node := Token_Node;
 868
 869          if Token = Tok_Identifier then
 870             Scan; -- past identifier
 871             exit when Token /= Tok_Dot;
 872
 873          elsif Token not in Token_Class_Desig then
 874             return P_Identifier; -- let P_Identifier issue the error message
 875
 876          else
 877             Scan; -- past designator
 878
 879             if Token /= Tok_Dot then
 880                Error_Msg_SP ("identifier expected");
 881                return Error;
 882             end if;
 883          end if;
 884
 885          --  Here at a dot, with token just before it in Designator_Node
 886
 887          if No (Prefix_Node) then
 888             Prefix_Node := Designator_Node;
 889          else
 890             Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 891             Set_Prefix (Selector_Node, Prefix_Node);
 892             Set_Selector_Name (Selector_Node, Designator_Node);
 893             Prefix_Node := Selector_Node;
 894          end if;
 895
 896          Dot_Sloc := Token_Ptr;
 897          Scan; -- past dot
 898       end loop;
 899
 900       --  Fall out of the loop having just scanned an identifier
 901
 902       if No (Prefix_Node) then
 903          return Designator_Node;
 904       else
 905          Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 906          Set_Prefix (Selector_Node, Prefix_Node);
 907          Set_Selector_Name (Selector_Node, Designator_Node);
 908          return Selector_Node;
 909       end if;
 910
 911    exception
 912       when Error_Resync =>
 913          return Error;
 914    end P_Qualified_Simple_Name;
 915
 916    --  This procedure differs from P_Qualified_Simple_Name only in that it
 917    --  raises Error_Resync if any error is encountered. It only returns after
 918    --  scanning a valid qualified simple name.
 919
 920    --  Error recovery: can raise Error_Resync
 921
 922    function P_Qualified_Simple_Name_Resync return Node_Id is
 923       Designator_Node : Node_Id;
 924       Prefix_Node     : Node_Id;
 925       Selector_Node   : Node_Id;
 926       Dot_Sloc        : Source_Ptr := No_Location;
 927
 928    begin
 929       Prefix_Node := Empty;
 930
 931       --  Loop through prefixes
 932
 933       loop
 934          Designator_Node := Token_Node;
 935
 936          if Token = Tok_Identifier then
 937             Scan; -- past identifier
 938             exit when Token /= Tok_Dot;
 939
 940          elsif Token not in Token_Class_Desig then
 941             Discard_Junk_Node (P_Identifier); -- to issue the error message
 942             raise Error_Resync;
 943
 944          else
 945             Scan; -- past designator
 946
 947             if Token /= Tok_Dot then
 948                Error_Msg_SP ("identifier expected");
 949                raise Error_Resync;
 950             end if;
 951          end if;
 952
 953          --  Here at a dot, with token just before it in Designator_Node
 954
 955          if No (Prefix_Node) then
 956             Prefix_Node := Designator_Node;
 957          else
 958             Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 959             Set_Prefix (Selector_Node, Prefix_Node);
 960             Set_Selector_Name (Selector_Node, Designator_Node);
 961             Prefix_Node := Selector_Node;
 962          end if;
 963
 964          Dot_Sloc := Token_Ptr;
 965          Scan; -- past period
 966       end loop;
 967
 968       --  Fall out of the loop having just scanned an identifier
 969
 970       if No (Prefix_Node) then
 971          return Designator_Node;
 972       else
 973          Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 974          Set_Prefix (Selector_Node, Prefix_Node);
 975          Set_Selector_Name (Selector_Node, Designator_Node);
 976          return Selector_Node;
 977       end if;
 978    end P_Qualified_Simple_Name_Resync;
 979
 980    ----------------------
 981    -- 4.1  Direct_Name --
 982    ----------------------
 983
 984    --  Parsed by P_Name and other functions in section 4.1
 985
 986    -----------------
 987    -- 4.1  Prefix --
 988    -----------------
 989
 990    --  Parsed by P_Name (4.1)
 991
 992    -------------------------------
 993    -- 4.1  Explicit Dereference --
 994    -------------------------------
 995
 996    --  Parsed by P_Name (4.1)
 997
 998    -------------------------------
 999    -- 4.1  Implicit_Dereference --
1000    -------------------------------
1001
1002    --  Parsed by P_Name (4.1)
1003
1004    ----------------------------
1005    -- 4.1  Indexed Component --
1006    ----------------------------
1007
1008    --  Parsed by P_Name (4.1)
1009
1010    ----------------
1011    -- 4.1  Slice --
1012    ----------------
1013
1014    --  Parsed by P_Name (4.1)
1015
1016    -----------------------------
1017    -- 4.1  Selected_Component --
1018    -----------------------------
1019
1020    --  Parsed by P_Name (4.1)
1021
1022    ------------------------
1023    -- 4.1  Selector Name --
1024    ------------------------
1025
1026    --  Parsed by P_Name (4.1)
1027
1028    ------------------------------
1029    -- 4.1  Attribute Reference --
1030    ------------------------------
1031
1032    --  Parsed by P_Name (4.1)
1033
1034    -------------------------------
1035    -- 4.1  Attribute Designator --
1036    -------------------------------
1037
1038    --  Parsed by P_Name (4.1)
1039
1040    --------------------------------------
1041    -- 4.1.4  Range Attribute Reference --
1042    --------------------------------------
1043
1044    --  RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1045
1046    --  RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1047
1048    --  In the grammar, a RANGE attribute is simply a name, but its use is
1049    --  highly restricted, so in the parser, we do not regard it as a name.
1050    --  Instead, P_Name returns without scanning the 'RANGE part of the
1051    --  attribute, and the caller uses the following function to construct
1052    --  a range attribute in places where it is appropriate.
1053
1054    --  Note that RANGE here is treated essentially as an identifier,
1055    --  rather than a reserved word.
1056
1057    --  The caller has parsed the prefix, i.e. a name, and Token points to
1058    --  the apostrophe. The token after the apostrophe is known to be RANGE
1059    --  at this point. The prefix node becomes the prefix of the attribute.
1060
1061    --  Error_Recovery: Cannot raise Error_Resync
1062
1063    function P_Range_Attribute_Reference
1064      (Prefix_Node : Node_Id)
1065       return        Node_Id
1066    is
1067       Attr_Node  : Node_Id;
1068
1069    begin
1070       Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1071       Set_Prefix (Attr_Node, Prefix_Node);
1072       Scan; -- past apostrophe
1073
1074       if Style_Check then
1075          Style.Check_Attribute_Name (True);
1076       end if;
1077
1078       Set_Attribute_Name (Attr_Node, Name_Range);
1079       Scan; -- past RANGE
1080
1081       if Token = Tok_Left_Paren then
1082          Scan; -- past left paren
1083          Set_Expressions (Attr_Node, New_List (P_Expression_If_OK));
1084          T_Right_Paren;
1085       end if;
1086
1087       return Attr_Node;
1088    end P_Range_Attribute_Reference;
1089
1090    ---------------------------------------
1091    -- 4.1.4  Range Attribute Designator --
1092    ---------------------------------------
1093
1094    --  Parsed by P_Range_Attribute_Reference (4.4)
1095
1096    --------------------
1097    -- 4.3  Aggregate --
1098    --------------------
1099
1100    --  AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1101
1102    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1103    --  an aggregate is known to be required (code statement, extension
1104    --  aggregate), in which cases this routine performs the necessary check
1105    --  that we have an aggregate rather than a parenthesized expression
1106
1107    --  Error recovery: can raise Error_Resync
1108
1109    function P_Aggregate return Node_Id is
1110       Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1111       Aggr_Node : constant Node_Id    := P_Aggregate_Or_Paren_Expr;
1112
1113    begin
1114       if Nkind (Aggr_Node) /= N_Aggregate
1115            and then
1116          Nkind (Aggr_Node) /= N_Extension_Aggregate
1117       then
1118          Error_Msg
1119            ("aggregate may not have single positional component", Aggr_Sloc);
1120          return Error;
1121       else
1122          return Aggr_Node;
1123       end if;
1124    end P_Aggregate;
1125
1126    ------------------------------------------------
1127    -- 4.3  Aggregate or Parenthesized Expression --
1128    ------------------------------------------------
1129
1130    --  This procedure parses out either an aggregate or a parenthesized
1131    --  expression (these two constructs are closely related, since a
1132    --  parenthesized expression looks like an aggregate with a single
1133    --  positional component).
1134
1135    --  AGGREGATE ::=
1136    --    RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1137
1138    --  RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1139
1140    --  RECORD_COMPONENT_ASSOCIATION_LIST ::=
1141    --     RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1142    --   | null record
1143
1144    --  RECORD_COMPONENT_ASSOCIATION ::=
1145    --    [COMPONENT_CHOICE_LIST =>] EXPRESSION
1146
1147    --  COMPONENT_CHOICE_LIST ::=
1148    --    component_SELECTOR_NAME {| component_SELECTOR_NAME}
1149    --  | others
1150
1151    --  EXTENSION_AGGREGATE ::=
1152    --    (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1153
1154    --  ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1155
1156    --  ARRAY_AGGREGATE ::=
1157    --    POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1158
1159    --  POSITIONAL_ARRAY_AGGREGATE ::=
1160    --    (EXPRESSION, EXPRESSION {, EXPRESSION})
1161    --  | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1162    --  | (EXPRESSION {, EXPRESSION}, others => <>)
1163
1164    --  NAMED_ARRAY_AGGREGATE ::=
1165    --    (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1166
1167    --  PRIMARY ::= (EXPRESSION);
1168
1169    --  Error recovery: can raise Error_Resync
1170
1171    --  Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1172    --        to Ada 2005 limited aggregates (AI-287)
1173
1174    function P_Aggregate_Or_Paren_Expr return Node_Id is
1175       Aggregate_Node : Node_Id;
1176       Expr_List      : List_Id;
1177       Assoc_List     : List_Id;
1178       Expr_Node      : Node_Id;
1179       Lparen_Sloc    : Source_Ptr;
1180       Scan_State     : Saved_Scan_State;
1181
1182       procedure Box_Error;
1183       --  Called if <> is encountered as positional aggregate element. Issues
1184       --  error message and sets Expr_Node to Error.
1185
1186       ---------------
1187       -- Box_Error --
1188       ---------------
1189
1190       procedure Box_Error is
1191       begin
1192          if Ada_Version < Ada_2005 then
1193             Error_Msg_SC ("box in aggregate is an Ada 2005 extension");
1194          end if;
1195
1196          --  Ada 2005 (AI-287): The box notation is allowed only with named
1197          --  notation because positional notation might be error prone. For
1198          --  example, in "(X, <>, Y, <>)", there is no type associated with
1199          --  the boxes, so you might not be leaving out the components you
1200          --  thought you were leaving out.
1201
1202          Error_Msg_SC ("(Ada 2005) box only allowed with named notation");
1203          Scan; -- past box
1204          Expr_Node := Error;
1205       end Box_Error;
1206
1207    --  Start of processing for P_Aggregate_Or_Paren_Expr
1208
1209    begin
1210       Lparen_Sloc := Token_Ptr;
1211       T_Left_Paren;
1212
1213       --  Conditional expression case
1214
1215       if Token = Tok_If then
1216          Expr_Node := P_Conditional_Expression;
1217          T_Right_Paren;
1218          return Expr_Node;
1219
1220       --  Case expression case
1221
1222       elsif Token = Tok_Case then
1223          Expr_Node := P_Case_Expression;
1224          T_Right_Paren;
1225          return Expr_Node;
1226
1227       --  Quantified expression case
1228
1229       elsif Token = Tok_For then
1230          Expr_Node := P_Quantified_Expression;
1231          T_Right_Paren;
1232          return Expr_Node;
1233
1234       --  Note: the mechanism used here of rescanning the initial expression
1235       --  is distinctly unpleasant, but it saves a lot of fiddling in scanning
1236       --  out the discrete choice list.
1237
1238       --  Deal with expression and extension aggregate cases first
1239
1240       elsif Token /= Tok_Others then
1241          Save_Scan_State (Scan_State); -- at start of expression
1242
1243          --  Deal with (NULL RECORD) case
1244
1245          if Token = Tok_Null then
1246             Scan; -- past NULL
1247
1248             if Token = Tok_Record then
1249                Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1250                Set_Null_Record_Present (Aggregate_Node, True);
1251                Scan; -- past RECORD
1252                T_Right_Paren;
1253                return Aggregate_Node;
1254             else
1255                Restore_Scan_State (Scan_State); -- to NULL that must be expr
1256             end if;
1257          end if;
1258
1259          --  Scan expression, handling box appearing as positional argument
1260
1261          if Token = Tok_Box then
1262             Box_Error;
1263          else
1264             Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1265          end if;
1266
1267          --  Extension aggregate case
1268
1269          if Token = Tok_With then
1270             if Nkind (Expr_Node) = N_Attribute_Reference
1271               and then Attribute_Name (Expr_Node) = Name_Range
1272             then
1273                Bad_Range_Attribute (Sloc (Expr_Node));
1274                return Error;
1275             end if;
1276
1277             if Ada_Version = Ada_83 then
1278                Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1279             end if;
1280
1281             Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1282             Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1283             Scan; -- past WITH
1284
1285             --  Deal with WITH NULL RECORD case
1286
1287             if Token = Tok_Null then
1288                Save_Scan_State (Scan_State); -- at NULL
1289                Scan; -- past NULL
1290
1291                if Token = Tok_Record then
1292                   Scan; -- past RECORD
1293                   Set_Null_Record_Present (Aggregate_Node, True);
1294                   T_Right_Paren;
1295                   return Aggregate_Node;
1296
1297                else
1298                   Restore_Scan_State (Scan_State); -- to NULL that must be expr
1299                end if;
1300             end if;
1301
1302             if Token /= Tok_Others then
1303                Save_Scan_State (Scan_State);
1304                Expr_Node := P_Expression;
1305             else
1306                Expr_Node := Empty;
1307             end if;
1308
1309          --  Expression case
1310
1311          elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1312             if Nkind (Expr_Node) = N_Attribute_Reference
1313               and then Attribute_Name (Expr_Node) = Name_Range
1314             then
1315                Error_Msg
1316                  ("|parentheses not allowed for range attribute", Lparen_Sloc);
1317                Scan; -- past right paren
1318                return Expr_Node;
1319             end if;
1320
1321             --  Bump paren count of expression
1322
1323             if Expr_Node /= Error then
1324                Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1325             end if;
1326
1327             T_Right_Paren; -- past right paren (error message if none)
1328             return Expr_Node;
1329
1330          --  Normal aggregate case
1331
1332          else
1333             Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1334          end if;
1335
1336       --  Others case
1337
1338       else
1339          Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1340          Expr_Node := Empty;
1341       end if;
1342
1343       --  Prepare to scan list of component associations
1344
1345       Expr_List  := No_List; -- don't set yet, maybe all named entries
1346       Assoc_List := No_List; -- don't set yet, maybe all positional entries
1347
1348       --  This loop scans through component associations. On entry to the
1349       --  loop, an expression has been scanned at the start of the current
1350       --  association unless initial token was OTHERS, in which case
1351       --  Expr_Node is set to Empty.
1352
1353       loop
1354          --  Deal with others association first. This is a named association
1355
1356          if No (Expr_Node) then
1357             if No (Assoc_List) then
1358                Assoc_List := New_List;
1359             end if;
1360
1361             Append (P_Record_Or_Array_Component_Association, Assoc_List);
1362
1363          --  Improper use of WITH
1364
1365          elsif Token = Tok_With then
1366             Error_Msg_SC ("WITH must be preceded by single expression in " &
1367                              "extension aggregate");
1368             raise Error_Resync;
1369
1370          --  Range attribute can only appear as part of a discrete choice list
1371
1372          elsif Nkind (Expr_Node) = N_Attribute_Reference
1373            and then Attribute_Name (Expr_Node) = Name_Range
1374            and then Token /= Tok_Arrow
1375            and then Token /= Tok_Vertical_Bar
1376          then
1377             Bad_Range_Attribute (Sloc (Expr_Node));
1378             return Error;
1379
1380          --  Assume positional case if comma, right paren, or literal or
1381          --  identifier or OTHERS follows (the latter cases are missing
1382          --  comma cases). Also assume positional if a semicolon follows,
1383          --  which can happen if there are missing parens
1384
1385          elsif Token = Tok_Comma
1386            or else Token = Tok_Right_Paren
1387            or else Token = Tok_Others
1388            or else Token in Token_Class_Lit_Or_Name
1389            or else Token = Tok_Semicolon
1390          then
1391             if Present (Assoc_List) then
1392                Error_Msg_BC -- CODEFIX
1393                   ("""='>"" expected (positional association cannot follow " &
1394                    "named association)");
1395             end if;
1396
1397             if No (Expr_List) then
1398                Expr_List := New_List;
1399             end if;
1400
1401             Append (Expr_Node, Expr_List);
1402
1403          --  Check for aggregate followed by left parent, maybe missing comma
1404
1405          elsif Nkind (Expr_Node) = N_Aggregate
1406            and then Token = Tok_Left_Paren
1407          then
1408             T_Comma;
1409
1410             if No (Expr_List) then
1411                Expr_List := New_List;
1412             end if;
1413
1414             Append (Expr_Node, Expr_List);
1415
1416          --  Anything else is assumed to be a named association
1417
1418          else
1419             Restore_Scan_State (Scan_State); -- to start of expression
1420
1421             if No (Assoc_List) then
1422                Assoc_List := New_List;
1423             end if;
1424
1425             Append (P_Record_Or_Array_Component_Association, Assoc_List);
1426          end if;
1427
1428          exit when not Comma_Present;
1429
1430          --  If we are at an expression terminator, something is seriously
1431          --  wrong, so let's get out now, before we start eating up stuff
1432          --  that doesn't belong to us!
1433
1434          if Token in Token_Class_Eterm then
1435
1436             --  If Some becomes a keyword, the following is needed to make it
1437             --  acceptable in older versions of Ada.
1438
1439             if Token = Tok_Some
1440               and then Ada_Version < Ada_2012
1441             then
1442                Scan_Reserved_Identifier (False);
1443             else
1444                Error_Msg_AP
1445                  ("expecting expression or component association");
1446                exit;
1447             end if;
1448          end if;
1449
1450          --  Deal with misused box
1451
1452          if Token = Tok_Box then
1453             Box_Error;
1454
1455          --  Otherwise initiate for reentry to top of loop by scanning an
1456          --  initial expression, unless the first token is OTHERS.
1457
1458          elsif Token = Tok_Others then
1459             Expr_Node := Empty;
1460
1461          else
1462             Save_Scan_State (Scan_State); -- at start of expression
1463             Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1464
1465          end if;
1466       end loop;
1467
1468       --  All component associations (positional and named) have been scanned
1469
1470       T_Right_Paren;
1471       Set_Expressions (Aggregate_Node, Expr_List);
1472       Set_Component_Associations (Aggregate_Node, Assoc_List);
1473       return Aggregate_Node;
1474    end P_Aggregate_Or_Paren_Expr;
1475
1476    ------------------------------------------------
1477    -- 4.3  Record or Array Component Association --
1478    ------------------------------------------------
1479
1480    --  RECORD_COMPONENT_ASSOCIATION ::=
1481    --    [COMPONENT_CHOICE_LIST =>] EXPRESSION
1482    --  | COMPONENT_CHOICE_LIST => <>
1483
1484    --  COMPONENT_CHOICE_LIST =>
1485    --    component_SELECTOR_NAME {| component_SELECTOR_NAME}
1486    --  | others
1487
1488    --  ARRAY_COMPONENT_ASSOCIATION ::=
1489    --    DISCRETE_CHOICE_LIST => EXPRESSION
1490    --  | DISCRETE_CHOICE_LIST => <>
1491
1492    --  Note: this routine only handles the named cases, including others.
1493    --  Cases where the component choice list is not present have already
1494    --  been handled directly.
1495
1496    --  Error recovery: can raise Error_Resync
1497
1498    --  Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1499    --        rules have been extended to give support to Ada 2005 limited
1500    --        aggregates (AI-287)
1501
1502    function P_Record_Or_Array_Component_Association return Node_Id is
1503       Assoc_Node : Node_Id;
1504
1505    begin
1506       Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1507       Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1508       Set_Sloc (Assoc_Node, Token_Ptr);
1509       TF_Arrow;
1510
1511       if Token = Tok_Box then
1512
1513          --  Ada 2005(AI-287): The box notation is used to indicate the
1514          --  default initialization of aggregate components
1515
1516          if Ada_Version < Ada_2005 then
1517             Error_Msg_SP
1518               ("component association with '<'> is an Ada 2005 extension");
1519             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1520          end if;
1521
1522          Set_Box_Present (Assoc_Node);
1523          Scan; -- Past box
1524       else
1525          Set_Expression (Assoc_Node, P_Expression);
1526       end if;
1527
1528       return Assoc_Node;
1529    end P_Record_Or_Array_Component_Association;
1530
1531    -----------------------------
1532    -- 4.3.1  Record Aggregate --
1533    -----------------------------
1534
1535    --  Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1536    --  All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1537
1538    ----------------------------------------------
1539    -- 4.3.1  Record Component Association List --
1540    ----------------------------------------------
1541
1542    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1543
1544    ----------------------------------
1545    -- 4.3.1  Component Choice List --
1546    ----------------------------------
1547
1548    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1549
1550    --------------------------------
1551    -- 4.3.1  Extension Aggregate --
1552    --------------------------------
1553
1554    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1555
1556    --------------------------
1557    -- 4.3.1  Ancestor Part --
1558    --------------------------
1559
1560    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1561
1562    ----------------------------
1563    -- 4.3.1  Array Aggregate --
1564    ----------------------------
1565
1566    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1567
1568    ---------------------------------------
1569    -- 4.3.1  Positional Array Aggregate --
1570    ---------------------------------------
1571
1572    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1573
1574    ----------------------------------
1575    -- 4.3.1  Named Array Aggregate --
1576    ----------------------------------
1577
1578    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1579
1580    ----------------------------------------
1581    -- 4.3.1  Array Component Association --
1582    ----------------------------------------
1583
1584    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1585
1586    ---------------------
1587    -- 4.4  Expression --
1588    ---------------------
1589
1590    --  This procedure parses EXPRESSION or CHOICE_EXPRESSION
1591
1592    --  EXPRESSION ::=
1593    --    RELATION {LOGICAL_OPERATOR RELATION}
1594
1595    --  CHOICE_EXPRESSION ::=
1596    --    CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1597
1598    --  LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1599
1600    --  On return, Expr_Form indicates the categorization of the expression
1601    --  EF_Range_Attr is not a possible value (if a range attribute is found,
1602    --  an error message is given, and Error is returned).
1603
1604    --  Error recovery: cannot raise Error_Resync
1605
1606    function P_Expression return Node_Id is
1607       Logical_Op      : Node_Kind;
1608       Prev_Logical_Op : Node_Kind;
1609       Op_Location     : Source_Ptr;
1610       Node1           : Node_Id;
1611       Node2           : Node_Id;
1612
1613    begin
1614       Node1 := P_Relation;
1615
1616       if Token in Token_Class_Logop then
1617          Prev_Logical_Op := N_Empty;
1618
1619          loop
1620             Op_Location := Token_Ptr;
1621             Logical_Op := P_Logical_Operator;
1622
1623             if Prev_Logical_Op /= N_Empty and then
1624                Logical_Op /= Prev_Logical_Op
1625             then
1626                Error_Msg
1627                  ("mixed logical operators in expression", Op_Location);
1628                Prev_Logical_Op := N_Empty;
1629             else
1630                Prev_Logical_Op := Logical_Op;
1631             end if;
1632
1633             Node2 := Node1;
1634             Node1 := New_Op_Node (Logical_Op, Op_Location);
1635             Set_Left_Opnd (Node1, Node2);
1636             Set_Right_Opnd (Node1, P_Relation);
1637             exit when Token not in Token_Class_Logop;
1638          end loop;
1639
1640          Expr_Form := EF_Non_Simple;
1641       end if;
1642
1643       if Token = Tok_Apostrophe then
1644          Bad_Range_Attribute (Token_Ptr);
1645          return Error;
1646       else
1647          return Node1;
1648       end if;
1649    end P_Expression;
1650
1651    --  This function is identical to the normal P_Expression, except that it
1652    --  also permits the appearance of a case, conditional, or quantified
1653    --  expression without the usual surrounding parentheses.
1654
1655    function P_Expression_If_OK return Node_Id is
1656    begin
1657       if Token = Tok_Case then
1658          return P_Case_Expression;
1659
1660       elsif Token = Tok_If then
1661          return P_Conditional_Expression;
1662
1663       elsif Token = Tok_For then
1664          return P_Quantified_Expression;
1665
1666       else
1667          return P_Expression;
1668       end if;
1669    end P_Expression_If_OK;
1670
1671    --  This function is identical to the normal P_Expression, except that it
1672    --  checks that the expression scan did not stop on a right paren. It is
1673    --  called in all contexts where a right parenthesis cannot legitimately
1674    --  follow an expression.
1675
1676    --  Error recovery: can not raise Error_Resync
1677
1678    function P_Expression_No_Right_Paren return Node_Id is
1679       Expr : constant Node_Id := P_Expression;
1680    begin
1681       Ignore (Tok_Right_Paren);
1682       return Expr;
1683    end P_Expression_No_Right_Paren;
1684
1685    ----------------------------------------
1686    -- 4.4  Expression_Or_Range_Attribute --
1687    ----------------------------------------
1688
1689    --  EXPRESSION ::=
1690    --    RELATION {and RELATION} | RELATION {and then RELATION}
1691    --  | RELATION {or RELATION}  | RELATION {or else RELATION}
1692    --  | RELATION {xor RELATION}
1693
1694    --  RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1695
1696    --  RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1697
1698    --  On return, Expr_Form indicates the categorization of the expression
1699    --  and EF_Range_Attr is one of the possibilities.
1700
1701    --  Error recovery: cannot raise Error_Resync
1702
1703    --  In the grammar, a RANGE attribute is simply a name, but its use is
1704    --  highly restricted, so in the parser, we do not regard it as a name.
1705    --  Instead, P_Name returns without scanning the 'RANGE part of the
1706    --  attribute, and P_Expression_Or_Range_Attribute handles the range
1707    --  attribute reference. In the normal case where a range attribute is
1708    --  not allowed, an error message is issued by P_Expression.
1709
1710    function P_Expression_Or_Range_Attribute return Node_Id is
1711       Logical_Op      : Node_Kind;
1712       Prev_Logical_Op : Node_Kind;
1713       Op_Location     : Source_Ptr;
1714       Node1           : Node_Id;
1715       Node2           : Node_Id;
1716       Attr_Node       : Node_Id;
1717
1718    begin
1719       Node1 := P_Relation;
1720
1721       if Token = Tok_Apostrophe then
1722          Attr_Node := P_Range_Attribute_Reference (Node1);
1723          Expr_Form := EF_Range_Attr;
1724          return Attr_Node;
1725
1726       elsif Token in Token_Class_Logop then
1727          Prev_Logical_Op := N_Empty;
1728
1729          loop
1730             Op_Location := Token_Ptr;
1731             Logical_Op := P_Logical_Operator;
1732
1733             if Prev_Logical_Op /= N_Empty and then
1734                Logical_Op /= Prev_Logical_Op
1735             then
1736                Error_Msg
1737                  ("mixed logical operators in expression", Op_Location);
1738                Prev_Logical_Op := N_Empty;
1739             else
1740                Prev_Logical_Op := Logical_Op;
1741             end if;
1742
1743             Node2 := Node1;
1744             Node1 := New_Op_Node (Logical_Op, Op_Location);
1745             Set_Left_Opnd (Node1, Node2);
1746             Set_Right_Opnd (Node1, P_Relation);
1747             exit when Token not in Token_Class_Logop;
1748          end loop;
1749
1750          Expr_Form := EF_Non_Simple;
1751       end if;
1752
1753       if Token = Tok_Apostrophe then
1754          Bad_Range_Attribute (Token_Ptr);
1755          return Error;
1756       else
1757          return Node1;
1758       end if;
1759    end P_Expression_Or_Range_Attribute;
1760
1761    --  Version that allows a non-parenthesized case, conditional, or quantified
1762    --  expression
1763
1764    function P_Expression_Or_Range_Attribute_If_OK return Node_Id is
1765    begin
1766       if Token = Tok_Case then
1767          return P_Case_Expression;
1768
1769       elsif Token = Tok_If then
1770          return P_Conditional_Expression;
1771
1772       elsif Token = Tok_For then
1773          return P_Quantified_Expression;
1774
1775       else
1776          return P_Expression_Or_Range_Attribute;
1777       end if;
1778    end P_Expression_Or_Range_Attribute_If_OK;
1779
1780    -------------------
1781    -- 4.4  Relation --
1782    -------------------
1783
1784    --  This procedure scans both relations and choice relations
1785
1786    --  CHOICE_RELATION ::=
1787    --    SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1788
1789    --  RELATION ::=
1790    --    SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
1791
1792    --  MEMBERSHIP_CHOICE_LIST ::=
1793    --    MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
1794
1795    --  MEMBERSHIP_CHOICE ::=
1796    --    CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
1797
1798    --  On return, Expr_Form indicates the categorization of the expression
1799
1800    --  Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1801    --  EF_Simple_Name and the following token is RANGE (range attribute case).
1802
1803    --  Error recovery: cannot raise Error_Resync. If an error occurs within an
1804    --  expression, then tokens are scanned until either a non-expression token,
1805    --  a right paren (not matched by a left paren) or a comma, is encountered.
1806
1807    function P_Relation return Node_Id is
1808       Node1, Node2 : Node_Id;
1809       Optok        : Source_Ptr;
1810
1811    begin
1812       Node1 := P_Simple_Expression;
1813
1814       if Token not in Token_Class_Relop then
1815          return Node1;
1816
1817       else
1818          --  Here we have a relational operator following. If so then scan it
1819          --  out. Note that the assignment symbol := is treated as a relational
1820          --  operator to improve the error recovery when it is misused for =.
1821          --  P_Relational_Operator also parses the IN and NOT IN operations.
1822
1823          Optok := Token_Ptr;
1824          Node2 := New_Op_Node (P_Relational_Operator, Optok);
1825          Set_Left_Opnd (Node2, Node1);
1826
1827          --  Case of IN or NOT IN
1828
1829          if Prev_Token = Tok_In then
1830             P_Membership_Test (Node2);
1831
1832          --  Case of relational operator (= /= < <= > >=)
1833
1834          else
1835             Set_Right_Opnd (Node2, P_Simple_Expression);
1836          end if;
1837
1838          Expr_Form := EF_Non_Simple;
1839
1840          if Token in Token_Class_Relop then
1841             Error_Msg_SC ("unexpected relational operator");
1842             raise Error_Resync;
1843          end if;
1844
1845          return Node2;
1846       end if;
1847
1848    --  If any error occurs, then scan to the next expression terminator symbol
1849    --  or comma or right paren at the outer (i.e. current) parentheses level.
1850    --  The flags are set to indicate a normal simple expression.
1851
1852    exception
1853       when Error_Resync =>
1854          Resync_Expression;
1855          Expr_Form := EF_Simple;
1856          return Error;
1857    end P_Relation;
1858
1859    ----------------------------
1860    -- 4.4  Simple Expression --
1861    ----------------------------
1862
1863    --  SIMPLE_EXPRESSION ::=
1864    --    [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1865
1866    --  On return, Expr_Form indicates the categorization of the expression
1867
1868    --  Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1869    --  EF_Simple_Name and the following token is RANGE (range attribute case).
1870
1871    --  Error recovery: cannot raise Error_Resync. If an error occurs within an
1872    --  expression, then tokens are scanned until either a non-expression token,
1873    --  a right paren (not matched by a left paren) or a comma, is encountered.
1874
1875    --  Note: P_Simple_Expression is called only internally by higher level
1876    --  expression routines. In cases in the grammar where a simple expression
1877    --  is required, the approach is to scan an expression, and then post an
1878    --  appropriate error message if the expression obtained is not simple. This
1879    --  gives better error recovery and treatment.
1880
1881    function P_Simple_Expression return Node_Id is
1882       Scan_State : Saved_Scan_State;
1883       Node1      : Node_Id;
1884       Node2      : Node_Id;
1885       Tokptr     : Source_Ptr;
1886
1887    begin
1888       --  Check for cases starting with a name. There are two reasons for
1889       --  special casing. First speed things up by catching a common case
1890       --  without going through several routine layers. Second the caller must
1891       --  be informed via Expr_Form when the simple expression is a name.
1892
1893       if Token in Token_Class_Name then
1894          Node1 := P_Name;
1895
1896          --  Deal with apostrophe cases
1897
1898          if Token = Tok_Apostrophe then
1899             Save_Scan_State (Scan_State); -- at apostrophe
1900             Scan; -- past apostrophe
1901
1902             --  If qualified expression, scan it out and fall through
1903
1904             if Token = Tok_Left_Paren then
1905                Node1 := P_Qualified_Expression (Node1);
1906                Expr_Form := EF_Simple;
1907
1908             --  If range attribute, then we return with Token pointing to the
1909             --  apostrophe. Note: avoid the normal error check on exit. We
1910             --  know that the expression really is complete in this case!
1911
1912             else -- Token = Tok_Range then
1913                Restore_Scan_State (Scan_State); -- to apostrophe
1914                Expr_Form := EF_Simple_Name;
1915                return Node1;
1916             end if;
1917          end if;
1918
1919          --  If an expression terminator follows, the previous processing
1920          --  completely scanned out the expression (a common case), and
1921          --  left Expr_Form set appropriately for returning to our caller.
1922
1923          if Token in Token_Class_Sterm then
1924             null;
1925
1926          --  If we do not have an expression terminator, then complete the
1927          --  scan of a simple expression. This code duplicates the code
1928          --  found in P_Term and P_Factor.
1929
1930          else
1931             if Token = Tok_Double_Asterisk then
1932                if Style_Check then
1933                   Style.Check_Exponentiation_Operator;
1934                end if;
1935
1936                Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
1937                Scan; -- past **
1938                Set_Left_Opnd (Node2, Node1);
1939                Set_Right_Opnd (Node2, P_Primary);
1940                Node1 := Node2;
1941             end if;
1942
1943             loop
1944                exit when Token not in Token_Class_Mulop;
1945                Tokptr := Token_Ptr;
1946                Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
1947
1948                if Style_Check then
1949                   Style.Check_Binary_Operator;
1950                end if;
1951
1952                Scan; -- past operator
1953                Set_Left_Opnd (Node2, Node1);
1954                Set_Right_Opnd (Node2, P_Factor);
1955                Node1 := Node2;
1956             end loop;
1957
1958             loop
1959                exit when Token not in Token_Class_Binary_Addop;
1960                Tokptr := Token_Ptr;
1961                Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
1962
1963                if Style_Check then
1964                   Style.Check_Binary_Operator;
1965                end if;
1966
1967                Scan; -- past operator
1968                Set_Left_Opnd (Node2, Node1);
1969                Set_Right_Opnd (Node2, P_Term);
1970                Node1 := Node2;
1971             end loop;
1972
1973             Expr_Form := EF_Simple;
1974          end if;
1975
1976       --  Cases where simple expression does not start with a name
1977
1978       else
1979          --  Scan initial sign and initial Term
1980
1981          if Token in Token_Class_Unary_Addop then
1982             Tokptr := Token_Ptr;
1983             Node1 := New_Op_Node (P_Unary_Adding_Operator, Tokptr);
1984
1985             if Style_Check then
1986                Style.Check_Unary_Plus_Or_Minus;
1987             end if;
1988
1989             Scan; -- past operator
1990             Set_Right_Opnd (Node1, P_Term);
1991          else
1992             Node1 := P_Term;
1993          end if;
1994
1995          --  In the following, we special-case a sequence of concatenations of
1996          --  string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
1997          --  else mixed in. For such a sequence, we return a tree representing
1998          --  "" & "aaabbb...ccc" (a single concatenation). This is done only if
1999          --  the number of concatenations is large. If semantic analysis
2000          --  resolves the "&" to a predefined one, then this folding gives the
2001          --  right answer. Otherwise, semantic analysis will complain about a
2002          --  capacity-exceeded error. The purpose of this trick is to avoid
2003          --  creating a deeply nested tree, which would cause deep recursion
2004          --  during semantics, causing stack overflow. This way, we can handle
2005          --  enormous concatenations in the normal case of predefined "&".  We
2006          --  first build up the normal tree, and then rewrite it if
2007          --  appropriate.
2008
2009          declare
2010             Num_Concats_Threshold : constant Positive := 1000;
2011             --  Arbitrary threshold value to enable optimization
2012
2013             First_Node : constant Node_Id := Node1;
2014             Is_Strlit_Concat : Boolean;
2015             --  True iff we've parsed a sequence of concatenations of string
2016             --  literals, with nothing else mixed in.
2017
2018             Num_Concats : Natural;
2019             --  Number of "&" operators if Is_Strlit_Concat is True
2020
2021          begin
2022             Is_Strlit_Concat :=
2023               Nkind (Node1) = N_String_Literal
2024                 and then Token = Tok_Ampersand;
2025             Num_Concats := 0;
2026
2027             --  Scan out sequence of terms separated by binary adding operators
2028
2029             loop
2030                exit when Token not in Token_Class_Binary_Addop;
2031                Tokptr := Token_Ptr;
2032                Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
2033                Scan; -- past operator
2034                Set_Left_Opnd (Node2, Node1);
2035                Node1 := P_Term;
2036                Set_Right_Opnd (Node2, Node1);
2037
2038                --  Check if we're still concatenating string literals
2039
2040                Is_Strlit_Concat :=
2041                  Is_Strlit_Concat
2042                    and then Nkind (Node2) = N_Op_Concat
2043                  and then Nkind (Node1) = N_String_Literal;
2044
2045                if Is_Strlit_Concat then
2046                   Num_Concats := Num_Concats + 1;
2047                end if;
2048
2049                Node1 := Node2;
2050             end loop;
2051
2052             --  If we have an enormous series of concatenations of string
2053             --  literals, rewrite as explained above. The Is_Folded_In_Parser
2054             --  flag tells semantic analysis that if the "&" is not predefined,
2055             --  the folded value is wrong.
2056
2057             if Is_Strlit_Concat
2058               and then Num_Concats >= Num_Concats_Threshold
2059             then
2060                declare
2061                   Empty_String_Val : String_Id;
2062                   --  String_Id for ""
2063
2064                   Strlit_Concat_Val : String_Id;
2065                   --  Contains the folded value (which will be correct if the
2066                   --  "&" operators are the predefined ones).
2067
2068                   Cur_Node : Node_Id;
2069                   --  For walking up the tree
2070
2071                   New_Node : Node_Id;
2072                   --  Folded node to replace Node1
2073
2074                   Loc : constant Source_Ptr := Sloc (First_Node);
2075
2076                begin
2077                   --  Walk up the tree starting at the leftmost string literal
2078                   --  (First_Node), building up the Strlit_Concat_Val as we
2079                   --  go. Note that we do not use recursion here -- the whole
2080                   --  point is to avoid recursively walking that enormous tree.
2081
2082                   Start_String;
2083                   Store_String_Chars (Strval (First_Node));
2084
2085                   Cur_Node := Parent (First_Node);
2086                   while Present (Cur_Node) loop
2087                      pragma Assert (Nkind (Cur_Node) = N_Op_Concat and then
2088                         Nkind (Right_Opnd (Cur_Node)) = N_String_Literal);
2089
2090                      Store_String_Chars (Strval (Right_Opnd (Cur_Node)));
2091                      Cur_Node := Parent (Cur_Node);
2092                   end loop;
2093
2094                   Strlit_Concat_Val := End_String;
2095
2096                   --  Create new folded node, and rewrite result with a concat-
2097                   --  enation of an empty string literal and the folded node.
2098
2099                   Start_String;
2100                   Empty_String_Val := End_String;
2101                   New_Node :=
2102                     Make_Op_Concat (Loc,
2103                       Make_String_Literal (Loc, Empty_String_Val),
2104                       Make_String_Literal (Loc, Strlit_Concat_Val,
2105                         Is_Folded_In_Parser => True));
2106                   Rewrite (Node1, New_Node);
2107                end;
2108             end if;
2109          end;
2110
2111          --  All done, we clearly do not have name or numeric literal so this
2112          --  is a case of a simple expression which is some other possibility.
2113
2114          Expr_Form := EF_Simple;
2115       end if;
2116
2117       --  Come here at end of simple expression, where we do a couple of
2118       --  special checks to improve error recovery.
2119
2120       --  Special test to improve error recovery. If the current token
2121       --  is a period, then someone is trying to do selection on something
2122       --  that is not a name, e.g. a qualified expression.
2123
2124       if Token = Tok_Dot then
2125          Error_Msg_SC ("prefix for selection is not a name");
2126
2127          --  If qualified expression, comment and continue, otherwise something
2128          --  is pretty nasty so do an Error_Resync call.
2129
2130          if Ada_Version < Ada_2012
2131            and then Nkind (Node1) = N_Qualified_Expression
2132          then
2133             Error_Msg_SC ("\would be legal in Ada 2012 mode");
2134          else
2135             raise Error_Resync;
2136          end if;
2137       end if;
2138
2139       --  Special test to improve error recovery: If the current token is
2140       --  not the first token on a line (as determined by checking the
2141       --  previous token position with the start of the current line),
2142       --  then we insist that we have an appropriate terminating token.
2143       --  Consider the following two examples:
2144
2145       --   1)  if A nad B then ...
2146
2147       --   2)  A := B
2148       --       C := D
2149
2150       --  In the first example, we would like to issue a binary operator
2151       --  expected message and resynchronize to the then. In the second
2152       --  example, we do not want to issue a binary operator message, so
2153       --  that instead we will get the missing semicolon message. This
2154       --  distinction is of course a heuristic which does not always work,
2155       --  but in practice it is quite effective.
2156
2157       --  Note: the one case in which we do not go through this circuit is
2158       --  when we have scanned a range attribute and want to return with
2159       --  Token pointing to the apostrophe. The apostrophe is not normally
2160       --  an expression terminator, and is not in Token_Class_Sterm, but
2161       --  in this special case we know that the expression is complete.
2162
2163       if not Token_Is_At_Start_Of_Line
2164          and then Token not in Token_Class_Sterm
2165       then
2166          --  Normally the right error message is indeed that we expected a
2167          --  binary operator, but in the case of being between a right and left
2168          --  paren, e.g. in an aggregate, a more likely error is missing comma.
2169
2170          if Prev_Token = Tok_Right_Paren and then Token = Tok_Left_Paren then
2171             T_Comma;
2172          else
2173             Error_Msg_AP ("binary operator expected");
2174          end if;
2175
2176          raise Error_Resync;
2177
2178       else
2179          return Node1;
2180       end if;
2181
2182    --  If any error occurs, then scan to next expression terminator symbol
2183    --  or comma, right paren or vertical bar at the outer (i.e. current) paren
2184    --  level. Expr_Form is set to indicate a normal simple expression.
2185
2186    exception
2187       when Error_Resync =>
2188          Resync_Expression;
2189          Expr_Form := EF_Simple;
2190          return Error;
2191    end P_Simple_Expression;
2192
2193    -----------------------------------------------
2194    -- 4.4  Simple Expression or Range Attribute --
2195    -----------------------------------------------
2196
2197    --  SIMPLE_EXPRESSION ::=
2198    --    [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2199
2200    --  RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2201
2202    --  RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2203
2204    --  Error recovery: cannot raise Error_Resync
2205
2206    function P_Simple_Expression_Or_Range_Attribute return Node_Id is
2207       Sexpr     : Node_Id;
2208       Attr_Node : Node_Id;
2209
2210    begin
2211       --  We don't just want to roar ahead and call P_Simple_Expression
2212       --  here, since we want to handle the case of a parenthesized range
2213       --  attribute cleanly.
2214
2215       if Token = Tok_Left_Paren then
2216          declare
2217             Lptr       : constant Source_Ptr := Token_Ptr;
2218             Scan_State : Saved_Scan_State;
2219
2220          begin
2221             Save_Scan_State (Scan_State);
2222             Scan; -- past left paren
2223             Sexpr := P_Simple_Expression;
2224
2225             if Token = Tok_Apostrophe then
2226                Attr_Node := P_Range_Attribute_Reference (Sexpr);
2227                Expr_Form := EF_Range_Attr;
2228
2229                if Token = Tok_Right_Paren then
2230                   Scan; -- scan past right paren if present
2231                end if;
2232
2233                Error_Msg ("parentheses not allowed for range attribute", Lptr);
2234
2235                return Attr_Node;
2236             end if;
2237
2238             Restore_Scan_State (Scan_State);
2239          end;
2240       end if;
2241
2242       --  Here after dealing with parenthesized range attribute
2243
2244       Sexpr := P_Simple_Expression;
2245
2246       if Token = Tok_Apostrophe then
2247          Attr_Node := P_Range_Attribute_Reference (Sexpr);
2248          Expr_Form := EF_Range_Attr;
2249          return Attr_Node;
2250
2251       else
2252          return Sexpr;
2253       end if;
2254    end P_Simple_Expression_Or_Range_Attribute;
2255
2256    ---------------
2257    -- 4.4  Term --
2258    ---------------
2259
2260    --  TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2261
2262    --  Error recovery: can raise Error_Resync
2263
2264    function P_Term return Node_Id is
2265       Node1, Node2 : Node_Id;
2266       Tokptr       : Source_Ptr;
2267
2268    begin
2269       Node1 := P_Factor;
2270
2271       loop
2272          exit when Token not in Token_Class_Mulop;
2273          Tokptr := Token_Ptr;
2274          Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
2275          Scan; -- past operator
2276          Set_Left_Opnd (Node2, Node1);
2277          Set_Right_Opnd (Node2, P_Factor);
2278          Node1 := Node2;
2279       end loop;
2280
2281       return Node1;
2282    end P_Term;
2283
2284    -----------------
2285    -- 4.4  Factor --
2286    -----------------
2287
2288    --  FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2289
2290    --  Error recovery: can raise Error_Resync
2291
2292    function P_Factor return Node_Id is
2293       Node1 : Node_Id;
2294       Node2 : Node_Id;
2295
2296    begin
2297       if Token = Tok_Abs then
2298          Node1 := New_Op_Node (N_Op_Abs, Token_Ptr);
2299
2300          if Style_Check then
2301             Style.Check_Abs_Not;
2302          end if;
2303
2304          Scan; -- past ABS
2305          Set_Right_Opnd (Node1, P_Primary);
2306          return Node1;
2307
2308       elsif Token = Tok_Not then
2309          Node1 := New_Op_Node (N_Op_Not, Token_Ptr);
2310
2311          if Style_Check then
2312             Style.Check_Abs_Not;
2313          end if;
2314
2315          Scan; -- past NOT
2316          Set_Right_Opnd (Node1, P_Primary);
2317          return Node1;
2318
2319       else
2320          Node1 := P_Primary;
2321
2322          if Token = Tok_Double_Asterisk then
2323             Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
2324             Scan; -- past **
2325             Set_Left_Opnd (Node2, Node1);
2326             Set_Right_Opnd (Node2, P_Primary);
2327             return Node2;
2328          else
2329             return Node1;
2330          end if;
2331       end if;
2332    end P_Factor;
2333
2334    ------------------
2335    -- 4.4  Primary --
2336    ------------------
2337
2338    --  PRIMARY ::=
2339    --    NUMERIC_LITERAL  | null
2340    --  | STRING_LITERAL   | AGGREGATE
2341    --  | NAME             | QUALIFIED_EXPRESSION
2342    --  | ALLOCATOR        | (EXPRESSION) | QUANTIFIED_EXPRESSION
2343
2344    --  Error recovery: can raise Error_Resync
2345
2346    function P_Primary return Node_Id is
2347       Scan_State : Saved_Scan_State;
2348       Node1      : Node_Id;
2349
2350    begin
2351       --  The loop runs more than once only if misplaced pragmas are found
2352
2353       loop
2354          case Token is
2355
2356             --  Name token can start a name, call or qualified expression, all
2357             --  of which are acceptable possibilities for primary. Note also
2358             --  that string literal is included in name (as operator symbol)
2359             --  and type conversion is included in name (as indexed component).
2360
2361             when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier =>
2362                Node1 := P_Name;
2363
2364                --  All done unless apostrophe follows
2365
2366                if Token /= Tok_Apostrophe then
2367                   return Node1;
2368
2369                --  Apostrophe following means that we have either just parsed
2370                --  the subtype mark of a qualified expression, or the prefix
2371                --  or a range attribute.
2372
2373                else -- Token = Tok_Apostrophe
2374                   Save_Scan_State (Scan_State); -- at apostrophe
2375                   Scan; -- past apostrophe
2376
2377                   --  If range attribute, then this is always an error, since
2378                   --  the only legitimate case (where the scanned expression is
2379                   --  a qualified simple name) is handled at the level of the
2380                   --  Simple_Expression processing. This case corresponds to a
2381                   --  usage such as 3 + A'Range, which is always illegal.
2382
2383                   if Token = Tok_Range then
2384                      Restore_Scan_State (Scan_State); -- to apostrophe
2385                      Bad_Range_Attribute (Token_Ptr);
2386                      return Error;
2387
2388                   --  If left paren, then we have a qualified expression.
2389                   --  Note that P_Name guarantees that in this case, where
2390                   --  Token = Tok_Apostrophe on return, the only two possible
2391                   --  tokens following the apostrophe are left paren and
2392                   --  RANGE, so we know we have a left paren here.
2393
2394                   else -- Token = Tok_Left_Paren
2395                      return P_Qualified_Expression (Node1);
2396
2397                   end if;
2398                end if;
2399
2400             --  Numeric or string literal
2401
2402             when Tok_Integer_Literal |
2403                  Tok_Real_Literal    |
2404                  Tok_String_Literal  =>
2405
2406                Node1 := Token_Node;
2407                Scan; -- past number
2408                return Node1;
2409
2410             --  Left paren, starts aggregate or parenthesized expression
2411
2412             when Tok_Left_Paren =>
2413                declare
2414                   Expr : constant Node_Id := P_Aggregate_Or_Paren_Expr;
2415
2416                begin
2417                   if Nkind (Expr) = N_Attribute_Reference
2418                     and then Attribute_Name (Expr) = Name_Range
2419                   then
2420                      Bad_Range_Attribute (Sloc (Expr));
2421                   end if;
2422
2423                   return Expr;
2424                end;
2425
2426             --  Allocator
2427
2428             when Tok_New =>
2429                return P_Allocator;
2430
2431             --  Null
2432
2433             when Tok_Null =>
2434                Scan; -- past NULL
2435                return New_Node (N_Null, Prev_Token_Ptr);
2436
2437             --  Pragma, not allowed here, so just skip past it
2438
2439             when Tok_Pragma =>
2440                P_Pragmas_Misplaced;
2441
2442             --  Deal with IF (possible unparenthesized conditional expression)
2443
2444             when Tok_If =>
2445
2446                --  If this looks like a real if, defined as an IF appearing at
2447                --  the start of a new line, then we consider we have a missing
2448                --  operand.
2449
2450                if Token_Is_At_Start_Of_Line then
2451                   Error_Msg_AP ("missing operand");
2452                   return Error;
2453
2454                --  If this looks like a conditional expression, then treat it
2455                --  that way with an error message.
2456
2457                elsif Ada_Version >= Ada_2012 then
2458                   Error_Msg_SC
2459                     ("conditional expression must be parenthesized");
2460                   return P_Conditional_Expression;
2461
2462                --  Otherwise treat as misused identifier
2463
2464                else
2465                   return P_Identifier;
2466                end if;
2467
2468             --  Deal with CASE (possible unparenthesized case expression)
2469
2470             when Tok_Case =>
2471
2472                --  If this looks like a real case, defined as a CASE appearing
2473                --  the start of a new line, then we consider we have a missing
2474                --  operand.
2475
2476                if Token_Is_At_Start_Of_Line then
2477                   Error_Msg_AP ("missing operand");
2478                   return Error;
2479
2480                --  If this looks like a case expression, then treat it that way
2481                --  with an error message.
2482
2483                elsif Ada_Version >= Ada_2012 then
2484                   Error_Msg_SC ("case expression must be parenthesized");
2485                   return P_Case_Expression;
2486
2487                --  Otherwise treat as misused identifier
2488
2489                else
2490                   return P_Identifier;
2491                end if;
2492
2493             --  For [all | some]  indicates a quantified expression
2494
2495             when Tok_For =>
2496
2497                if Token_Is_At_Start_Of_Line then
2498                   Error_Msg_AP ("misplaced loop");
2499                   return Error;
2500
2501                elsif Ada_Version >= Ada_2012 then
2502                   Error_Msg_SC ("quantified expression must be parenthesized");
2503                   return P_Quantified_Expression;
2504
2505                else
2506
2507                --  Otherwise treat as misused identifier
2508
2509                   return P_Identifier;
2510                end if;
2511
2512             --  Anything else is illegal as the first token of a primary, but
2513             --  we test for a reserved identifier so that it is treated nicely
2514
2515             when others =>
2516                if Is_Reserved_Identifier then
2517                   return P_Identifier;
2518
2519                elsif Prev_Token = Tok_Comma then
2520                   Error_Msg_SP -- CODEFIX
2521                     ("|extra "","" ignored");
2522                   raise Error_Resync;
2523
2524                else
2525                   Error_Msg_AP ("missing operand");
2526                   raise Error_Resync;
2527                end if;
2528
2529          end case;
2530       end loop;
2531    end P_Primary;
2532
2533    -------------------------------
2534    -- 4.4 Quantified_Expression --
2535    -------------------------------
2536
2537    --  QUANTIFIED_EXPRESSION ::=
2538    --    for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
2539    --    for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
2540
2541    function P_Quantified_Expression return Node_Id is
2542       I_Spec : Node_Id;
2543       Node1  : Node_Id;
2544
2545    begin
2546       Scan;  --  past FOR
2547
2548       Node1 := New_Node (N_Quantified_Expression, Prev_Token_Ptr);
2549
2550       if Token = Tok_All then
2551          Set_All_Present (Node1);
2552
2553       --  We treat Some as a non-reserved keyword, so it appears to the scanner
2554       --  as an identifier. If Some is made into a reserved word, the check
2555       --  below is against Tok_Some.
2556
2557       elsif Token /= Tok_Identifier
2558         or else Chars (Token_Node) /= Name_Some
2559       then
2560          Error_Msg_AP ("missing quantifier");
2561          raise Error_Resync;
2562       end if;
2563
2564       Scan; -- past SOME
2565       I_Spec := P_Loop_Parameter_Specification;
2566
2567       if Nkind (I_Spec) = N_Loop_Parameter_Specification then
2568          Set_Loop_Parameter_Specification (Node1, I_Spec);
2569       else
2570          Set_Iterator_Specification (Node1, I_Spec);
2571       end if;
2572
2573       if Token = Tok_Arrow then
2574          Scan;
2575          Set_Condition (Node1, P_Expression);
2576          return Node1;
2577       else
2578          Error_Msg_AP ("missing arrow");
2579          raise Error_Resync;
2580       end if;
2581    end P_Quantified_Expression;
2582
2583    ---------------------------
2584    -- 4.5  Logical Operator --
2585    ---------------------------
2586
2587    --  LOGICAL_OPERATOR  ::=  and | or | xor
2588
2589    --  Note: AND THEN and OR ELSE are also treated as logical operators
2590    --  by the parser (even though they are not operators semantically)
2591
2592    --  The value returned is the appropriate Node_Kind code for the operator
2593    --  On return, Token points to the token following the scanned operator.
2594
2595    --  The caller has checked that the first token is a legitimate logical
2596    --  operator token (i.e. is either XOR, AND, OR).
2597
2598    --  Error recovery: cannot raise Error_Resync
2599
2600    function P_Logical_Operator return Node_Kind is
2601    begin
2602       if Token = Tok_And then
2603          if Style_Check then
2604             Style.Check_Binary_Operator;
2605          end if;
2606
2607          Scan; -- past AND
2608
2609          if Token = Tok_Then then
2610             Scan; -- past THEN
2611             return N_And_Then;
2612          else
2613             return N_Op_And;
2614          end if;
2615
2616       elsif Token = Tok_Or then
2617          if Style_Check then
2618             Style.Check_Binary_Operator;
2619          end if;
2620
2621          Scan; -- past OR
2622
2623          if Token = Tok_Else then
2624             Scan; -- past ELSE
2625             return N_Or_Else;
2626          else
2627             return N_Op_Or;
2628          end if;
2629
2630       else -- Token = Tok_Xor
2631          if Style_Check then
2632             Style.Check_Binary_Operator;
2633          end if;
2634
2635          Scan; -- past XOR
2636          return N_Op_Xor;
2637       end if;
2638    end P_Logical_Operator;
2639
2640    ------------------------------
2641    -- 4.5  Relational Operator --
2642    ------------------------------
2643
2644    --  RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2645
2646    --  The value returned is the appropriate Node_Kind code for the operator.
2647    --  On return, Token points to the operator token, NOT past it.
2648
2649    --  The caller has checked that the first token is a legitimate relational
2650    --  operator token (i.e. is one of the operator tokens listed above).
2651
2652    --  Error recovery: cannot raise Error_Resync
2653
2654    function P_Relational_Operator return Node_Kind is
2655       Op_Kind : Node_Kind;
2656       Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
2657                      (Tok_Less          => N_Op_Lt,
2658                       Tok_Equal         => N_Op_Eq,
2659                       Tok_Greater       => N_Op_Gt,
2660                       Tok_Not_Equal     => N_Op_Ne,
2661                       Tok_Greater_Equal => N_Op_Ge,
2662                       Tok_Less_Equal    => N_Op_Le,
2663                       Tok_In            => N_In,
2664                       Tok_Not           => N_Not_In,
2665                       Tok_Box           => N_Op_Ne);
2666
2667    begin
2668       if Token = Tok_Box then
2669          Error_Msg_SC -- CODEFIX
2670            ("|""'<'>"" should be ""/=""");
2671       end if;
2672
2673       Op_Kind := Relop_Node (Token);
2674
2675       if Style_Check then
2676          Style.Check_Binary_Operator;
2677       end if;
2678
2679       Scan; -- past operator token
2680
2681       if Prev_Token = Tok_Not then
2682          T_In;
2683       end if;
2684
2685       return Op_Kind;
2686    end P_Relational_Operator;
2687
2688    ---------------------------------
2689    -- 4.5  Binary Adding Operator --
2690    ---------------------------------
2691
2692    --  BINARY_ADDING_OPERATOR ::= + | - | &
2693
2694    --  The value returned is the appropriate Node_Kind code for the operator.
2695    --  On return, Token points to the operator token (NOT past it).
2696
2697    --  The caller has checked that the first token is a legitimate adding
2698    --  operator token (i.e. is one of the operator tokens listed above).
2699
2700    --  Error recovery: cannot raise Error_Resync
2701
2702    function P_Binary_Adding_Operator return Node_Kind is
2703       Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
2704                      (Tok_Ampersand => N_Op_Concat,
2705                       Tok_Minus     => N_Op_Subtract,
2706                       Tok_Plus      => N_Op_Add);
2707    begin
2708       return Addop_Node (Token);
2709    end P_Binary_Adding_Operator;
2710
2711    --------------------------------
2712    -- 4.5  Unary Adding Operator --
2713    --------------------------------
2714
2715    --  UNARY_ADDING_OPERATOR ::= + | -
2716
2717    --  The value returned is the appropriate Node_Kind code for the operator.
2718    --  On return, Token points to the operator token (NOT past it).
2719
2720    --  The caller has checked that the first token is a legitimate adding
2721    --  operator token (i.e. is one of the operator tokens listed above).
2722
2723    --  Error recovery: cannot raise Error_Resync
2724
2725    function P_Unary_Adding_Operator return Node_Kind is
2726       Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
2727                      (Tok_Minus => N_Op_Minus,
2728                       Tok_Plus  => N_Op_Plus);
2729    begin
2730       return Addop_Node (Token);
2731    end P_Unary_Adding_Operator;
2732
2733    -------------------------------
2734    -- 4.5  Multiplying Operator --
2735    -------------------------------
2736
2737    --  MULTIPLYING_OPERATOR ::= * | / | mod | rem
2738
2739    --  The value returned is the appropriate Node_Kind code for the operator.
2740    --  On return, Token points to the operator token (NOT past it).
2741
2742    --  The caller has checked that the first token is a legitimate multiplying
2743    --  operator token (i.e. is one of the operator tokens listed above).
2744
2745    --  Error recovery: cannot raise Error_Resync
2746
2747    function P_Multiplying_Operator return Node_Kind is
2748       Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
2749         (Tok_Asterisk       => N_Op_Multiply,
2750          Tok_Mod            => N_Op_Mod,
2751          Tok_Rem            => N_Op_Rem,
2752          Tok_Slash          => N_Op_Divide);
2753    begin
2754       return Mulop_Node (Token);
2755    end P_Multiplying_Operator;
2756
2757    --------------------------------------
2758    -- 4.5  Highest Precedence Operator --
2759    --------------------------------------
2760
2761    --  Parsed by P_Factor (4.4)
2762
2763    --  Note: this rule is not in fact used by the grammar at any point!
2764
2765    --------------------------
2766    -- 4.6  Type Conversion --
2767    --------------------------
2768
2769    --  Parsed by P_Primary as a Name (4.1)
2770
2771    -------------------------------
2772    -- 4.7  Qualified Expression --
2773    -------------------------------
2774
2775    --  QUALIFIED_EXPRESSION ::=
2776    --    SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2777
2778    --  The caller has scanned the name which is the Subtype_Mark parameter
2779    --  and scanned past the single quote following the subtype mark. The
2780    --  caller has not checked that this name is in fact appropriate for
2781    --  a subtype mark name (i.e. it is a selected component or identifier).
2782
2783    --  Error_Recovery: cannot raise Error_Resync
2784
2785    function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
2786       Qual_Node : Node_Id;
2787    begin
2788       Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
2789       Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
2790       Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
2791       return Qual_Node;
2792    end P_Qualified_Expression;
2793
2794    --------------------
2795    -- 4.8  Allocator --
2796    --------------------
2797
2798    --  ALLOCATOR ::=
2799    --    new [NULL_EXCLUSION] SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2800
2801    --  The caller has checked that the initial token is NEW
2802
2803    --  Error recovery: can raise Error_Resync
2804
2805    function P_Allocator return Node_Id is
2806       Alloc_Node             : Node_Id;
2807       Type_Node              : Node_Id;
2808       Null_Exclusion_Present : Boolean;
2809
2810    begin
2811       Alloc_Node := New_Node (N_Allocator, Token_Ptr);
2812       T_New;
2813
2814       --  Scan Null_Exclusion if present (Ada 2005 (AI-231))
2815
2816       Null_Exclusion_Present := P_Null_Exclusion;
2817       Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
2818       Type_Node := P_Subtype_Mark_Resync;
2819
2820       if Token = Tok_Apostrophe then
2821          Scan; -- past apostrophe
2822          Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
2823       else
2824          Set_Expression
2825            (Alloc_Node,
2826             P_Subtype_Indication (Type_Node, Null_Exclusion_Present));
2827       end if;
2828
2829       return Alloc_Node;
2830    end P_Allocator;
2831
2832    -----------------------
2833    -- P_Case_Expression --
2834    -----------------------
2835
2836    function P_Case_Expression return Node_Id is
2837       Loc        : constant Source_Ptr := Token_Ptr;
2838       Case_Node  : Node_Id;
2839       Save_State : Saved_Scan_State;
2840
2841    begin
2842       if Ada_Version < Ada_2012 then
2843          Error_Msg_SC ("|case expression is an Ada 2012 feature");
2844          Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
2845       end if;
2846
2847       Scan; -- past CASE
2848       Case_Node :=
2849         Make_Case_Expression (Loc,
2850           Expression   => P_Expression_No_Right_Paren,
2851           Alternatives => New_List);
2852       T_Is;
2853
2854       --  We now have scanned out CASE expression IS, scan alternatives
2855
2856       loop
2857          T_When;
2858          Append_To (Alternatives (Case_Node), P_Case_Expression_Alternative);
2859
2860          --  Missing comma if WHEN (more alternatives present)
2861
2862          if Token = Tok_When then
2863             T_Comma;
2864
2865          --  If comma/WHEN, skip comma and we have another alternative
2866
2867          elsif Token = Tok_Comma then
2868             Save_Scan_State (Save_State);
2869             Scan; -- past comma
2870
2871             if Token /= Tok_When then
2872                Restore_Scan_State (Save_State);
2873                exit;
2874             end if;
2875
2876          --  If no comma or WHEN, definitely done
2877
2878          else
2879             exit;
2880          end if;
2881       end loop;
2882
2883       --  If we have an END CASE, diagnose as not needed
2884
2885       if Token = Tok_End then
2886          Error_Msg_SC ("`END CASE` not allowed at end of case expression");
2887          Scan; -- past END
2888
2889          if Token = Tok_Case then
2890             Scan; -- past CASE;
2891          end if;
2892       end if;
2893
2894       --  Return the Case_Expression node
2895
2896       return Case_Node;
2897    end P_Case_Expression;
2898
2899    -----------------------------------
2900    -- P_Case_Expression_Alternative --
2901    -----------------------------------
2902
2903    --  CASE_STATEMENT_ALTERNATIVE ::=
2904    --    when DISCRETE_CHOICE_LIST =>
2905    --      EXPRESSION
2906
2907    --  The caller has checked that and scanned past the initial WHEN token
2908    --  Error recovery: can raise Error_Resync
2909
2910    function P_Case_Expression_Alternative return Node_Id is
2911       Case_Alt_Node : Node_Id;
2912    begin
2913       Case_Alt_Node := New_Node (N_Case_Expression_Alternative, Token_Ptr);
2914       Set_Discrete_Choices (Case_Alt_Node, P_Discrete_Choice_List);
2915       TF_Arrow;
2916       Set_Expression (Case_Alt_Node, P_Expression);
2917       return Case_Alt_Node;
2918    end P_Case_Expression_Alternative;
2919
2920    ------------------------------
2921    -- P_Conditional_Expression --
2922    ------------------------------
2923
2924    function P_Conditional_Expression return Node_Id is
2925       Exprs : constant List_Id    := New_List;
2926       Loc   : constant Source_Ptr := Token_Ptr;
2927       Expr  : Node_Id;
2928       State : Saved_Scan_State;
2929
2930    begin
2931       Inside_Conditional_Expression := Inside_Conditional_Expression + 1;
2932
2933       if Token = Tok_If and then Ada_Version < Ada_2012 then
2934          Error_Msg_SC ("|conditional expression is an Ada 2012 feature");
2935          Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
2936       end if;
2937
2938       Scan; -- past IF or ELSIF
2939       Append_To (Exprs, P_Condition);
2940       TF_Then;
2941       Append_To (Exprs, P_Expression);
2942
2943       --  We now have scanned out IF expr THEN expr
2944
2945       --  Check for common error of semicolon before the ELSE
2946
2947       if Token = Tok_Semicolon then
2948          Save_Scan_State (State);
2949          Scan; -- past semicolon
2950
2951          if Token = Tok_Else or else Token = Tok_Elsif then
2952             Error_Msg_SP -- CODEFIX
2953               ("|extra "";"" ignored");
2954
2955          else
2956             Restore_Scan_State (State);
2957          end if;
2958       end if;
2959
2960       --  Scan out ELSIF sequence if present
2961
2962       if Token = Tok_Elsif then
2963          Expr := P_Conditional_Expression;
2964          Set_Is_Elsif (Expr);
2965          Append_To (Exprs, Expr);
2966
2967       --  Scan out ELSE phrase if present
2968
2969       elsif Token = Tok_Else then
2970
2971          --  Scan out ELSE expression
2972
2973          Scan; -- Past ELSE
2974          Append_To (Exprs, P_Expression);
2975
2976       --  Two expression case (implied True, filled in during semantics)
2977
2978       else
2979          null;
2980       end if;
2981
2982       --  If we have an END IF, diagnose as not needed
2983
2984       if Token = Tok_End then
2985          Error_Msg_SC
2986            ("`END IF` not allowed at end of conditional expression");
2987          Scan; -- past END
2988
2989          if Token = Tok_If then
2990             Scan; -- past IF;
2991          end if;
2992       end if;
2993
2994       Inside_Conditional_Expression := Inside_Conditional_Expression - 1;
2995
2996       --  Return the Conditional_Expression node
2997
2998       return
2999         Make_Conditional_Expression (Loc,
3000           Expressions => Exprs);
3001    end P_Conditional_Expression;
3002
3003    -----------------------
3004    -- P_Membership_Test --
3005    -----------------------
3006
3007    --  MEMBERSHIP_CHOICE_LIST ::= MEMBERHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
3008    --  MEMBERSHIP_CHOICE      ::= CHOICE_EXPRESSION | range | subtype_mark
3009
3010    procedure P_Membership_Test (N : Node_Id) is
3011       Alt : constant Node_Id :=
3012               P_Range_Or_Subtype_Mark
3013                 (Allow_Simple_Expression => (Ada_Version >= Ada_2012));
3014
3015    begin
3016       --  Set case
3017
3018       if Token = Tok_Vertical_Bar then
3019          if Ada_Version < Ada_2012 then
3020             Error_Msg_SC ("set notation is an Ada 2012 feature");
3021             Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
3022          end if;
3023
3024          Set_Alternatives (N, New_List (Alt));
3025          Set_Right_Opnd   (N, Empty);
3026
3027          --  Loop to accumulate alternatives
3028
3029          while Token = Tok_Vertical_Bar loop
3030             Scan; -- past vertical bar
3031             Append_To
3032               (Alternatives (N),
3033                P_Range_Or_Subtype_Mark (Allow_Simple_Expression => True));
3034          end loop;
3035
3036       --  Not set case
3037
3038       else
3039          Set_Right_Opnd   (N, Alt);
3040          Set_Alternatives (N, No_List);
3041       end if;
3042    end P_Membership_Test;
3043
3044 end Ch4;