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