gcc/ada/par-ch3.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P A R . C H 3                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2010, 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 Sinfo.CN; use Sinfo.CN;
  31
  32 separate (Par)
  33
  34 ---------
  35 -- Ch3 --
  36 ---------
  37
  38 package body Ch3 is
  39
  40    -----------------------
  41    -- Local Subprograms --
  42    -----------------------
  43
  44    function P_Component_List                               return Node_Id;
  45    function P_Defining_Character_Literal                   return Node_Id;
  46    function P_Delta_Constraint                             return Node_Id;
  47    function P_Derived_Type_Def_Or_Private_Ext_Decl         return Node_Id;
  48    function P_Digits_Constraint                            return Node_Id;
  49    function P_Discriminant_Association                     return Node_Id;
  50    function P_Enumeration_Literal_Specification            return Node_Id;
  51    function P_Enumeration_Type_Definition                  return Node_Id;
  52    function P_Fixed_Point_Definition                       return Node_Id;
  53    function P_Floating_Point_Definition                    return Node_Id;
  54    function P_Index_Or_Discriminant_Constraint             return Node_Id;
  55    function P_Real_Range_Specification_Opt                 return Node_Id;
  56    function P_Subtype_Declaration                          return Node_Id;
  57    function P_Type_Declaration                             return Node_Id;
  58    function P_Modular_Type_Definition                      return Node_Id;
  59    function P_Variant                                      return Node_Id;
  60    function P_Variant_Part                                 return Node_Id;
  61
  62    procedure Check_Restricted_Expression (N : Node_Id);
  63    --  Check that the expression N meets the Restricted_Expression syntax.
  64    --  The syntax is as follows:
  65    --
  66    --    RESTRICTED_EXPRESSION ::=
  67    --        RESTRICTED_RELATION {and RESTRICTED_RELATION}
  68    --      | RESTRICTED_RELATION {and then RESTRICTED_RELATION}
  69    --      | RESTRICTED_RELATION {or RESTRICTED_RELATION}
  70    --      | RESTRICTED_RELATION {or else RESTRICTED_RELATION}
  71    --      | RESTRICTED_RELATION {xor RESTRICTED_RELATION}
  72    --
  73    --    RESTRICTED_RELATION ::=
  74    --       SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
  75    --
  76    --  This syntax is used for choices when extensions (and set notations)
  77    --  are enabled, to remove the ambiguity of "when X in A | B". We consider
  78    --  it very unlikely that this will ever arise in practice.
  79
  80    procedure P_Declarative_Items
  81      (Decls   : List_Id;
  82       Done    : out Boolean;
  83       In_Spec : Boolean);
  84    --  Scans out a single declarative item, or, in the case of a declaration
  85    --  with a list of identifiers, a list of declarations, one for each of the
  86    --  identifiers in the list. The declaration or declarations scanned are
  87    --  appended to the given list. Done indicates whether or not there may be
  88    --  additional declarative items to scan. If Done is True, then a decision
  89    --  has been made that there are no more items to scan. If Done is False,
  90    --  then there may be additional declarations to scan. In_Spec is true if
  91    --  we are scanning a package declaration, and is used to generate an
  92    --  appropriate message if a statement is encountered in such a context.
  93
  94    procedure P_Identifier_Declarations
  95      (Decls   : List_Id;
  96       Done    : out Boolean;
  97       In_Spec : Boolean);
  98    --  Scans out a set of declarations for an identifier or list of
  99    --  identifiers, and appends them to the given list. The parameters have
 100    --  the same significance as for P_Declarative_Items.
 101
 102    procedure Statement_When_Declaration_Expected
 103      (Decls   : List_Id;
 104       Done    : out Boolean;
 105       In_Spec : Boolean);
 106    --  Called when a statement is found at a point where a declaration was
 107    --  expected. The parameters are as described for P_Declarative_Items.
 108
 109    procedure Set_Declaration_Expected;
 110    --  Posts a "declaration expected" error messages at the start of the
 111    --  current token, and if this is the first such message issued, saves
 112    --  the message id in Missing_Begin_Msg, for possible later replacement.
 113
 114    ---------------------------------
 115    -- Check_Restricted_Expression --
 116    ---------------------------------
 117
 118    procedure Check_Restricted_Expression (N : Node_Id) is
 119    begin
 120       if Nkind_In (N, N_Op_And, N_Op_Or, N_Op_Xor, N_And_Then, N_Or_Else) then
 121          Check_Restricted_Expression (Left_Opnd (N));
 122          Check_Restricted_Expression (Right_Opnd (N));
 123
 124       elsif Nkind_In (N, N_In, N_Not_In)
 125         and then Paren_Count (N) = 0
 126       then
 127          Error_Msg_N
 128            ("|this expression must be parenthesized in Ada 2012 mode!", N);
 129       end if;
 130    end Check_Restricted_Expression;
 131
 132    -------------------
 133    -- Init_Expr_Opt --
 134    -------------------
 135
 136    function Init_Expr_Opt (P : Boolean := False) return Node_Id is
 137    begin
 138       --  For colon, assume it means := unless it is at the end of
 139       --  a line, in which case guess that it means a semicolon.
 140
 141       if Token = Tok_Colon then
 142          if Token_Is_At_End_Of_Line then
 143             T_Semicolon;
 144             return Empty;
 145          end if;
 146
 147       --  Here if := or something that we will take as equivalent
 148
 149       elsif Token = Tok_Colon_Equal
 150         or else Token = Tok_Equal
 151         or else Token = Tok_Is
 152       then
 153          null;
 154
 155       --  Another possibility. If we have a literal followed by a semicolon,
 156       --  we assume that we have a missing colon-equal.
 157
 158       elsif Token in Token_Class_Literal then
 159          declare
 160             Scan_State : Saved_Scan_State;
 161
 162          begin
 163             Save_Scan_State (Scan_State);
 164             Scan; -- past literal or identifier
 165
 166             if Token = Tok_Semicolon then
 167                Restore_Scan_State (Scan_State);
 168             else
 169                Restore_Scan_State (Scan_State);
 170                return Empty;
 171             end if;
 172          end;
 173
 174       --  Otherwise we definitely have no initialization expression
 175
 176       else
 177          return Empty;
 178       end if;
 179
 180       --  Merge here if we have an initialization expression
 181
 182       T_Colon_Equal;
 183
 184       if P then
 185          return P_Expression;
 186       else
 187          return P_Expression_No_Right_Paren;
 188       end if;
 189    end Init_Expr_Opt;
 190
 191    ----------------------------
 192    -- 3.1  Basic Declaration --
 193    ----------------------------
 194
 195    --  Parsed by P_Basic_Declarative_Items (3.9)
 196
 197    ------------------------------
 198    -- 3.1  Defining Identifier --
 199    ------------------------------
 200
 201    --  DEFINING_IDENTIFIER ::= IDENTIFIER
 202
 203    --  Error recovery: can raise Error_Resync
 204
 205    function P_Defining_Identifier (C : Id_Check := None) return Node_Id is
 206       Ident_Node : Node_Id;
 207
 208    begin
 209       --  Scan out the identifier. Note that this code is essentially identical
 210       --  to P_Identifier, except that in the call to Scan_Reserved_Identifier
 211       --  we set Force_Msg to True, since we want at least one message for each
 212       --  separate declaration (but not use) of a reserved identifier.
 213
 214       if Token = Tok_Identifier then
 215
 216          --  Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
 217          --  OVERRIDING, and SYNCHRONIZED are new reserved words. Note that
 218          --  in the case where these keywords are misused in Ada 95 mode,
 219          --  this routine will generally not be called at all.
 220
 221          if Ada_Version = Ada_95
 222            and then Warn_On_Ada_2005_Compatibility
 223          then
 224             if Token_Name = Name_Overriding
 225               or else Token_Name = Name_Synchronized
 226               or else (Token_Name = Name_Interface
 227                         and then Prev_Token /= Tok_Pragma)
 228             then
 229                Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node);
 230             end if;
 231          end if;
 232
 233       --  If we have a reserved identifier, manufacture an identifier with
 234       --  a corresponding name after posting an appropriate error message
 235
 236       elsif Is_Reserved_Identifier (C) then
 237          Scan_Reserved_Identifier (Force_Msg => True);
 238
 239       --  Otherwise we have junk that cannot be interpreted as an identifier
 240
 241       else
 242          T_Identifier; -- to give message
 243          raise Error_Resync;
 244       end if;
 245
 246       Ident_Node := Token_Node;
 247       Scan; -- past the reserved identifier
 248
 249       --  If we already have a defining identifier, clean it out and make
 250       --  a new clean identifier. This situation arises in some error cases
 251       --  and we need to fix it.
 252
 253       if Nkind (Ident_Node) = N_Defining_Identifier then
 254          Ident_Node :=
 255            Make_Identifier (Sloc (Ident_Node),
 256              Chars => Chars (Ident_Node));
 257       end if;
 258
 259       --  Change identifier to defining identifier if not in error
 260
 261       if Ident_Node /= Error then
 262          Change_Identifier_To_Defining_Identifier (Ident_Node);
 263       end if;
 264
 265       return Ident_Node;
 266    end P_Defining_Identifier;
 267
 268    -----------------------------
 269    -- 3.2.1  Type Declaration --
 270    -----------------------------
 271
 272    --  TYPE_DECLARATION ::=
 273    --    FULL_TYPE_DECLARATION
 274    --  | INCOMPLETE_TYPE_DECLARATION
 275    --  | PRIVATE_TYPE_DECLARATION
 276    --  | PRIVATE_EXTENSION_DECLARATION
 277
 278    --  FULL_TYPE_DECLARATION ::=
 279    --    type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART] is TYPE_DEFINITION
 280    --      [ASPECT_SPECIFICATIONS];
 281    --  | CONCURRENT_TYPE_DECLARATION
 282
 283    --  INCOMPLETE_TYPE_DECLARATION ::=
 284    --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] [is tagged];
 285
 286    --  PRIVATE_TYPE_DECLARATION ::=
 287    --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
 288    --      is [abstract] [tagged] [limited] private;
 289
 290    --  PRIVATE_EXTENSION_DECLARATION ::=
 291    --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
 292    --      [abstract] [limited | synchronized]
 293    --        new ancestor_SUBTYPE_INDICATION [and INTERFACE_LIST]
 294    --          with private;
 295
 296    --  TYPE_DEFINITION ::=
 297    --    ENUMERATION_TYPE_DEFINITION  | INTEGER_TYPE_DEFINITION
 298    --  | REAL_TYPE_DEFINITION         | ARRAY_TYPE_DEFINITION
 299    --  | RECORD_TYPE_DEFINITION       | ACCESS_TYPE_DEFINITION
 300    --  | DERIVED_TYPE_DEFINITION      | INTERFACE_TYPE_DEFINITION
 301
 302    --  INTEGER_TYPE_DEFINITION ::=
 303    --    SIGNED_INTEGER_TYPE_DEFINITION
 304    --    MODULAR_TYPE_DEFINITION
 305
 306    --  INTERFACE_TYPE_DEFINITION ::=
 307    --    [limited | task | protected | synchronized ] interface
 308    --      [and INTERFACE_LIST]
 309
 310    --  Error recovery: can raise Error_Resync
 311
 312    --  The processing for full type declarations, incomplete type declarations,
 313    --  private type declarations and type definitions is included in this
 314    --  function. The processing for concurrent type declarations is NOT here,
 315    --  but rather in chapter 9 (this function handles only declarations
 316    --  starting with TYPE).
 317
 318    function P_Type_Declaration return Node_Id is
 319       Abstract_Present : Boolean := False;
 320       Abstract_Loc     : Source_Ptr := No_Location;
 321       Decl_Node        : Node_Id;
 322       Discr_List       : List_Id;
 323       Discr_Sloc       : Source_Ptr;
 324       End_Labl         : Node_Id;
 325       Ident_Node       : Node_Id;
 326       Is_Derived_Iface : Boolean := False;
 327       Type_Loc         : Source_Ptr;
 328       Type_Start_Col   : Column_Number;
 329       Unknown_Dis      : Boolean;
 330
 331       Typedef_Node : Node_Id;
 332       --  Normally holds type definition, except in the case of a private
 333       --  extension declaration, in which case it holds the declaration itself
 334
 335    begin
 336       Type_Loc := Token_Ptr;
 337       Type_Start_Col := Start_Column;
 338
 339       --  If we have TYPE, then proceed ahead and scan identifier
 340
 341       if Token = Tok_Type then
 342          Type_Token_Location := Type_Loc;
 343          Scan; -- past TYPE
 344          Ident_Node := P_Defining_Identifier (C_Is);
 345
 346       --  Otherwise this is an error case
 347
 348       else
 349          T_Type;
 350          Type_Token_Location := Type_Loc;
 351          Ident_Node := P_Defining_Identifier (C_Is);
 352       end if;
 353
 354       Discr_Sloc := Token_Ptr;
 355
 356       if P_Unknown_Discriminant_Part_Opt then
 357          Unknown_Dis := True;
 358          Discr_List := No_List;
 359       else
 360          Unknown_Dis := False;
 361          Discr_List := P_Known_Discriminant_Part_Opt;
 362       end if;
 363
 364       --  Incomplete type declaration. We complete the processing for this
 365       --  case here and return the resulting incomplete type declaration node
 366
 367       if Token = Tok_Semicolon then
 368          Scan; -- past ;
 369          Decl_Node := New_Node (N_Incomplete_Type_Declaration, Type_Loc);
 370          Set_Defining_Identifier (Decl_Node, Ident_Node);
 371          Set_Unknown_Discriminants_Present (Decl_Node, Unknown_Dis);
 372          Set_Discriminant_Specifications (Decl_Node, Discr_List);
 373          return Decl_Node;
 374
 375       else
 376          Decl_Node := Empty;
 377       end if;
 378
 379       --  Full type declaration or private type declaration, must have IS
 380
 381       if Token = Tok_Equal then
 382          TF_Is;
 383          Scan; -- past = used in place of IS
 384
 385       elsif Token = Tok_Renames then
 386          Error_Msg_SC  -- CODEFIX
 387            ("RENAMES should be IS");
 388          Scan; -- past RENAMES used in place of IS
 389
 390       else
 391          TF_Is;
 392       end if;
 393
 394       --  First an error check, if we have two identifiers in a row, a likely
 395       --  possibility is that the first of the identifiers is an incorrectly
 396       --  spelled keyword.
 397
 398       if Token = Tok_Identifier then
 399          declare
 400             SS : Saved_Scan_State;
 401             I2 : Boolean;
 402
 403          begin
 404             Save_Scan_State (SS);
 405             Scan; -- past initial identifier
 406             I2 := (Token = Tok_Identifier);
 407             Restore_Scan_State (SS);
 408
 409             if I2
 410               and then
 411                 (Bad_Spelling_Of (Tok_Abstract) or else
 412                  Bad_Spelling_Of (Tok_Access)   or else
 413                  Bad_Spelling_Of (Tok_Aliased)  or else
 414                  Bad_Spelling_Of (Tok_Constant))
 415             then
 416                null;
 417             end if;
 418          end;
 419       end if;
 420
 421       --  Check for misuse of Ada 95 keyword abstract in Ada 83 mode
 422
 423       if Token_Name = Name_Abstract then
 424          Check_95_Keyword (Tok_Abstract, Tok_Tagged);
 425          Check_95_Keyword (Tok_Abstract, Tok_New);
 426       end if;
 427
 428       --  Check cases of misuse of ABSTRACT
 429
 430       if Token = Tok_Abstract then
 431          Abstract_Present := True;
 432          Abstract_Loc     := Token_Ptr;
 433          Scan; -- past ABSTRACT
 434
 435          --  Ada 2005 (AI-419): AARM 3.4 (2/2)
 436
 437          if (Ada_Version < Ada_2005 and then Token = Tok_Limited)
 438            or else Token = Tok_Private
 439            or else Token = Tok_Record
 440            or else Token = Tok_Null
 441          then
 442             Error_Msg_AP ("TAGGED expected");
 443          end if;
 444       end if;
 445
 446       --  Check for misuse of Ada 95 keyword Tagged
 447
 448       if Token_Name = Name_Tagged then
 449          Check_95_Keyword (Tok_Tagged, Tok_Private);
 450          Check_95_Keyword (Tok_Tagged, Tok_Limited);
 451          Check_95_Keyword (Tok_Tagged, Tok_Record);
 452       end if;
 453
 454       --  Special check for misuse of Aliased
 455
 456       if Token = Tok_Aliased or else Token_Name = Name_Aliased then
 457          Error_Msg_SC ("ALIASED not allowed in type definition");
 458          Scan; -- past ALIASED
 459       end if;
 460
 461       --  The following processing deals with either a private type declaration
 462       --  or a full type declaration. In the private type case, we build the
 463       --  N_Private_Type_Declaration node, setting its Tagged_Present and
 464       --  Limited_Present flags, on encountering the Private keyword, and
 465       --  leave Typedef_Node set to Empty. For the full type declaration
 466       --  case, Typedef_Node gets set to the type definition.
 467
 468       Typedef_Node := Empty;
 469
 470       --  Switch on token following the IS. The loop normally runs once. It
 471       --  only runs more than once if an error is detected, to try again after
 472       --  detecting and fixing up the error.
 473
 474       loop
 475          case Token is
 476
 477             when Tok_Access |
 478                  Tok_Not    => --  Ada 2005 (AI-231)
 479                Typedef_Node := P_Access_Type_Definition;
 480                exit;
 481
 482             when Tok_Array =>
 483                Typedef_Node := P_Array_Type_Definition;
 484                exit;
 485
 486             when Tok_Delta =>
 487                Typedef_Node := P_Fixed_Point_Definition;
 488                exit;
 489
 490             when Tok_Digits =>
 491                Typedef_Node := P_Floating_Point_Definition;
 492                exit;
 493
 494             when Tok_In =>
 495                Ignore (Tok_In);
 496
 497             when Tok_Integer_Literal =>
 498                T_Range;
 499                Typedef_Node := P_Signed_Integer_Type_Definition;
 500                exit;
 501
 502             when Tok_Null =>
 503                Typedef_Node := P_Record_Definition;
 504                exit;
 505
 506             when Tok_Left_Paren =>
 507                Typedef_Node := P_Enumeration_Type_Definition;
 508
 509                End_Labl :=
 510                  Make_Identifier (Token_Ptr,
 511                    Chars => Chars (Ident_Node));
 512                Set_Comes_From_Source (End_Labl, False);
 513
 514                Set_End_Label (Typedef_Node, End_Labl);
 515                exit;
 516
 517             when Tok_Mod =>
 518                Typedef_Node := P_Modular_Type_Definition;
 519                exit;
 520
 521             when Tok_New =>
 522                Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
 523
 524                if Nkind (Typedef_Node) = N_Derived_Type_Definition
 525                  and then Present (Record_Extension_Part (Typedef_Node))
 526                then
 527                   End_Labl :=
 528                     Make_Identifier (Token_Ptr,
 529                       Chars => Chars (Ident_Node));
 530                   Set_Comes_From_Source (End_Labl, False);
 531
 532                   Set_End_Label
 533                     (Record_Extension_Part (Typedef_Node), End_Labl);
 534                end if;
 535
 536                exit;
 537
 538             when Tok_Range =>
 539                Typedef_Node := P_Signed_Integer_Type_Definition;
 540                exit;
 541
 542             when Tok_Record =>
 543                Typedef_Node := P_Record_Definition;
 544
 545                End_Labl :=
 546                  Make_Identifier (Token_Ptr,
 547                    Chars => Chars (Ident_Node));
 548                Set_Comes_From_Source (End_Labl, False);
 549
 550                Set_End_Label (Typedef_Node, End_Labl);
 551                exit;
 552
 553             when Tok_Tagged =>
 554                Scan; -- past TAGGED
 555
 556                --  Ada 2005 (AI-326): If the words IS TAGGED appear, the type
 557                --  is a tagged incomplete type.
 558
 559                if Ada_Version >= Ada_2005
 560                  and then Token = Tok_Semicolon
 561                then
 562                   Scan; -- past ;
 563
 564                   Decl_Node :=
 565                     New_Node (N_Incomplete_Type_Declaration, Type_Loc);
 566                   Set_Defining_Identifier           (Decl_Node, Ident_Node);
 567                   Set_Tagged_Present                (Decl_Node);
 568                   Set_Unknown_Discriminants_Present (Decl_Node, Unknown_Dis);
 569                   Set_Discriminant_Specifications   (Decl_Node, Discr_List);
 570
 571                   return Decl_Node;
 572                end if;
 573
 574                if Token = Tok_Abstract then
 575                   Error_Msg_SC -- CODEFIX
 576                     ("ABSTRACT must come before TAGGED");
 577                   Abstract_Present := True;
 578                   Abstract_Loc := Token_Ptr;
 579                   Scan; -- past ABSTRACT
 580                end if;
 581
 582                if Token = Tok_Limited then
 583                   Scan; -- past LIMITED
 584
 585                   --  TAGGED LIMITED PRIVATE case
 586
 587                   if Token = Tok_Private then
 588                      Decl_Node :=
 589                        New_Node (N_Private_Type_Declaration, Type_Loc);
 590                      Set_Tagged_Present (Decl_Node, True);
 591                      Set_Limited_Present (Decl_Node, True);
 592                      Scan; -- past PRIVATE
 593
 594                   --  TAGGED LIMITED RECORD
 595
 596                   else
 597                      Typedef_Node := P_Record_Definition;
 598                      Set_Tagged_Present (Typedef_Node, True);
 599                      Set_Limited_Present (Typedef_Node, True);
 600
 601                      End_Labl :=
 602                        Make_Identifier (Token_Ptr,
 603                          Chars => Chars (Ident_Node));
 604                      Set_Comes_From_Source (End_Labl, False);
 605
 606                      Set_End_Label (Typedef_Node, End_Labl);
 607                   end if;
 608
 609                else
 610                   --  TAGGED PRIVATE
 611
 612                   if Token = Tok_Private then
 613                      Decl_Node :=
 614                        New_Node (N_Private_Type_Declaration, Type_Loc);
 615                      Set_Tagged_Present (Decl_Node, True);
 616                      Scan; -- past PRIVATE
 617
 618                   --  TAGGED RECORD
 619
 620                   else
 621                      Typedef_Node := P_Record_Definition;
 622                      Set_Tagged_Present (Typedef_Node, True);
 623
 624                      End_Labl :=
 625                        Make_Identifier (Token_Ptr,
 626                          Chars => Chars (Ident_Node));
 627                      Set_Comes_From_Source (End_Labl, False);
 628
 629                      Set_End_Label (Typedef_Node, End_Labl);
 630                   end if;
 631                end if;
 632
 633                exit;
 634
 635             when Tok_Limited =>
 636                Scan; -- past LIMITED
 637
 638                loop
 639                   if Token = Tok_Tagged then
 640                      Error_Msg_SC -- CODEFIX
 641                        ("TAGGED must come before LIMITED");
 642                      Scan; -- past TAGGED
 643
 644                   elsif Token = Tok_Abstract then
 645                      Error_Msg_SC -- CODEFIX
 646                        ("ABSTRACT must come before LIMITED");
 647                      Scan; -- past ABSTRACT
 648
 649                   else
 650                      exit;
 651                   end if;
 652                end loop;
 653
 654                --  LIMITED RECORD or LIMITED NULL RECORD
 655
 656                if Token = Tok_Record or else Token = Tok_Null then
 657                   if Ada_Version = Ada_83 then
 658                      Error_Msg_SP
 659                        ("(Ada 83) limited record declaration not allowed!");
 660
 661                   --  In Ada2005, "abstract limited" can appear before "new",
 662                   --  but it cannot be part of an untagged record declaration.
 663
 664                   elsif Abstract_Present
 665                     and then Prev_Token /= Tok_Tagged
 666                   then
 667                      Error_Msg_SP ("TAGGED expected");
 668                   end if;
 669
 670                   Typedef_Node := P_Record_Definition;
 671                   Set_Limited_Present (Typedef_Node, True);
 672
 673                --  Ada 2005 (AI-251): LIMITED INTERFACE
 674
 675                --  If we are compiling in Ada 83 or Ada 95 mode, "interface"
 676                --  is not a reserved word but we force its analysis to
 677                --  generate the corresponding usage error.
 678
 679                elsif Token = Tok_Interface
 680                  or else (Token = Tok_Identifier
 681                            and then Chars (Token_Node) = Name_Interface)
 682                then
 683                   Typedef_Node :=
 684                     P_Interface_Type_Definition (Abstract_Present);
 685                   Abstract_Present := True;
 686                   Set_Limited_Present (Typedef_Node);
 687
 688                   if Nkind (Typedef_Node) = N_Derived_Type_Definition then
 689                      Is_Derived_Iface := True;
 690                   end if;
 691
 692                   --  Ada 2005 (AI-419): LIMITED NEW
 693
 694                elsif Token = Tok_New then
 695                   if Ada_Version < Ada_2005 then
 696                      Error_Msg_SP
 697                        ("LIMITED in derived type is an Ada 2005 extension");
 698                      Error_Msg_SP
 699                        ("\unit must be compiled with -gnat05 switch");
 700                   end if;
 701
 702                   Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
 703                   Set_Limited_Present (Typedef_Node);
 704
 705                   if Nkind (Typedef_Node) = N_Derived_Type_Definition
 706                     and then Present (Record_Extension_Part (Typedef_Node))
 707                   then
 708                      End_Labl :=
 709                        Make_Identifier (Token_Ptr,
 710                                         Chars => Chars (Ident_Node));
 711                      Set_Comes_From_Source (End_Labl, False);
 712
 713                      Set_End_Label
 714                        (Record_Extension_Part (Typedef_Node), End_Labl);
 715                   end if;
 716
 717                --  LIMITED PRIVATE is the only remaining possibility here
 718
 719                else
 720                   Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc);
 721                   Set_Limited_Present (Decl_Node, True);
 722                   T_Private; -- past PRIVATE (or complain if not there!)
 723                end if;
 724
 725                exit;
 726
 727             --  Here we have an identifier after the IS, which is certainly
 728             --  wrong and which might be one of several different mistakes.
 729
 730             when Tok_Identifier =>
 731
 732                --  First case, if identifier is on same line, then probably we
 733                --  have something like "type X is Integer .." and the best
 734                --  diagnosis is a missing NEW. Note: the missing new message
 735                --  will be posted by P_Derived_Type_Def_Or_Private_Ext_Decl.
 736
 737                if not Token_Is_At_Start_Of_Line then
 738                   Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
 739
 740                --  If the identifier is at the start of the line, and is in the
 741                --  same column as the type declaration itself then we consider
 742                --  that we had a missing type definition on the previous line
 743
 744                elsif Start_Column <= Type_Start_Col then
 745                   Error_Msg_AP ("type definition expected");
 746                   Typedef_Node := Error;
 747
 748                --  If the identifier is at the start of the line, and is in
 749                --  a column to the right of the type declaration line, then we
 750                --  may have something like:
 751
 752                --    type x is
 753                --       r : integer
 754
 755                --  and the best diagnosis is a missing record keyword
 756
 757                else
 758                   Typedef_Node := P_Record_Definition;
 759                end if;
 760
 761                exit;
 762
 763             --  Ada 2005 (AI-251): INTERFACE
 764
 765             when Tok_Interface =>
 766                Typedef_Node := P_Interface_Type_Definition (Abstract_Present);
 767                Abstract_Present := True;
 768                exit;
 769
 770             when Tok_Private =>
 771                Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc);
 772                Scan; -- past PRIVATE
 773
 774                --  Check error cases of private [abstract] tagged
 775
 776                if Token = Tok_Abstract then
 777                   Error_Msg_SC ("`ABSTRACT TAGGED` must come before PRIVATE");
 778                   Scan; -- past ABSTRACT
 779
 780                   if Token = Tok_Tagged then
 781                      Scan; -- past TAGGED
 782                   end if;
 783
 784                elsif Token = Tok_Tagged then
 785                   Error_Msg_SC ("TAGGED must come before PRIVATE");
 786                   Scan; -- past TAGGED
 787                end if;
 788
 789                exit;
 790
 791             --  Ada 2005 (AI-345): Protected, synchronized or task interface
 792             --  or Ada 2005 (AI-443): Synchronized private extension.
 793
 794             when Tok_Protected    |
 795                  Tok_Synchronized |
 796                  Tok_Task         =>
 797
 798                declare
 799                   Saved_Token : constant Token_Type := Token;
 800
 801                begin
 802                   Scan; -- past TASK, PROTECTED or SYNCHRONIZED
 803
 804                   --  Synchronized private extension
 805
 806                   if Token = Tok_New then
 807                      Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
 808
 809                      if Saved_Token = Tok_Synchronized then
 810                         if Nkind (Typedef_Node) =
 811                           N_Derived_Type_Definition
 812                         then
 813                            Error_Msg_N
 814                              ("SYNCHRONIZED not allowed for record extension",
 815                               Typedef_Node);
 816                         else
 817                            Set_Synchronized_Present (Typedef_Node);
 818                         end if;
 819
 820                      else
 821                         Error_Msg_SC ("invalid kind of private extension");
 822                      end if;
 823
 824                   --  Interface
 825
 826                   else
 827                      if Token /= Tok_Interface then
 828                         Error_Msg_SC ("NEW or INTERFACE expected");
 829                      end if;
 830
 831                      Typedef_Node :=
 832                        P_Interface_Type_Definition (Abstract_Present);
 833                      Abstract_Present := True;
 834
 835                      case Saved_Token is
 836                         when Tok_Task =>
 837                            Set_Task_Present         (Typedef_Node);
 838
 839                         when Tok_Protected =>
 840                            Set_Protected_Present    (Typedef_Node);
 841
 842                         when Tok_Synchronized =>
 843                            Set_Synchronized_Present (Typedef_Node);
 844
 845                         when others =>
 846                            pragma Assert (False);
 847                            null;
 848                      end case;
 849                   end if;
 850                end;
 851
 852                exit;
 853
 854             --  Anything else is an error
 855
 856             when others =>
 857                if Bad_Spelling_Of (Tok_Access)
 858                     or else
 859                   Bad_Spelling_Of (Tok_Array)
 860                     or else
 861                   Bad_Spelling_Of (Tok_Delta)
 862                     or else
 863                   Bad_Spelling_Of (Tok_Digits)
 864                     or else
 865                   Bad_Spelling_Of (Tok_Limited)
 866                     or else
 867                   Bad_Spelling_Of (Tok_Private)
 868                     or else
 869                   Bad_Spelling_Of (Tok_Range)
 870                     or else
 871                   Bad_Spelling_Of (Tok_Record)
 872                     or else
 873                   Bad_Spelling_Of (Tok_Tagged)
 874                then
 875                   null;
 876
 877                else
 878                   Error_Msg_AP ("type definition expected");
 879                   raise Error_Resync;
 880                end if;
 881
 882          end case;
 883       end loop;
 884
 885       --  For the private type declaration case, the private type declaration
 886       --  node has been built, with the Tagged_Present and Limited_Present
 887       --  flags set as needed, and Typedef_Node is left set to Empty.
 888
 889       if No (Typedef_Node) then
 890          Set_Unknown_Discriminants_Present (Decl_Node, Unknown_Dis);
 891          Set_Abstract_Present (Decl_Node, Abstract_Present);
 892
 893       --  For a private extension declaration, Typedef_Node contains the
 894       --  N_Private_Extension_Declaration node, which we now complete. Note
 895       --  that the private extension declaration, unlike a full type
 896       --  declaration, does permit unknown discriminants.
 897
 898       elsif Nkind (Typedef_Node) = N_Private_Extension_Declaration then
 899          Decl_Node := Typedef_Node;
 900          Set_Sloc (Decl_Node, Type_Loc);
 901          Set_Unknown_Discriminants_Present (Decl_Node, Unknown_Dis);
 902          Set_Abstract_Present (Typedef_Node, Abstract_Present);
 903
 904       --  In the full type declaration case, Typedef_Node has the type
 905       --  definition and here is where we build the full type declaration
 906       --  node. This is also where we check for improper use of an unknown
 907       --  discriminant part (not allowed for full type declaration).
 908
 909       else
 910          if Nkind (Typedef_Node) = N_Record_Definition
 911            or else (Nkind (Typedef_Node) = N_Derived_Type_Definition
 912                       and then Present (Record_Extension_Part (Typedef_Node)))
 913            or else Is_Derived_Iface
 914          then
 915             Set_Abstract_Present (Typedef_Node, Abstract_Present);
 916
 917          elsif Abstract_Present then
 918             Error_Msg ("ABSTRACT not allowed here, ignored", Abstract_Loc);
 919          end if;
 920
 921          Decl_Node := New_Node (N_Full_Type_Declaration, Type_Loc);
 922          Set_Type_Definition (Decl_Node, Typedef_Node);
 923
 924          if Unknown_Dis then
 925             Error_Msg
 926               ("Full type declaration cannot have unknown discriminants",
 927                 Discr_Sloc);
 928          end if;
 929       end if;
 930
 931       --  Remaining processing is common for all three cases
 932
 933       Set_Defining_Identifier (Decl_Node, Ident_Node);
 934       Set_Discriminant_Specifications (Decl_Node, Discr_List);
 935       P_Aspect_Specifications (Decl_Node);
 936       return Decl_Node;
 937    end P_Type_Declaration;
 938
 939    ----------------------------------
 940    -- 3.2.1  Full Type Declaration --
 941    ----------------------------------
 942
 943    --  Parsed by P_Type_Declaration (3.2.1)
 944
 945    ----------------------------
 946    -- 3.2.1  Type Definition --
 947    ----------------------------
 948
 949    --  Parsed by P_Type_Declaration (3.2.1)
 950
 951    --------------------------------
 952    -- 3.2.2  Subtype Declaration --
 953    --------------------------------
 954
 955    --  SUBTYPE_DECLARATION ::=
 956    --    subtype DEFINING_IDENTIFIER is [NULL_EXCLUSION] SUBTYPE_INDICATION;
 957
 958    --  The caller has checked that the initial token is SUBTYPE
 959
 960    --  Error recovery: can raise Error_Resync
 961
 962    function P_Subtype_Declaration return Node_Id is
 963       Decl_Node        : Node_Id;
 964       Not_Null_Present : Boolean := False;
 965
 966    begin
 967       Decl_Node := New_Node (N_Subtype_Declaration, Token_Ptr);
 968       Scan; -- past SUBTYPE
 969       Set_Defining_Identifier (Decl_Node, P_Defining_Identifier (C_Is));
 970       TF_Is;
 971
 972       if Token = Tok_New then
 973          Error_Msg_SC  -- CODEFIX
 974            ("NEW ignored (only allowed in type declaration)");
 975          Scan; -- past NEW
 976       end if;
 977
 978       Not_Null_Present := P_Null_Exclusion; --  Ada 2005 (AI-231)
 979       Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
 980
 981       Set_Subtype_Indication
 982         (Decl_Node, P_Subtype_Indication (Not_Null_Present));
 983       P_Aspect_Specifications (Decl_Node);
 984       return Decl_Node;
 985    end P_Subtype_Declaration;
 986
 987    -------------------------------
 988    -- 3.2.2  Subtype Indication --
 989    -------------------------------
 990
 991    --  SUBTYPE_INDICATION ::=
 992    --    [not null] SUBTYPE_MARK [CONSTRAINT]
 993
 994    --  Error recovery: can raise Error_Resync
 995
 996    function P_Null_Exclusion
 997      (Allow_Anonymous_In_95 : Boolean := False) return Boolean
 998    is
 999       Not_Loc : constant Source_Ptr := Token_Ptr;
1000       --  Source position of "not", if present
1001
1002    begin
1003       if Token /= Tok_Not then
1004          return False;
1005
1006       else
1007          Scan; --  past NOT
1008
1009          if Token = Tok_Null then
1010             Scan; --  past NULL
1011
1012             --  Ada 2005 (AI-441, AI-447): null_exclusion is illegal in Ada 95,
1013             --  except in the case of anonymous access types.
1014
1015             --  Allow_Anonymous_In_95 will be True if we're parsing a formal
1016             --  parameter or discriminant, which are the only places where
1017             --  anonymous access types occur in Ada 95. "Formal : not null
1018             --  access ..." is legal in Ada 95, whereas "Formal : not null
1019             --  Named_Access_Type" is not.
1020
1021             if Ada_Version >= Ada_2005
1022               or else (Ada_Version >= Ada_95
1023                         and then Allow_Anonymous_In_95
1024                         and then Token = Tok_Access)
1025             then
1026                null; -- OK
1027
1028             else
1029                Error_Msg
1030                  ("`NOT NULL` access type is an Ada 2005 extension", Not_Loc);
1031                Error_Msg
1032                  ("\unit should be compiled with -gnat05 switch", Not_Loc);
1033             end if;
1034
1035          else
1036             Error_Msg_SP ("NULL expected");
1037          end if;
1038
1039          if Token = Tok_New then
1040             Error_Msg ("`NOT NULL` comes after NEW, not before", Not_Loc);
1041          end if;
1042
1043          return True;
1044       end if;
1045    end P_Null_Exclusion;
1046
1047    function P_Subtype_Indication
1048      (Not_Null_Present : Boolean := False) return Node_Id
1049    is
1050       Type_Node : Node_Id;
1051
1052    begin
1053       if Token = Tok_Identifier or else Token = Tok_Operator_Symbol then
1054          Type_Node := P_Subtype_Mark;
1055          return P_Subtype_Indication (Type_Node, Not_Null_Present);
1056
1057       else
1058          --  Check for error of using record definition and treat it nicely,
1059          --  otherwise things are really messed up, so resynchronize.
1060
1061          if Token = Tok_Record then
1062             Error_Msg_SC ("anonymous record definitions are not permitted");
1063             Discard_Junk_Node (P_Record_Definition);
1064             return Error;
1065
1066          else
1067             Error_Msg_AP ("subtype indication expected");
1068             raise Error_Resync;
1069          end if;
1070       end if;
1071    end P_Subtype_Indication;
1072
1073    --  The following function is identical except that it is called with
1074    --  the subtype mark already scanned out, and it scans out the constraint
1075
1076    --  Error recovery: can raise Error_Resync
1077
1078    function P_Subtype_Indication
1079      (Subtype_Mark     : Node_Id;
1080       Not_Null_Present : Boolean := False) return Node_Id
1081    is
1082       Indic_Node  : Node_Id;
1083       Constr_Node : Node_Id;
1084
1085    begin
1086       Constr_Node := P_Constraint_Opt;
1087
1088       if No (Constr_Node) then
1089          return Subtype_Mark;
1090       else
1091          if Not_Null_Present then
1092             Error_Msg_SP ("`NOT NULL` not allowed if constraint given");
1093          end if;
1094
1095          Indic_Node := New_Node (N_Subtype_Indication, Sloc (Subtype_Mark));
1096          Set_Subtype_Mark (Indic_Node, Check_Subtype_Mark (Subtype_Mark));
1097          Set_Constraint (Indic_Node, Constr_Node);
1098          return Indic_Node;
1099       end if;
1100    end P_Subtype_Indication;
1101
1102    -------------------------
1103    -- 3.2.2  Subtype Mark --
1104    -------------------------
1105
1106    --  SUBTYPE_MARK ::= subtype_NAME;
1107
1108    --  Note: The subtype mark which appears after an IN or NOT IN
1109    --  operator is parsed by P_Range_Or_Subtype_Mark (3.5)
1110
1111    --  Error recovery: cannot raise Error_Resync
1112
1113    function P_Subtype_Mark return Node_Id is
1114    begin
1115       return P_Subtype_Mark_Resync;
1116    exception
1117       when Error_Resync =>
1118          return Error;
1119    end P_Subtype_Mark;
1120
1121    --  This routine differs from P_Subtype_Mark in that it insists that an
1122    --  identifier be present, and if it is not, it raises Error_Resync.
1123
1124    --  Error recovery: can raise Error_Resync
1125
1126    function P_Subtype_Mark_Resync return Node_Id is
1127       Type_Node : Node_Id;
1128
1129    begin
1130       if Token = Tok_Access then
1131          Error_Msg_SC ("anonymous access type definition not allowed here");
1132          Scan; -- past ACCESS
1133       end if;
1134
1135       if Token = Tok_Array then
1136          Error_Msg_SC ("anonymous array definition not allowed here");
1137          Discard_Junk_Node (P_Array_Type_Definition);
1138          return Error;
1139
1140       --  If Some becomes a keyword, the following is needed to make it
1141       --  acceptable in older versions of Ada.
1142
1143       elsif Token = Tok_Some
1144         and then Ada_Version < Ada_2012
1145       then
1146          Scan_Reserved_Identifier (False);
1147          Scan;
1148          return Token_Node;
1149
1150       else
1151          Type_Node := P_Qualified_Simple_Name_Resync;
1152
1153          --  Check for a subtype mark attribute. The only valid possibilities
1154          --  are 'CLASS and 'BASE. Anything else is a definite error. We may
1155          --  as well catch it here.
1156
1157          if Token = Tok_Apostrophe then
1158             return P_Subtype_Mark_Attribute (Type_Node);
1159          else
1160             return Type_Node;
1161          end if;
1162       end if;
1163    end P_Subtype_Mark_Resync;
1164
1165    --  The following function is called to scan out a subtype mark attribute.
1166    --  The caller has already scanned out the subtype mark, which is passed in
1167    --  as the argument, and has checked that the current token is apostrophe.
1168
1169    --  Only a special subclass of attributes, called type attributes
1170    --  (see Snames package) are allowed in this syntactic position.
1171
1172    --  Note: if the apostrophe is followed by other than an identifier, then
1173    --  the input expression is returned unchanged, and the scan pointer is
1174    --  left pointing to the apostrophe.
1175
1176    --  Error recovery: can raise Error_Resync
1177
1178    function P_Subtype_Mark_Attribute (Type_Node : Node_Id) return Node_Id is
1179       Attr_Node  : Node_Id := Empty;
1180       Scan_State : Saved_Scan_State;
1181       Prefix     : Node_Id;
1182
1183    begin
1184       Prefix := Check_Subtype_Mark (Type_Node);
1185
1186       if Prefix = Error then
1187          raise Error_Resync;
1188       end if;
1189
1190       --  Loop through attributes appearing (more than one can appear as for
1191       --  for example in X'Base'Class). We are at an apostrophe on entry to
1192       --  this loop, and it runs once for each attribute parsed, with
1193       --  Prefix being the current possible prefix if it is an attribute.
1194
1195       loop
1196          Save_Scan_State (Scan_State); -- at Apostrophe
1197          Scan; -- past apostrophe
1198
1199          if Token /= Tok_Identifier then
1200             Restore_Scan_State (Scan_State); -- to apostrophe
1201             return Prefix; -- no attribute after all
1202
1203          elsif not Is_Type_Attribute_Name (Token_Name) then
1204             Error_Msg_N
1205               ("attribute & may not be used in a subtype mark", Token_Node);
1206             raise Error_Resync;
1207
1208          else
1209             Attr_Node :=
1210               Make_Attribute_Reference (Prev_Token_Ptr,
1211                 Prefix => Prefix,
1212                 Attribute_Name => Token_Name);
1213             Scan; -- past type attribute identifier
1214          end if;
1215
1216          exit when Token /= Tok_Apostrophe;
1217          Prefix := Attr_Node;
1218       end loop;
1219
1220       --  Fall through here after scanning type attribute
1221
1222       return Attr_Node;
1223    end P_Subtype_Mark_Attribute;
1224
1225    -----------------------
1226    -- 3.2.2  Constraint --
1227    -----------------------
1228
1229    --  CONSTRAINT ::= SCALAR_CONSTRAINT | COMPOSITE_CONSTRAINT
1230
1231    --  SCALAR_CONSTRAINT ::=
1232    --    RANGE_CONSTRAINT | DIGITS_CONSTRAINT | DELTA_CONSTRAINT
1233
1234    --  COMPOSITE_CONSTRAINT ::=
1235    --    INDEX_CONSTRAINT | DISCRIMINANT_CONSTRAINT
1236
1237    --  If no constraint is present, this function returns Empty
1238
1239    --  Error recovery: can raise Error_Resync
1240
1241    function P_Constraint_Opt return Node_Id is
1242    begin
1243       if Token = Tok_Range
1244         or else Bad_Spelling_Of (Tok_Range)
1245       then
1246          return P_Range_Constraint;
1247
1248       elsif Token = Tok_Digits
1249         or else Bad_Spelling_Of (Tok_Digits)
1250       then
1251          return P_Digits_Constraint;
1252
1253       elsif Token = Tok_Delta
1254         or else Bad_Spelling_Of (Tok_Delta)
1255       then
1256          return P_Delta_Constraint;
1257
1258       elsif Token = Tok_Left_Paren then
1259          return P_Index_Or_Discriminant_Constraint;
1260
1261       elsif Token = Tok_In then
1262          Ignore (Tok_In);
1263          return P_Constraint_Opt;
1264
1265       else
1266          return Empty;
1267       end if;
1268    end P_Constraint_Opt;
1269
1270    ------------------------------
1271    -- 3.2.2  Scalar Constraint --
1272    ------------------------------
1273
1274    --  Parsed by P_Constraint_Opt (3.2.2)
1275
1276    ---------------------------------
1277    -- 3.2.2  Composite Constraint --
1278    ---------------------------------
1279
1280    --  Parsed by P_Constraint_Opt (3.2.2)
1281
1282    --------------------------------------------------------
1283    -- 3.3  Identifier Declarations (Also 7.4, 8.5, 11.1) --
1284    --------------------------------------------------------
1285
1286    --  This routine scans out a declaration starting with an identifier:
1287
1288    --  OBJECT_DECLARATION ::=
1289    --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
1290    --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION]
1291    --        [ASPECT_SPECIFICATIONS];
1292    --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
1293    --      ACCESS_DEFINITION [:= EXPRESSION]
1294    --        [ASPECT_SPECIFICATIONS];
1295    --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
1296    --      ARRAY_TYPE_DEFINITION [:= EXPRESSION]
1297    --        [ASPECT_SPECIFICATIONS];
1298
1299    --  NUMBER_DECLARATION ::=
1300    --    DEFINING_IDENTIFIER_LIST : constant ::= static_EXPRESSION;
1301
1302    --  OBJECT_RENAMING_DECLARATION ::=
1303    --    DEFINING_IDENTIFIER :
1304    --      [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME;
1305    --  | DEFINING_IDENTIFIER :
1306    --      ACCESS_DEFINITION renames object_NAME;
1307
1308    --  EXCEPTION_RENAMING_DECLARATION ::=
1309    --    DEFINING_IDENTIFIER : exception renames exception_NAME;
1310
1311    --  EXCEPTION_DECLARATION ::=
1312    --    DEFINING_IDENTIFIER_LIST : exception
1313    --      [ASPECT_SPECIFICATIONS];
1314
1315    --  Note that the ALIASED indication in an object declaration is
1316    --  marked by a flag in the parent node.
1317
1318    --  The caller has checked that the initial token is an identifier
1319
1320    --  The value returned is a list of declarations, one for each identifier
1321    --  in the list (as described in Sinfo, we always split up multiple
1322    --  declarations into the equivalent sequence of single declarations
1323    --  using the More_Ids and Prev_Ids flags to preserve the source).
1324
1325    --  If the identifier turns out to be a probable statement rather than
1326    --  an identifier, then the scan is left pointing to the identifier and
1327    --  No_List is returned.
1328
1329    --  Error recovery: can raise Error_Resync
1330
1331    procedure P_Identifier_Declarations
1332      (Decls   : List_Id;
1333       Done    : out Boolean;
1334       In_Spec : Boolean)
1335    is
1336       Acc_Node         : Node_Id;
1337       Decl_Node        : Node_Id;
1338       Type_Node        : Node_Id;
1339       Ident_Sloc       : Source_Ptr;
1340       Scan_State       : Saved_Scan_State;
1341       List_OK          : Boolean := True;
1342       Ident            : Nat;
1343       Init_Expr        : Node_Id;
1344       Init_Loc         : Source_Ptr;
1345       Con_Loc          : Source_Ptr;
1346       Not_Null_Present : Boolean := False;
1347
1348       Idents : array (Int range 1 .. 4096) of Entity_Id;
1349       --  Used to save identifiers in the identifier list. The upper bound
1350       --  of 4096 is expected to be infinite in practice, and we do not even
1351       --  bother to check if this upper bound is exceeded.
1352
1353       Num_Idents : Nat := 1;
1354       --  Number of identifiers stored in Idents
1355
1356       procedure No_List;
1357       --  This procedure is called in renames cases to make sure that we do
1358       --  not have more than one identifier. If we do have more than one
1359       --  then an error message is issued (and the declaration is split into
1360       --  multiple declarations)
1361
1362       function Token_Is_Renames return Boolean;
1363       --  Checks if current token is RENAMES, and if so, scans past it and
1364       --  returns True, otherwise returns False. Includes checking for some
1365       --  common error cases.
1366
1367       -------------
1368       -- No_List --
1369       -------------
1370
1371       procedure No_List is
1372       begin
1373          if Num_Idents > 1 then
1374             Error_Msg
1375               ("identifier list not allowed for RENAMES",
1376                Sloc (Idents (2)));
1377          end if;
1378
1379          List_OK := False;
1380       end No_List;
1381
1382       ----------------------
1383       -- Token_Is_Renames --
1384       ----------------------
1385
1386       function Token_Is_Renames return Boolean is
1387          At_Colon : Saved_Scan_State;
1388
1389       begin
1390          if Token = Tok_Colon then
1391             Save_Scan_State (At_Colon);
1392             Scan; -- past colon
1393             Check_Misspelling_Of (Tok_Renames);
1394
1395             if Token = Tok_Renames then
1396                Error_Msg_SP -- CODEFIX
1397                  ("|extra "":"" ignored");
1398                Scan; -- past RENAMES
1399                return True;
1400             else
1401                Restore_Scan_State (At_Colon);
1402                return False;
1403             end if;
1404
1405          else
1406             Check_Misspelling_Of (Tok_Renames);
1407
1408             if Token = Tok_Renames then
1409                Scan; -- past RENAMES
1410                return True;
1411             else
1412                return False;
1413             end if;
1414          end if;
1415       end Token_Is_Renames;
1416
1417    --  Start of processing for P_Identifier_Declarations
1418
1419    begin
1420       Ident_Sloc := Token_Ptr;
1421       Save_Scan_State (Scan_State); -- at first identifier
1422       Idents (1) := P_Defining_Identifier (C_Comma_Colon);
1423
1424       --  If we have a colon after the identifier, then we can assume that
1425       --  this is in fact a valid identifier declaration and can steam ahead.
1426
1427       if Token = Tok_Colon then
1428          Scan; -- past colon
1429
1430       --  If we have a comma, then scan out the list of identifiers
1431
1432       elsif Token = Tok_Comma then
1433          while Comma_Present loop
1434             Num_Idents := Num_Idents + 1;
1435             Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
1436          end loop;
1437
1438          Save_Scan_State (Scan_State); -- at colon
1439          T_Colon;
1440
1441       --  If we have identifier followed by := then we assume that what is
1442       --  really meant is an assignment statement. The assignment statement
1443       --  is scanned out and added to the list of declarations. An exception
1444       --  occurs if the := is followed by the keyword constant, in which case
1445       --  we assume it was meant to be a colon.
1446
1447       elsif Token = Tok_Colon_Equal then
1448          Scan; -- past :=
1449
1450          if Token = Tok_Constant then
1451             Error_Msg_SP ("colon expected");
1452
1453          else
1454             Restore_Scan_State (Scan_State);
1455             Statement_When_Declaration_Expected (Decls, Done, In_Spec);
1456             return;
1457          end if;
1458
1459       --  If we have an IS keyword, then assume the TYPE keyword was missing
1460
1461       elsif Token = Tok_Is then
1462          Restore_Scan_State (Scan_State);
1463          Append_To (Decls, P_Type_Declaration);
1464          Done := False;
1465          return;
1466
1467       --  Otherwise we have an error situation
1468
1469       else
1470          Restore_Scan_State (Scan_State);
1471
1472          --  First case is possible misuse of PROTECTED in Ada 83 mode. If
1473          --  so, fix the keyword and return to scan the protected declaration.
1474
1475          if Token_Name = Name_Protected then
1476             Check_95_Keyword (Tok_Protected, Tok_Identifier);
1477             Check_95_Keyword (Tok_Protected, Tok_Type);
1478             Check_95_Keyword (Tok_Protected, Tok_Body);
1479
1480             if Token = Tok_Protected then
1481                Done := False;
1482                return;
1483             end if;
1484
1485          --  Check misspelling possibilities. If so, correct the misspelling
1486          --  and return to scan out the resulting declaration.
1487
1488          elsif Bad_Spelling_Of (Tok_Function)
1489            or else Bad_Spelling_Of (Tok_Procedure)
1490            or else Bad_Spelling_Of (Tok_Package)
1491            or else Bad_Spelling_Of (Tok_Pragma)
1492            or else Bad_Spelling_Of (Tok_Protected)
1493            or else Bad_Spelling_Of (Tok_Generic)
1494            or else Bad_Spelling_Of (Tok_Subtype)
1495            or else Bad_Spelling_Of (Tok_Type)
1496            or else Bad_Spelling_Of (Tok_Task)
1497            or else Bad_Spelling_Of (Tok_Use)
1498            or else Bad_Spelling_Of (Tok_For)
1499          then
1500             Done := False;
1501             return;
1502
1503          --  Otherwise we definitely have an ordinary identifier with a junk
1504          --  token after it. Just complain that we expect a declaration, and
1505          --  skip to a semicolon
1506
1507          else
1508             Set_Declaration_Expected;
1509             Resync_Past_Semicolon;
1510             Done := False;
1511             return;
1512          end if;
1513       end if;
1514
1515       --  Come here with an identifier list and colon scanned out. We now
1516       --  build the nodes for the declarative items. One node is built for
1517       --  each identifier in the list, with the type information being
1518       --  repeated by rescanning the appropriate section of source.
1519
1520       --  First an error check, if we have two identifiers in a row, a likely
1521       --  possibility is that the first of the identifiers is an incorrectly
1522       --  spelled keyword.
1523
1524       if Token = Tok_Identifier then
1525          declare
1526             SS : Saved_Scan_State;
1527             I2 : Boolean;
1528
1529          begin
1530             Save_Scan_State (SS);
1531             Scan; -- past initial identifier
1532             I2 := (Token = Tok_Identifier);
1533             Restore_Scan_State (SS);
1534
1535             if I2
1536               and then
1537                 (Bad_Spelling_Of (Tok_Access)   or else
1538                  Bad_Spelling_Of (Tok_Aliased)  or else
1539                  Bad_Spelling_Of (Tok_Constant))
1540             then
1541                null;
1542             end if;
1543          end;
1544       end if;
1545
1546       --  Loop through identifiers
1547
1548       Ident := 1;
1549       Ident_Loop : loop
1550
1551          --  Check for some cases of misused Ada 95 keywords
1552
1553          if Token_Name = Name_Aliased then
1554             Check_95_Keyword (Tok_Aliased, Tok_Array);
1555             Check_95_Keyword (Tok_Aliased, Tok_Identifier);
1556             Check_95_Keyword (Tok_Aliased, Tok_Constant);
1557          end if;
1558
1559          --  Constant cases
1560
1561          if Token = Tok_Constant then
1562             Con_Loc := Token_Ptr;
1563             Scan; -- past CONSTANT
1564
1565             --  Number declaration, initialization required
1566
1567             Init_Expr := Init_Expr_Opt;
1568
1569             if Present (Init_Expr) then
1570                if Not_Null_Present then
1571                   Error_Msg_SP
1572                     ("`NOT NULL` not allowed in numeric expression");
1573                end if;
1574
1575                Decl_Node := New_Node (N_Number_Declaration, Ident_Sloc);
1576                Set_Expression (Decl_Node, Init_Expr);
1577
1578             --  Constant object declaration
1579
1580             else
1581                Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
1582                Set_Constant_Present (Decl_Node, True);
1583
1584                if Token_Name = Name_Aliased then
1585                   Check_95_Keyword (Tok_Aliased, Tok_Array);
1586                   Check_95_Keyword (Tok_Aliased, Tok_Identifier);
1587                end if;
1588
1589                if Token = Tok_Aliased then
1590                   Error_Msg_SC -- CODEFIX
1591                     ("ALIASED should be before CONSTANT");
1592                   Scan; -- past ALIASED
1593                   Set_Aliased_Present (Decl_Node, True);
1594                end if;
1595
1596                if Token = Tok_Array then
1597                   Set_Object_Definition
1598                     (Decl_Node, P_Array_Type_Definition);
1599
1600                else
1601                   Not_Null_Present := P_Null_Exclusion; --  Ada 2005 (AI-231)
1602                   Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
1603
1604                   if Token = Tok_Access then
1605                      if Ada_Version < Ada_2005 then
1606                         Error_Msg_SP
1607                           ("generalized use of anonymous access types " &
1608                            "is an Ada 2005 extension");
1609                         Error_Msg_SP
1610                           ("\unit must be compiled with -gnat05 switch");
1611                      end if;
1612
1613                      Set_Object_Definition
1614                        (Decl_Node, P_Access_Definition (Not_Null_Present));
1615                   else
1616                      Set_Object_Definition
1617                        (Decl_Node, P_Subtype_Indication (Not_Null_Present));
1618                   end if;
1619                end if;
1620
1621                if Token = Tok_Renames then
1622                   Error_Msg
1623                     ("CONSTANT not permitted in renaming declaration",
1624                      Con_Loc);
1625                   Scan; -- Past renames
1626                   Discard_Junk_Node (P_Name);
1627                end if;
1628             end if;
1629
1630          --  Exception cases
1631
1632          elsif Token = Tok_Exception then
1633             Scan; -- past EXCEPTION
1634
1635             if Token_Is_Renames then
1636                No_List;
1637                Decl_Node :=
1638                  New_Node (N_Exception_Renaming_Declaration, Ident_Sloc);
1639                Set_Name (Decl_Node, P_Qualified_Simple_Name_Resync);
1640                No_Constraint;
1641             else
1642                Decl_Node := New_Node (N_Exception_Declaration, Prev_Token_Ptr);
1643             end if;
1644
1645          --  Aliased case (note that an object definition is required)
1646
1647          elsif Token = Tok_Aliased then
1648             Scan; -- past ALIASED
1649             Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
1650             Set_Aliased_Present (Decl_Node, True);
1651
1652             if Token = Tok_Constant then
1653                Scan; -- past CONSTANT
1654                Set_Constant_Present (Decl_Node, True);
1655             end if;
1656
1657             if Token = Tok_Array then
1658                Set_Object_Definition
1659                  (Decl_Node, P_Array_Type_Definition);
1660
1661             else
1662                Not_Null_Present := P_Null_Exclusion; --  Ada 2005 (AI-231)
1663                Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
1664
1665                --  Access definition (AI-406) or subtype indication
1666
1667                if Token = Tok_Access then
1668                   if Ada_Version < Ada_2005 then
1669                      Error_Msg_SP
1670                        ("generalized use of anonymous access types " &
1671                         "is an Ada 2005 extension");
1672                      Error_Msg_SP
1673                        ("\unit must be compiled with -gnat05 switch");
1674                   end if;
1675
1676                   Set_Object_Definition
1677                     (Decl_Node, P_Access_Definition (Not_Null_Present));
1678                else
1679                   Set_Object_Definition
1680                     (Decl_Node, P_Subtype_Indication (Not_Null_Present));
1681                end if;
1682             end if;
1683
1684          --  Array case
1685
1686          elsif Token = Tok_Array then
1687             Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
1688             Set_Object_Definition (Decl_Node, P_Array_Type_Definition);
1689
1690          --  Ada 2005 (AI-254, AI-406)
1691
1692          elsif Token = Tok_Not then
1693
1694             --  OBJECT_DECLARATION ::=
1695             --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
1696             --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION];
1697             --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
1698             --      ACCESS_DEFINITION [:= EXPRESSION];
1699
1700             --  OBJECT_RENAMING_DECLARATION ::=
1701             --    DEFINING_IDENTIFIER :
1702             --      [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME;
1703             --  | DEFINING_IDENTIFIER :
1704             --      ACCESS_DEFINITION renames object_NAME;
1705
1706             Not_Null_Present := P_Null_Exclusion;  --  Ada 2005 (AI-231/423)
1707
1708             if Token = Tok_Access then
1709                if Ada_Version < Ada_2005 then
1710                   Error_Msg_SP
1711                     ("generalized use of anonymous access types " &
1712                      "is an Ada 2005 extension");
1713                   Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1714                end if;
1715
1716                Acc_Node := P_Access_Definition (Not_Null_Present);
1717
1718                if Token /= Tok_Renames then
1719                   Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
1720                   Set_Object_Definition (Decl_Node, Acc_Node);
1721
1722                else
1723                   Scan; --  past renames
1724                   No_List;
1725                   Decl_Node :=
1726                     New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
1727                   Set_Access_Definition (Decl_Node, Acc_Node);
1728                   Set_Name (Decl_Node, P_Name);
1729                end if;
1730
1731             else
1732                Type_Node := P_Subtype_Mark;
1733
1734                --  Object renaming declaration
1735
1736                if Token_Is_Renames then
1737                   if Ada_Version < Ada_2005 then
1738                      Error_Msg_SP
1739                        ("`NOT NULL` not allowed in object renaming");
1740                      raise Error_Resync;
1741
1742                   --  Ada 2005 (AI-423): Object renaming declaration with
1743                   --  a null exclusion.
1744
1745                   else
1746                      No_List;
1747                      Decl_Node :=
1748                        New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
1749                      Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
1750                      Set_Subtype_Mark (Decl_Node, Type_Node);
1751                      Set_Name (Decl_Node, P_Name);
1752                   end if;
1753
1754                --  Object declaration
1755
1756                else
1757                   Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
1758                   Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
1759                   Set_Object_Definition
1760                     (Decl_Node,
1761                      P_Subtype_Indication (Type_Node, Not_Null_Present));
1762
1763                   --  RENAMES at this point means that we had the combination
1764                   --  of a constraint on the Type_Node and renames, which is
1765                   --  illegal
1766
1767                   if Token_Is_Renames then
1768                      Error_Msg_N
1769                        ("constraint not allowed in object renaming "
1770                         & "declaration",
1771                         Constraint (Object_Definition (Decl_Node)));
1772                      raise Error_Resync;
1773                   end if;
1774                end if;
1775             end if;
1776
1777          --  Ada 2005 (AI-230): Access Definition case
1778
1779          elsif Token = Tok_Access then
1780             if Ada_Version < Ada_2005 then
1781                Error_Msg_SP
1782                  ("generalized use of anonymous access types " &
1783                   "is an Ada 2005 extension");
1784                Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1785             end if;
1786
1787             Acc_Node := P_Access_Definition (Null_Exclusion_Present => False);
1788
1789             --  Object declaration with access definition, or renaming
1790
1791             if Token /= Tok_Renames then
1792                Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
1793                Set_Object_Definition (Decl_Node, Acc_Node);
1794
1795             else
1796                Scan; --  past renames
1797                No_List;
1798                Decl_Node :=
1799                  New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
1800                Set_Access_Definition (Decl_Node, Acc_Node);
1801                Set_Name (Decl_Node, P_Name);
1802             end if;
1803
1804          --  Subtype indication case
1805
1806          else
1807             Type_Node := P_Subtype_Mark;
1808
1809             --  Object renaming declaration
1810
1811             if Token_Is_Renames then
1812                No_List;
1813                Decl_Node :=
1814                  New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
1815                Set_Subtype_Mark (Decl_Node, Type_Node);
1816                Set_Name (Decl_Node, P_Name);
1817
1818             --  Object declaration
1819
1820             else
1821                Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
1822                Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
1823                Set_Object_Definition
1824                  (Decl_Node,
1825                   P_Subtype_Indication (Type_Node, Not_Null_Present));
1826
1827                --  RENAMES at this point means that we had the combination of
1828                --  a constraint on the Type_Node and renames, which is illegal
1829
1830                if Token_Is_Renames then
1831                   Error_Msg_N
1832                     ("constraint not allowed in object renaming declaration",
1833                      Constraint (Object_Definition (Decl_Node)));
1834                   raise Error_Resync;
1835                end if;
1836             end if;
1837          end if;
1838
1839          --  Scan out initialization, allowed only for object declaration
1840
1841          Init_Loc := Token_Ptr;
1842          Init_Expr := Init_Expr_Opt;
1843
1844          if Present (Init_Expr) then
1845             if Nkind (Decl_Node) = N_Object_Declaration then
1846                Set_Expression (Decl_Node, Init_Expr);
1847                Set_Has_Init_Expression (Decl_Node);
1848             else
1849                Error_Msg ("initialization not allowed here", Init_Loc);
1850             end if;
1851          end if;
1852
1853          Set_Defining_Identifier (Decl_Node, Idents (Ident));
1854          P_Aspect_Specifications (Decl_Node);
1855
1856          if List_OK then
1857             if Ident < Num_Idents then
1858                Set_More_Ids (Decl_Node, True);
1859             end if;
1860
1861             if Ident > 1 then
1862                Set_Prev_Ids (Decl_Node, True);
1863             end if;
1864          end if;
1865
1866          Append (Decl_Node, Decls);
1867          exit Ident_Loop when Ident = Num_Idents;
1868          Restore_Scan_State (Scan_State);
1869          T_Colon;
1870          Ident := Ident + 1;
1871       end loop Ident_Loop;
1872
1873       Done := False;
1874    end P_Identifier_Declarations;
1875
1876    -------------------------------
1877    -- 3.3.1  Object Declaration --
1878    -------------------------------
1879
1880    --  OBJECT DECLARATION ::=
1881    --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
1882    --      SUBTYPE_INDICATION [:= EXPRESSION];
1883    --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
1884    --      ARRAY_TYPE_DEFINITION [:= EXPRESSION];
1885    --  | SINGLE_TASK_DECLARATION
1886    --  | SINGLE_PROTECTED_DECLARATION
1887
1888    --  Cases starting with TASK are parsed by P_Task (9.1)
1889    --  Cases starting with PROTECTED are parsed by P_Protected (9.4)
1890    --  All other cases are parsed by P_Identifier_Declarations (3.3)
1891
1892    -------------------------------------
1893    -- 3.3.1  Defining Identifier List --
1894    -------------------------------------
1895
1896    --  DEFINING_IDENTIFIER_LIST ::=
1897    --    DEFINING_IDENTIFIER {, DEFINING_IDENTIFIER}
1898
1899    --  Always parsed by the construct in which it appears. See special
1900    --  section on "Handling of Defining Identifier Lists" in this unit.
1901
1902    -------------------------------
1903    -- 3.3.2  Number Declaration --
1904    -------------------------------
1905
1906    --  Parsed by P_Identifier_Declarations (3.3)
1907
1908    -------------------------------------------------------------------------
1909    -- 3.4  Derived Type Definition or Private Extension Declaration (7.3) --
1910    -------------------------------------------------------------------------
1911
1912    --  DERIVED_TYPE_DEFINITION ::=
1913    --    [abstract] [limited] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION
1914    --    [[and INTERFACE_LIST] RECORD_EXTENSION_PART]
1915
1916    --  PRIVATE_EXTENSION_DECLARATION ::=
1917    --     type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
1918    --       [abstract] [limited | synchronized]
1919    --          new ancestor_SUBTYPE_INDICATION [and INTERFACE_LIST]
1920    --            with private;
1921
1922    --  RECORD_EXTENSION_PART ::= with RECORD_DEFINITION
1923
1924    --  The caller has already scanned out the part up to the NEW, and Token
1925    --  either contains Tok_New (or ought to, if it doesn't this procedure
1926    --  will post an appropriate "NEW expected" message).
1927
1928    --  Note: the caller is responsible for filling in the Sloc field of
1929    --  the returned node in the private extension declaration case as
1930    --  well as the stuff relating to the discriminant part.
1931
1932    --  Error recovery: can raise Error_Resync;
1933
1934    function P_Derived_Type_Def_Or_Private_Ext_Decl return Node_Id is
1935       Typedef_Node     : Node_Id;
1936       Typedecl_Node    : Node_Id;
1937       Not_Null_Present : Boolean := False;
1938
1939    begin
1940       Typedef_Node := New_Node (N_Derived_Type_Definition, Token_Ptr);
1941
1942       if Ada_Version < Ada_2005
1943         and then Token = Tok_Identifier
1944         and then Token_Name = Name_Interface
1945       then
1946          Error_Msg_SP
1947            ("abstract interface is an Ada 2005 extension");
1948          Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1949       else
1950          T_New;
1951       end if;
1952
1953       if Token = Tok_Abstract then
1954          Error_Msg_SC -- CODEFIX
1955            ("ABSTRACT must come before NEW, not after");
1956          Scan;
1957       end if;
1958
1959       Not_Null_Present := P_Null_Exclusion; --  Ada 2005 (AI-231)
1960       Set_Null_Exclusion_Present (Typedef_Node, Not_Null_Present);
1961       Set_Subtype_Indication (Typedef_Node,
1962          P_Subtype_Indication (Not_Null_Present));
1963
1964       --  Ada 2005 (AI-251): Deal with interfaces
1965
1966       if Token = Tok_And then
1967          Scan; -- past AND
1968
1969          if Ada_Version < Ada_2005 then
1970             Error_Msg_SP
1971               ("abstract interface is an Ada 2005 extension");
1972             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1973          end if;
1974
1975          Set_Interface_List (Typedef_Node, New_List);
1976
1977          loop
1978             Append (P_Qualified_Simple_Name, Interface_List (Typedef_Node));
1979             exit when Token /= Tok_And;
1980             Scan; -- past AND
1981          end loop;
1982
1983          if Token /= Tok_With then
1984             Error_Msg_SC ("WITH expected");
1985             raise Error_Resync;
1986          end if;
1987       end if;
1988
1989       --  Deal with record extension, note that we assume that a WITH is
1990       --  missing in the case of "type X is new Y record ..." or in the
1991       --  case of "type X is new Y null record".
1992
1993       --  First make sure we don't have an aspect specification. If we do
1994       --  return now, so that our caller can check it (the WITH here is not
1995       --  part of a type extension).
1996
1997       if Aspect_Specifications_Present then
1998          return Typedef_Node;
1999
2000       --  OK, not an aspect specification, so continue test for extension
2001
2002       elsif Token = Tok_With
2003         or else Token = Tok_Record
2004         or else Token = Tok_Null
2005       then
2006          T_With; -- past WITH or give error message
2007
2008          if Token = Tok_Limited then
2009             Error_Msg_SC ("LIMITED keyword not allowed in private extension");
2010             Scan; -- ignore LIMITED
2011          end if;
2012
2013          --  Private extension declaration
2014
2015          if Token = Tok_Private then
2016             Scan; -- past PRIVATE
2017
2018             --  Throw away the type definition node and build the type
2019             --  declaration node. Note the caller must set the Sloc,
2020             --  Discriminant_Specifications, Unknown_Discriminants_Present,
2021             --  and Defined_Identifier fields in the returned node.
2022
2023             Typedecl_Node :=
2024               Make_Private_Extension_Declaration (No_Location,
2025                 Defining_Identifier => Empty,
2026                 Subtype_Indication  => Subtype_Indication (Typedef_Node),
2027                 Abstract_Present    => Abstract_Present (Typedef_Node),
2028                 Interface_List      => Interface_List (Typedef_Node));
2029
2030             return Typedecl_Node;
2031
2032          --  Derived type definition with record extension part
2033
2034          else
2035             Set_Record_Extension_Part (Typedef_Node, P_Record_Definition);
2036             return Typedef_Node;
2037          end if;
2038
2039       --  Derived type definition with no record extension part
2040
2041       else
2042          return Typedef_Node;
2043       end if;
2044    end P_Derived_Type_Def_Or_Private_Ext_Decl;
2045
2046    ---------------------------
2047    -- 3.5  Range Constraint --
2048    ---------------------------
2049
2050    --  RANGE_CONSTRAINT ::= range RANGE
2051
2052    --  The caller has checked that the initial token is RANGE
2053
2054    --  Error recovery: cannot raise Error_Resync
2055
2056    function P_Range_Constraint return Node_Id is
2057       Range_Node : Node_Id;
2058
2059    begin
2060       Range_Node := New_Node (N_Range_Constraint, Token_Ptr);
2061       Scan; -- past RANGE
2062       Set_Range_Expression (Range_Node, P_Range);
2063       return Range_Node;
2064    end P_Range_Constraint;
2065
2066    ----------------
2067    -- 3.5  Range --
2068    ----------------
2069
2070    --  RANGE ::=
2071    --    RANGE_ATTRIBUTE_REFERENCE | SIMPLE_EXPRESSION .. SIMPLE_EXPRESSION
2072
2073    --  Note: the range that appears in a membership test is parsed by
2074    --  P_Range_Or_Subtype_Mark (3.5).
2075
2076    --  Error recovery: cannot raise Error_Resync
2077
2078    function P_Range return Node_Id is
2079       Expr_Node  : Node_Id;
2080       Range_Node : Node_Id;
2081
2082    begin
2083       Expr_Node := P_Simple_Expression_Or_Range_Attribute;
2084
2085       if Expr_Form = EF_Range_Attr then
2086          return Expr_Node;
2087
2088       elsif Token = Tok_Dot_Dot then
2089          Range_Node := New_Node (N_Range, Token_Ptr);
2090          Set_Low_Bound (Range_Node, Expr_Node);
2091          Scan; -- past ..
2092          Expr_Node := P_Expression;
2093          Check_Simple_Expression (Expr_Node);
2094          Set_High_Bound (Range_Node, Expr_Node);
2095          return Range_Node;
2096
2097       --  Anything else is an error
2098
2099       else
2100          T_Dot_Dot; -- force missing .. message
2101          return Error;
2102       end if;
2103    end P_Range;
2104
2105    ----------------------------------
2106    -- 3.5  P_Range_Or_Subtype_Mark --
2107    ----------------------------------
2108
2109    --  RANGE ::=
2110    --    RANGE_ATTRIBUTE_REFERENCE
2111    --  | SIMPLE_EXPRESSION .. SIMPLE_EXPRESSION
2112
2113    --  This routine scans out the range or subtype mark that forms the right
2114    --  operand of a membership test (it is not used in any other contexts, and
2115    --  error messages are specialized with this knowledge in mind).
2116
2117    --  Note: as documented in the Sinfo interface, although the syntax only
2118    --  allows a subtype mark, we in fact allow any simple expression to be
2119    --  returned from this routine. The semantics is responsible for issuing
2120    --  an appropriate message complaining if the argument is not a name.
2121    --  This simplifies the coding and error recovery processing in the
2122    --  parser, and in any case it is preferable not to consider this a
2123    --  syntax error and to continue with the semantic analysis.
2124
2125    --  Error recovery: cannot raise Error_Resync
2126
2127    function P_Range_Or_Subtype_Mark
2128      (Allow_Simple_Expression : Boolean := False) return Node_Id
2129    is
2130       Expr_Node  : Node_Id;
2131       Range_Node : Node_Id;
2132       Save_Loc   : Source_Ptr;
2133
2134    --  Start of processing for P_Range_Or_Subtype_Mark
2135
2136    begin
2137       --  Save location of possible junk parentheses
2138
2139       Save_Loc := Token_Ptr;
2140
2141       --  Scan out either a simple expression or a range (this accepts more
2142       --  than is legal here, but as explained above, we like to allow more
2143       --  with a proper diagnostic, and in the case of a membership operation
2144       --  where sets are allowed, a simple expression is permissible anyway.
2145
2146       Expr_Node := P_Simple_Expression_Or_Range_Attribute;
2147
2148       --  Range attribute
2149
2150       if Expr_Form = EF_Range_Attr then
2151          return Expr_Node;
2152
2153       --  Simple_Expression .. Simple_Expression
2154
2155       elsif Token = Tok_Dot_Dot then
2156          Check_Simple_Expression (Expr_Node);
2157          Range_Node := New_Node (N_Range, Token_Ptr);
2158          Set_Low_Bound (Range_Node, Expr_Node);
2159          Scan; -- past ..
2160          Set_High_Bound (Range_Node, P_Simple_Expression);
2161          return Range_Node;
2162
2163       --  Case of subtype mark (optionally qualified simple name or an
2164       --  attribute whose prefix is an optionally qualified simple name)
2165
2166       elsif Expr_Form = EF_Simple_Name
2167         or else Nkind (Expr_Node) = N_Attribute_Reference
2168       then
2169          --  Check for error of range constraint after a subtype mark
2170
2171          if Token = Tok_Range then
2172             Error_Msg_SC ("range constraint not allowed in membership test");
2173             Scan; -- past RANGE
2174             raise Error_Resync;
2175
2176          --  Check for error of DIGITS or DELTA after a subtype mark
2177
2178          elsif Token = Tok_Digits or else Token = Tok_Delta then
2179             Error_Msg_SC
2180               ("accuracy definition not allowed in membership test");
2181             Scan; -- past DIGITS or DELTA
2182             raise Error_Resync;
2183
2184          --  Attribute reference, may or may not be OK, but in any case we
2185          --  will scan it out
2186
2187          elsif Token = Tok_Apostrophe then
2188             return P_Subtype_Mark_Attribute (Expr_Node);
2189
2190          --  OK case of simple name, just return it
2191
2192          else
2193             return Expr_Node;
2194          end if;
2195
2196       --  Simple expression case
2197
2198       elsif Expr_Form = EF_Simple and then Allow_Simple_Expression then
2199          return Expr_Node;
2200
2201       --  Here we have some kind of error situation. Check for junk parens
2202       --  then return what we have, caller will deal with other errors.
2203
2204       else
2205          if Nkind (Expr_Node) in N_Subexpr
2206            and then Paren_Count (Expr_Node) /= 0
2207          then
2208             Error_Msg ("|parentheses not allowed for subtype mark", Save_Loc);
2209             Set_Paren_Count (Expr_Node, 0);
2210          end if;
2211
2212          return Expr_Node;
2213       end if;
2214    end P_Range_Or_Subtype_Mark;
2215
2216    ----------------------------------------
2217    -- 3.5.1  Enumeration Type Definition --
2218    ----------------------------------------
2219
2220    --  ENUMERATION_TYPE_DEFINITION ::=
2221    --    (ENUMERATION_LITERAL_SPECIFICATION
2222    --      {, ENUMERATION_LITERAL_SPECIFICATION})
2223
2224    --  The caller has already scanned out the TYPE keyword
2225
2226    --  Error recovery: can raise Error_Resync;
2227
2228    function P_Enumeration_Type_Definition return Node_Id is
2229       Typedef_Node : Node_Id;
2230
2231    begin
2232       Typedef_Node := New_Node (N_Enumeration_Type_Definition, Token_Ptr);
2233       Set_Literals (Typedef_Node, New_List);
2234
2235       T_Left_Paren;
2236
2237       loop
2238          Append (P_Enumeration_Literal_Specification, Literals (Typedef_Node));
2239          exit when not Comma_Present;
2240       end loop;
2241
2242       T_Right_Paren;
2243       return Typedef_Node;
2244    end P_Enumeration_Type_Definition;
2245
2246    ----------------------------------------------
2247    -- 3.5.1  Enumeration Literal Specification --
2248    ----------------------------------------------
2249
2250    --  ENUMERATION_LITERAL_SPECIFICATION ::=
2251    --    DEFINING_IDENTIFIER | DEFINING_CHARACTER_LITERAL
2252
2253    --  Error recovery: can raise Error_Resync
2254
2255    function P_Enumeration_Literal_Specification return Node_Id is
2256    begin
2257       if Token = Tok_Char_Literal then
2258          return P_Defining_Character_Literal;
2259       else
2260          return P_Defining_Identifier (C_Comma_Right_Paren);
2261       end if;
2262    end P_Enumeration_Literal_Specification;
2263
2264    ---------------------------------------
2265    -- 3.5.1  Defining_Character_Literal --
2266    ---------------------------------------
2267
2268    --  DEFINING_CHARACTER_LITERAL ::= CHARACTER_LITERAL
2269
2270    --  Error recovery: cannot raise Error_Resync
2271
2272    --  The caller has checked that the current token is a character literal
2273
2274    function P_Defining_Character_Literal return Node_Id is
2275       Literal_Node : Node_Id;
2276    begin
2277       Literal_Node := Token_Node;
2278       Change_Character_Literal_To_Defining_Character_Literal (Literal_Node);
2279       Scan; -- past character literal
2280       return Literal_Node;
2281    end P_Defining_Character_Literal;
2282
2283    ------------------------------------
2284    -- 3.5.4  Integer Type Definition --
2285    ------------------------------------
2286
2287    --  Parsed by P_Type_Declaration (3.2.1)
2288
2289    -------------------------------------------
2290    -- 3.5.4  Signed Integer Type Definition --
2291    -------------------------------------------
2292
2293    --  SIGNED_INTEGER_TYPE_DEFINITION ::=
2294    --    range static_SIMPLE_EXPRESSION .. static_SIMPLE_EXPRESSION
2295
2296    --  Normally the initial token on entry is RANGE, but in some
2297    --  error conditions, the range token was missing and control is
2298    --  passed with Token pointing to first token of the first expression.
2299
2300    --  Error recovery: cannot raise Error_Resync
2301
2302    function P_Signed_Integer_Type_Definition return Node_Id is
2303       Typedef_Node : Node_Id;
2304       Expr_Node    : Node_Id;
2305
2306    begin
2307       Typedef_Node := New_Node (N_Signed_Integer_Type_Definition, Token_Ptr);
2308
2309       if Token = Tok_Range then
2310          Scan; -- past RANGE
2311       end if;
2312
2313       Expr_Node := P_Expression;
2314       Check_Simple_Expression (Expr_Node);
2315       Set_Low_Bound (Typedef_Node, Expr_Node);
2316       T_Dot_Dot;
2317       Expr_Node := P_Expression;
2318       Check_Simple_Expression (Expr_Node);
2319       Set_High_Bound (Typedef_Node, Expr_Node);
2320       return Typedef_Node;
2321    end P_Signed_Integer_Type_Definition;
2322
2323    ------------------------------------
2324    -- 3.5.4  Modular Type Definition --
2325    ------------------------------------
2326
2327    --  MODULAR_TYPE_DEFINITION ::= mod static_EXPRESSION
2328
2329    --  The caller has checked that the initial token is MOD
2330
2331    --  Error recovery: cannot raise Error_Resync
2332
2333    function P_Modular_Type_Definition return Node_Id is
2334       Typedef_Node : Node_Id;
2335
2336    begin
2337       if Ada_Version = Ada_83 then
2338          Error_Msg_SC ("(Ada 83): modular types not allowed");
2339       end if;
2340
2341       Typedef_Node := New_Node (N_Modular_Type_Definition, Token_Ptr);
2342       Scan; -- past MOD
2343       Set_Expression (Typedef_Node, P_Expression_No_Right_Paren);
2344
2345       --  Handle mod L..R cleanly
2346
2347       if Token = Tok_Dot_Dot then
2348          Error_Msg_SC ("range not allowed for modular type");
2349          Scan; -- past ..
2350          Set_Expression (Typedef_Node, P_Expression_No_Right_Paren);
2351       end if;
2352
2353       return Typedef_Node;
2354    end P_Modular_Type_Definition;
2355
2356    ---------------------------------
2357    -- 3.5.6  Real Type Definition --
2358    ---------------------------------
2359
2360    --  Parsed by P_Type_Declaration (3.2.1)
2361
2362    --------------------------------------
2363    -- 3.5.7  Floating Point Definition --
2364    --------------------------------------
2365
2366    --  FLOATING_POINT_DEFINITION ::=
2367    --    digits static_EXPRESSION [REAL_RANGE_SPECIFICATION]
2368
2369    --  Note: In Ada-83, the EXPRESSION must be a SIMPLE_EXPRESSION
2370
2371    --  The caller has checked that the initial token is DIGITS
2372
2373    --  Error recovery: cannot raise Error_Resync
2374
2375    function P_Floating_Point_Definition return Node_Id is
2376       Digits_Loc : constant Source_Ptr := Token_Ptr;
2377       Def_Node   : Node_Id;
2378       Expr_Node  : Node_Id;
2379
2380    begin
2381       Scan; -- past DIGITS
2382       Expr_Node := P_Expression_No_Right_Paren;
2383       Check_Simple_Expression_In_Ada_83 (Expr_Node);
2384
2385       --  Handle decimal fixed-point defn with DIGITS/DELTA in wrong order
2386
2387       if Token = Tok_Delta then
2388          Error_Msg_SC -- CODEFIX
2389            ("|DELTA must come before DIGITS");
2390          Def_Node := New_Node (N_Decimal_Fixed_Point_Definition, Digits_Loc);
2391          Scan; -- past DELTA
2392          Set_Delta_Expression (Def_Node, P_Expression_No_Right_Paren);
2393
2394       --  OK floating-point definition
2395
2396       else
2397          Def_Node := New_Node (N_Floating_Point_Definition, Digits_Loc);
2398       end if;
2399
2400       Set_Digits_Expression (Def_Node, Expr_Node);
2401       Set_Real_Range_Specification (Def_Node, P_Real_Range_Specification_Opt);
2402       return Def_Node;
2403    end P_Floating_Point_Definition;
2404
2405    -------------------------------------
2406    -- 3.5.7  Real Range Specification --
2407    -------------------------------------
2408
2409    --  REAL_RANGE_SPECIFICATION ::=
2410    --    range static_SIMPLE_EXPRESSION .. static_SIMPLE_EXPRESSION
2411
2412    --  Error recovery: cannot raise Error_Resync
2413
2414    function P_Real_Range_Specification_Opt return Node_Id is
2415       Specification_Node : Node_Id;
2416       Expr_Node          : Node_Id;
2417
2418    begin
2419       if Token = Tok_Range then
2420          Specification_Node :=
2421            New_Node (N_Real_Range_Specification, Token_Ptr);
2422          Scan; -- past RANGE
2423          Expr_Node := P_Expression_No_Right_Paren;
2424          Check_Simple_Expression (Expr_Node);
2425          Set_Low_Bound (Specification_Node, Expr_Node);
2426          T_Dot_Dot;
2427          Expr_Node := P_Expression_No_Right_Paren;
2428          Check_Simple_Expression (Expr_Node);
2429          Set_High_Bound (Specification_Node, Expr_Node);
2430          return Specification_Node;
2431       else
2432          return Empty;
2433       end if;
2434    end P_Real_Range_Specification_Opt;
2435
2436    -----------------------------------
2437    -- 3.5.9  Fixed Point Definition --
2438    -----------------------------------
2439
2440    --  FIXED_POINT_DEFINITION ::=
2441    --    ORDINARY_FIXED_POINT_DEFINITION | DECIMAL_FIXED_POINT_DEFINITION
2442
2443    --  ORDINARY_FIXED_POINT_DEFINITION ::=
2444    --    delta static_EXPRESSION REAL_RANGE_SPECIFICATION
2445
2446    --  DECIMAL_FIXED_POINT_DEFINITION ::=
2447    --    delta static_EXPRESSION
2448    --      digits static_EXPRESSION [REAL_RANGE_SPECIFICATION]
2449
2450    --  The caller has checked that the initial token is DELTA
2451
2452    --  Error recovery: cannot raise Error_Resync
2453
2454    function P_Fixed_Point_Definition return Node_Id is
2455       Delta_Node : Node_Id;
2456       Delta_Loc  : Source_Ptr;
2457       Def_Node   : Node_Id;
2458       Expr_Node  : Node_Id;
2459
2460    begin
2461       Delta_Loc := Token_Ptr;
2462       Scan; -- past DELTA
2463       Delta_Node := P_Expression_No_Right_Paren;
2464       Check_Simple_Expression_In_Ada_83 (Delta_Node);
2465
2466       if Token = Tok_Digits then
2467          if Ada_Version = Ada_83 then
2468             Error_Msg_SC ("(Ada 83) decimal fixed type not allowed!");
2469          end if;
2470
2471          Def_Node := New_Node (N_Decimal_Fixed_Point_Definition, Delta_Loc);
2472          Scan; -- past DIGITS
2473          Expr_Node := P_Expression_No_Right_Paren;
2474          Check_Simple_Expression_In_Ada_83 (Expr_Node);
2475          Set_Digits_Expression (Def_Node, Expr_Node);
2476
2477       else
2478          Def_Node := New_Node (N_Ordinary_Fixed_Point_Definition, Delta_Loc);
2479
2480          --  Range is required in ordinary fixed point case
2481
2482          if Token /= Tok_Range then
2483             Error_Msg_AP ("range must be given for fixed-point type");
2484             T_Range;
2485          end if;
2486       end if;
2487
2488       Set_Delta_Expression (Def_Node, Delta_Node);
2489       Set_Real_Range_Specification (Def_Node, P_Real_Range_Specification_Opt);
2490       return Def_Node;
2491    end P_Fixed_Point_Definition;
2492
2493    --------------------------------------------
2494    -- 3.5.9  Ordinary Fixed Point Definition --
2495    --------------------------------------------
2496
2497    --  Parsed by P_Fixed_Point_Definition (3.5.9)
2498
2499    -------------------------------------------
2500    -- 3.5.9  Decimal Fixed Point Definition --
2501    -------------------------------------------
2502
2503    --  Parsed by P_Decimal_Point_Definition (3.5.9)
2504
2505    ------------------------------
2506    -- 3.5.9  Digits Constraint --
2507    ------------------------------
2508
2509    --  DIGITS_CONSTRAINT ::=
2510    --    digits static_EXPRESSION [RANGE_CONSTRAINT]
2511
2512    --  Note: in Ada 83, the EXPRESSION must be a SIMPLE_EXPRESSION
2513
2514    --  The caller has checked that the initial token is DIGITS
2515
2516    function P_Digits_Constraint return Node_Id is
2517       Constraint_Node : Node_Id;
2518       Expr_Node : Node_Id;
2519
2520    begin
2521       Constraint_Node := New_Node (N_Digits_Constraint, Token_Ptr);
2522       Scan; -- past DIGITS
2523       Expr_Node := P_Expression;
2524       Check_Simple_Expression_In_Ada_83 (Expr_Node);
2525       Set_Digits_Expression (Constraint_Node, Expr_Node);
2526
2527       if Token = Tok_Range then
2528          Set_Range_Constraint (Constraint_Node, P_Range_Constraint);
2529       end if;
2530
2531       return Constraint_Node;
2532    end P_Digits_Constraint;
2533
2534    -----------------------------
2535    -- 3.5.9  Delta Constraint --
2536    -----------------------------
2537
2538    --  DELTA CONSTRAINT ::= DELTA STATIC_EXPRESSION [RANGE_CONSTRAINT]
2539
2540    --  Note: this is an obsolescent feature in Ada 95 (I.3)
2541
2542    --  Note: in Ada 83, the EXPRESSION must be a SIMPLE_EXPRESSION
2543
2544    --  The caller has checked that the initial token is DELTA
2545
2546    --  Error recovery: cannot raise Error_Resync
2547
2548    function P_Delta_Constraint return Node_Id is
2549       Constraint_Node : Node_Id;
2550       Expr_Node : Node_Id;
2551
2552    begin
2553       Constraint_Node := New_Node (N_Delta_Constraint, Token_Ptr);
2554       Scan; -- past DELTA
2555       Expr_Node := P_Expression;
2556       Check_Simple_Expression_In_Ada_83 (Expr_Node);
2557       Set_Delta_Expression (Constraint_Node, Expr_Node);
2558
2559       if Token = Tok_Range then
2560          Set_Range_Constraint (Constraint_Node, P_Range_Constraint);
2561       end if;
2562
2563       return Constraint_Node;
2564    end P_Delta_Constraint;
2565
2566    --------------------------------
2567    -- 3.6  Array Type Definition --
2568    --------------------------------
2569
2570    --  ARRAY_TYPE_DEFINITION ::=
2571    --    UNCONSTRAINED_ARRAY_DEFINITION | CONSTRAINED_ARRAY_DEFINITION
2572
2573    --  UNCONSTRAINED_ARRAY_DEFINITION ::=
2574    --    array (INDEX_SUBTYPE_DEFINITION {, INDEX_SUBTYPE_DEFINITION}) of
2575    --      COMPONENT_DEFINITION
2576
2577    --  INDEX_SUBTYPE_DEFINITION ::= SUBTYPE_MARK range <>
2578
2579    --  CONSTRAINED_ARRAY_DEFINITION ::=
2580    --    array (DISCRETE_SUBTYPE_DEFINITION {, DISCRETE_SUBTYPE_DEFINITION}) of
2581    --      COMPONENT_DEFINITION
2582
2583    --  DISCRETE_SUBTYPE_DEFINITION ::=
2584    --    DISCRETE_SUBTYPE_INDICATION | RANGE
2585
2586    --  COMPONENT_DEFINITION ::=
2587    --    [aliased] [NULL_EXCLUSION] SUBTYPE_INDICATION | ACCESS_DEFINITION
2588
2589    --  The caller has checked that the initial token is ARRAY
2590
2591    --  Error recovery: can raise Error_Resync
2592
2593    function P_Array_Type_Definition return Node_Id is
2594       Array_Loc        : Source_Ptr;
2595       CompDef_Node     : Node_Id;
2596       Def_Node         : Node_Id;
2597       Not_Null_Present : Boolean := False;
2598       Subs_List        : List_Id;
2599       Scan_State       : Saved_Scan_State;
2600       Aliased_Present  : Boolean := False;
2601
2602    begin
2603       Array_Loc := Token_Ptr;
2604       Scan; -- past ARRAY
2605       Subs_List := New_List;
2606       T_Left_Paren;
2607
2608       --  It's quite tricky to disentangle these two possibilities, so we do
2609       --  a prescan to determine which case we have and then reset the scan.
2610       --  The prescan skips past possible subtype mark tokens.
2611
2612       Save_Scan_State (Scan_State); -- just after paren
2613
2614       while Token in Token_Class_Desig or else
2615             Token = Tok_Dot or else
2616             Token = Tok_Apostrophe -- because of 'BASE, 'CLASS
2617       loop
2618          Scan;
2619       end loop;
2620
2621       --  If we end up on RANGE <> then we have the unconstrained case. We
2622       --  will also allow the RANGE to be omitted, just to improve error
2623       --  handling for a case like array (integer <>) of integer;
2624
2625       Scan; -- past possible RANGE or <>
2626
2627       if (Prev_Token = Tok_Range and then Token = Tok_Box) or else
2628          Prev_Token = Tok_Box
2629       then
2630          Def_Node := New_Node (N_Unconstrained_Array_Definition, Array_Loc);
2631          Restore_Scan_State (Scan_State); -- to first subtype mark
2632
2633          loop
2634             Append (P_Subtype_Mark_Resync, Subs_List);
2635             T_Range;
2636             T_Box;
2637             exit when Token = Tok_Right_Paren or else Token = Tok_Of;
2638             T_Comma;
2639          end loop;
2640
2641          Set_Subtype_Marks (Def_Node, Subs_List);
2642
2643       else
2644          Def_Node := New_Node (N_Constrained_Array_Definition, Array_Loc);
2645          Restore_Scan_State (Scan_State); -- to first discrete range
2646
2647          loop
2648             Append (P_Discrete_Subtype_Definition, Subs_List);
2649             exit when not Comma_Present;
2650          end loop;
2651
2652          Set_Discrete_Subtype_Definitions (Def_Node, Subs_List);
2653       end if;
2654
2655       T_Right_Paren;
2656       T_Of;
2657
2658       CompDef_Node := New_Node (N_Component_Definition, Token_Ptr);
2659
2660       if Token_Name = Name_Aliased then
2661          Check_95_Keyword (Tok_Aliased, Tok_Identifier);
2662       end if;
2663
2664       if Token = Tok_Aliased then
2665          Aliased_Present := True;
2666          Scan; -- past ALIASED
2667       end if;
2668
2669       Not_Null_Present := P_Null_Exclusion; --  Ada 2005 (AI-231/AI-254)
2670
2671       --  Ada 2005 (AI-230): Access Definition case
2672
2673       if Token = Tok_Access then
2674          if Ada_Version < Ada_2005 then
2675             Error_Msg_SP
2676               ("generalized use of anonymous access types " &
2677                "is an Ada 2005 extension");
2678             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
2679          end if;
2680
2681          if Aliased_Present then
2682             Error_Msg_SP ("ALIASED not allowed here");
2683          end if;
2684
2685          Set_Subtype_Indication     (CompDef_Node, Empty);
2686          Set_Aliased_Present        (CompDef_Node, False);
2687          Set_Access_Definition      (CompDef_Node,
2688            P_Access_Definition (Not_Null_Present));
2689       else
2690
2691          Set_Access_Definition      (CompDef_Node, Empty);
2692          Set_Aliased_Present        (CompDef_Node, Aliased_Present);
2693          Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
2694          Set_Subtype_Indication     (CompDef_Node,
2695            P_Subtype_Indication (Not_Null_Present));
2696       end if;
2697
2698       Set_Component_Definition (Def_Node, CompDef_Node);
2699
2700       return Def_Node;
2701    end P_Array_Type_Definition;
2702
2703    -----------------------------------------
2704    -- 3.6  Unconstrained Array Definition --
2705    -----------------------------------------
2706
2707    --  Parsed by P_Array_Type_Definition (3.6)
2708
2709    ---------------------------------------
2710    -- 3.6  Constrained Array Definition --
2711    ---------------------------------------
2712
2713    --  Parsed by P_Array_Type_Definition (3.6)
2714
2715    --------------------------------------
2716    -- 3.6  Discrete Subtype Definition --
2717    --------------------------------------
2718
2719    --  DISCRETE_SUBTYPE_DEFINITION ::=
2720    --    discrete_SUBTYPE_INDICATION | RANGE
2721
2722    --  Note: the discrete subtype definition appearing in a constrained
2723    --  array definition is parsed by P_Array_Type_Definition (3.6)
2724
2725    --  Error recovery: cannot raise Error_Resync
2726
2727    function P_Discrete_Subtype_Definition return Node_Id is
2728    begin
2729       --  The syntax of a discrete subtype definition is identical to that
2730       --  of a discrete range, so we simply share the same parsing code.
2731
2732       return P_Discrete_Range;
2733    end P_Discrete_Subtype_Definition;
2734
2735    -------------------------------
2736    -- 3.6  Component Definition --
2737    -------------------------------
2738
2739    --  For the array case, parsed by P_Array_Type_Definition (3.6)
2740    --  For the record case, parsed by P_Component_Declaration (3.8)
2741
2742    -----------------------------
2743    -- 3.6.1  Index Constraint --
2744    -----------------------------
2745
2746    --  Parsed by P_Index_Or_Discriminant_Constraint (3.7.1)
2747
2748    ---------------------------
2749    -- 3.6.1  Discrete Range --
2750    ---------------------------
2751
2752    --  DISCRETE_RANGE ::= discrete_SUBTYPE_INDICATION | RANGE
2753
2754    --  The possible forms for a discrete range are:
2755
2756       --   Subtype_Mark                           (SUBTYPE_INDICATION, 3.2.2)
2757       --   Subtype_Mark range Range               (SUBTYPE_INDICATION, 3.2.2)
2758       --   Range_Attribute                        (RANGE, 3.5)
2759       --   Simple_Expression .. Simple_Expression (RANGE, 3.5)
2760
2761    --  Error recovery: cannot raise Error_Resync
2762
2763    function P_Discrete_Range return Node_Id is
2764       Expr_Node  : Node_Id;
2765       Range_Node : Node_Id;
2766
2767    begin
2768       Expr_Node := P_Simple_Expression_Or_Range_Attribute;
2769
2770       if Expr_Form = EF_Range_Attr then
2771          return Expr_Node;
2772
2773       elsif Token = Tok_Range then
2774          if Expr_Form /= EF_Simple_Name then
2775             Error_Msg_SC ("range must be preceded by subtype mark");
2776          end if;
2777
2778          return P_Subtype_Indication (Expr_Node);
2779
2780       --  Check Expression .. Expression case
2781
2782       elsif Token = Tok_Dot_Dot then
2783          Range_Node := New_Node (N_Range, Token_Ptr);
2784          Set_Low_Bound (Range_Node, Expr_Node);
2785          Scan; -- past ..
2786          Expr_Node := P_Expression;
2787          Check_Simple_Expression (Expr_Node);
2788          Set_High_Bound (Range_Node, Expr_Node);
2789          return Range_Node;
2790
2791       --  Otherwise we must have a subtype mark
2792
2793       elsif Expr_Form = EF_Simple_Name then
2794          return Expr_Node;
2795
2796       --  If incorrect, complain that we expect ..
2797
2798       else
2799          T_Dot_Dot;
2800          return Expr_Node;
2801       end if;
2802    end P_Discrete_Range;
2803
2804    ----------------------------
2805    -- 3.7  Discriminant Part --
2806    ----------------------------
2807
2808    --  DISCRIMINANT_PART ::=
2809    --    UNKNOWN_DISCRIMINANT_PART
2810    --  | KNOWN_DISCRIMINANT_PART
2811
2812    --  A discriminant part is parsed by P_Known_Discriminant_Part_Opt (3.7)
2813    --  or P_Unknown_Discriminant_Part (3.7), since we know which we want.
2814
2815    ------------------------------------
2816    -- 3.7  Unknown Discriminant Part --
2817    ------------------------------------
2818
2819    --  UNKNOWN_DISCRIMINANT_PART ::= (<>)
2820
2821    --  If no unknown discriminant part is present, then False is returned,
2822    --  otherwise the unknown discriminant is scanned out and True is returned.
2823
2824    --  Error recovery: cannot raise Error_Resync
2825
2826    function P_Unknown_Discriminant_Part_Opt return Boolean is
2827       Scan_State : Saved_Scan_State;
2828
2829    begin
2830       --  If <> right now, then this is missing left paren
2831
2832       if Token = Tok_Box then
2833          U_Left_Paren;
2834
2835       --  If not <> or left paren, then definitely no box
2836
2837       elsif Token /= Tok_Left_Paren then
2838          return False;
2839
2840       --  Left paren, so might be a box after it
2841
2842       else
2843          Save_Scan_State (Scan_State);
2844          Scan; -- past the left paren
2845
2846          if Token /= Tok_Box then
2847             Restore_Scan_State (Scan_State);
2848             return False;
2849          end if;
2850       end if;
2851
2852       --  We are now pointing to the box
2853
2854       if Ada_Version = Ada_83 then
2855          Error_Msg_SC ("(Ada 83) unknown discriminant not allowed!");
2856       end if;
2857
2858       Scan; -- past the box
2859       U_Right_Paren; -- must be followed by right paren
2860       return True;
2861    end P_Unknown_Discriminant_Part_Opt;
2862
2863    ----------------------------------
2864    -- 3.7  Known Discriminant Part --
2865    ----------------------------------
2866
2867    --  KNOWN_DISCRIMINANT_PART ::=
2868    --    (DISCRIMINANT_SPECIFICATION {; DISCRIMINANT_SPECIFICATION})
2869
2870    --  DISCRIMINANT_SPECIFICATION ::=
2871    --    DEFINING_IDENTIFIER_LIST : [NULL_EXCLUSION] SUBTYPE_MARK
2872    --      [:= DEFAULT_EXPRESSION]
2873    --  | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION
2874    --      [:= DEFAULT_EXPRESSION]
2875
2876    --  If no known discriminant part is present, then No_List is returned
2877
2878    --  Error recovery: cannot raise Error_Resync
2879
2880    function P_Known_Discriminant_Part_Opt return List_Id is
2881       Specification_Node : Node_Id;
2882       Specification_List : List_Id;
2883       Ident_Sloc         : Source_Ptr;
2884       Scan_State         : Saved_Scan_State;
2885       Num_Idents         : Nat;
2886       Not_Null_Present   : Boolean;
2887       Ident              : Nat;
2888
2889       Idents : array (Int range 1 .. 4096) of Entity_Id;
2890       --  This array holds the list of defining identifiers. The upper bound
2891       --  of 4096 is intended to be essentially infinite, and we do not even
2892       --  bother to check for it being exceeded.
2893
2894    begin
2895       if Token = Tok_Left_Paren then
2896          Specification_List := New_List;
2897          Scan; -- past (
2898          P_Pragmas_Misplaced;
2899
2900          Specification_Loop : loop
2901
2902             Ident_Sloc := Token_Ptr;
2903             Idents (1) := P_Defining_Identifier (C_Comma_Colon);
2904             Num_Idents := 1;
2905
2906             while Comma_Present loop
2907                Num_Idents := Num_Idents + 1;
2908                Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
2909             end loop;
2910
2911             --  If there are multiple identifiers, we repeatedly scan the
2912             --  type and initialization expression information by resetting
2913             --  the scan pointer (so that we get completely separate trees
2914             --  for each occurrence).
2915
2916             if Num_Idents > 1 then
2917                Save_Scan_State (Scan_State);
2918             end if;
2919
2920             T_Colon;
2921
2922             --  Loop through defining identifiers in list
2923
2924             Ident := 1;
2925             Ident_Loop : loop
2926                Specification_Node :=
2927                  New_Node (N_Discriminant_Specification, Ident_Sloc);
2928                Set_Defining_Identifier (Specification_Node, Idents (Ident));
2929                Not_Null_Present :=  --  Ada 2005 (AI-231, AI-447)
2930                  P_Null_Exclusion (Allow_Anonymous_In_95 => True);
2931
2932                if Token = Tok_Access then
2933                   if Ada_Version = Ada_83 then
2934                      Error_Msg_SC
2935                        ("(Ada 83) access discriminant not allowed!");
2936                   end if;
2937
2938                   Set_Discriminant_Type
2939                     (Specification_Node,
2940                      P_Access_Definition (Not_Null_Present));
2941                else
2942
2943                   Set_Discriminant_Type
2944                     (Specification_Node, P_Subtype_Mark);
2945                   No_Constraint;
2946                   Set_Null_Exclusion_Present  -- Ada 2005 (AI-231)
2947                     (Specification_Node, Not_Null_Present);
2948                end if;
2949
2950                Set_Expression
2951                  (Specification_Node, Init_Expr_Opt (True));
2952
2953                if Ident > 1 then
2954                   Set_Prev_Ids (Specification_Node, True);
2955                end if;
2956
2957                if Ident < Num_Idents then
2958                   Set_More_Ids (Specification_Node, True);
2959                end if;
2960
2961                Append (Specification_Node, Specification_List);
2962                exit Ident_Loop when Ident = Num_Idents;
2963                Ident := Ident + 1;
2964                Restore_Scan_State (Scan_State);
2965                T_Colon;
2966             end loop Ident_Loop;
2967
2968             exit Specification_Loop when Token /= Tok_Semicolon;
2969             Scan; -- past ;
2970             P_Pragmas_Misplaced;
2971          end loop Specification_Loop;
2972
2973          T_Right_Paren;
2974          return Specification_List;
2975
2976       else
2977          return No_List;
2978       end if;
2979    end P_Known_Discriminant_Part_Opt;
2980
2981    -------------------------------------
2982    -- 3.7  Discriminant Specification --
2983    -------------------------------------
2984
2985    --  Parsed by P_Known_Discriminant_Part_Opt (3.7)
2986
2987    -----------------------------
2988    -- 3.7  Default Expression --
2989    -----------------------------
2990
2991    --  Always parsed (simply as an Expression) by the parent construct
2992
2993    ------------------------------------
2994    -- 3.7.1  Discriminant Constraint --
2995    ------------------------------------
2996
2997    --  Parsed by P_Index_Or_Discriminant_Constraint (3.7.1)
2998
2999    --------------------------------------------------------
3000    -- 3.7.1  Index or Discriminant Constraint (also 3.6) --
3001    --------------------------------------------------------
3002
3003    --  DISCRIMINANT_CONSTRAINT ::=
3004    --    (DISCRIMINANT_ASSOCIATION {, DISCRIMINANT_ASSOCIATION})
3005
3006    --  DISCRIMINANT_ASSOCIATION ::=
3007    --    [discriminant_SELECTOR_NAME {| discriminant_SELECTOR_NAME} =>]
3008    --      EXPRESSION
3009
3010    --  This routine parses either an index or a discriminant constraint. As
3011    --  is clear from the above grammar, it is often possible to clearly
3012    --  determine which of the two possibilities we have, but there are
3013    --  cases (those in which we have a series of expressions of the same
3014    --  syntactic form as subtype indications), where we cannot tell. Since
3015    --  this means that in any case the semantic phase has to distinguish
3016    --  between the two, there is not much point in the parser trying to
3017    --  distinguish even those cases where the difference is clear. In any
3018    --  case, if we have a situation like:
3019
3020    --     (A => 123, 235 .. 500)
3021
3022    --  it is not clear which of the two items is the wrong one, better to
3023    --  let the semantic phase give a clear message. Consequently, this
3024    --  routine in general returns a list of items which can be either
3025    --  discrete ranges or discriminant associations.
3026
3027    --  The caller has checked that the initial token is a left paren
3028
3029    --  Error recovery: can raise Error_Resync
3030
3031    function P_Index_Or_Discriminant_Constraint return Node_Id is
3032       Scan_State  : Saved_Scan_State;
3033       Constr_Node : Node_Id;
3034       Constr_List : List_Id;
3035       Expr_Node   : Node_Id;
3036       Result_Node : Node_Id;
3037
3038    begin
3039       Result_Node := New_Node (N_Index_Or_Discriminant_Constraint, Token_Ptr);
3040       Scan; -- past (
3041       Constr_List := New_List;
3042       Set_Constraints (Result_Node, Constr_List);
3043
3044       --  The two syntactic forms are a little mixed up, so what we are doing
3045       --  here is looking at the first entry to determine which case we have
3046
3047       --  A discriminant constraint is a list of discriminant associations,
3048       --  which have one of the following possible forms:
3049
3050       --    Expression
3051       --    Id => Expression
3052       --    Id | Id | .. | Id => Expression
3053
3054       --  An index constraint is a list of discrete ranges which have one
3055       --  of the following possible forms:
3056
3057       --    Subtype_Mark
3058       --    Subtype_Mark range Range
3059       --    Range_Attribute
3060       --    Simple_Expression .. Simple_Expression
3061
3062       --  Loop through discriminants in list
3063
3064       loop
3065          --  Check cases of Id => Expression or Id | Id => Expression
3066
3067          if Token = Tok_Identifier then
3068             Save_Scan_State (Scan_State); -- at Id
3069             Scan; -- past Id
3070
3071             if Token = Tok_Arrow or else Token = Tok_Vertical_Bar then
3072                Restore_Scan_State (Scan_State); -- to Id
3073                Append (P_Discriminant_Association, Constr_List);
3074                goto Loop_Continue;
3075             else
3076                Restore_Scan_State (Scan_State); -- to Id
3077             end if;
3078          end if;
3079
3080          --  Otherwise scan out an expression and see what we have got
3081
3082          Expr_Node := P_Expression_Or_Range_Attribute;
3083
3084          if Expr_Form = EF_Range_Attr then
3085             Append (Expr_Node, Constr_List);
3086
3087          elsif Token = Tok_Range then
3088             if Expr_Form /= EF_Simple_Name then
3089                Error_Msg_SC ("subtype mark required before RANGE");
3090             end if;
3091
3092             Append (P_Subtype_Indication (Expr_Node), Constr_List);
3093             goto Loop_Continue;
3094
3095          --  Check Simple_Expression .. Simple_Expression case
3096
3097          elsif Token = Tok_Dot_Dot then
3098             Check_Simple_Expression (Expr_Node);
3099             Constr_Node := New_Node (N_Range, Token_Ptr);
3100             Set_Low_Bound (Constr_Node, Expr_Node);
3101             Scan; -- past ..
3102             Expr_Node := P_Expression;
3103             Check_Simple_Expression (Expr_Node);
3104             Set_High_Bound (Constr_Node, Expr_Node);
3105             Append (Constr_Node, Constr_List);
3106             goto Loop_Continue;
3107
3108          --  Case of an expression which could be either form
3109
3110          else
3111             Append (Expr_Node, Constr_List);
3112             goto Loop_Continue;
3113          end if;
3114
3115          --  Here with a single entry scanned
3116
3117          <<Loop_Continue>>
3118             exit when not Comma_Present;
3119
3120       end loop;
3121
3122       T_Right_Paren;
3123       return Result_Node;
3124    end P_Index_Or_Discriminant_Constraint;
3125
3126    -------------------------------------
3127    -- 3.7.1  Discriminant Association --
3128    -------------------------------------
3129
3130    --  DISCRIMINANT_ASSOCIATION ::=
3131    --    [discriminant_SELECTOR_NAME {| discriminant_SELECTOR_NAME} =>]
3132    --      EXPRESSION
3133
3134    --  This routine is used only when the name list is present and the caller
3135    --  has already checked this (by scanning ahead and repositioning the
3136    --  scan).
3137
3138    --  Error_Recovery: cannot raise Error_Resync;
3139
3140    function P_Discriminant_Association return Node_Id is
3141       Discr_Node : Node_Id;
3142       Names_List : List_Id;
3143       Ident_Sloc : Source_Ptr;
3144
3145    begin
3146       Ident_Sloc := Token_Ptr;
3147       Names_List := New_List;
3148
3149       loop
3150          Append (P_Identifier (C_Vertical_Bar_Arrow), Names_List);
3151          exit when Token /= Tok_Vertical_Bar;
3152          Scan; -- past |
3153       end loop;
3154
3155       Discr_Node := New_Node (N_Discriminant_Association, Ident_Sloc);
3156       Set_Selector_Names (Discr_Node, Names_List);
3157       TF_Arrow;
3158       Set_Expression (Discr_Node, P_Expression);
3159       return Discr_Node;
3160    end P_Discriminant_Association;
3161
3162    ---------------------------------
3163    -- 3.8  Record Type Definition --
3164    ---------------------------------
3165
3166    --  RECORD_TYPE_DEFINITION ::=
3167    --    [[abstract] tagged] [limited] RECORD_DEFINITION
3168
3169    --  There is no node in the tree for a record type definition. Instead
3170    --  a record definition node appears, with possible Abstract_Present,
3171    --  Tagged_Present, and Limited_Present flags set appropriately.
3172
3173    ----------------------------
3174    -- 3.8  Record Definition --
3175    ----------------------------
3176
3177    --  RECORD_DEFINITION ::=
3178    --    record
3179    --      COMPONENT_LIST
3180    --    end record
3181    --  | null record
3182
3183    --  Note: in the case where a record definition node is used to represent
3184    --  a record type definition, the caller sets the Tagged_Present and
3185    --  Limited_Present flags in the resulting N_Record_Definition node as
3186    --  required.
3187
3188    --  Note that the RECORD token at the start may be missing in certain
3189    --  error situations, so this function is expected to post the error
3190
3191    --  Error recovery: can raise Error_Resync
3192
3193    function P_Record_Definition return Node_Id is
3194       Rec_Node : Node_Id;
3195
3196    begin
3197       Rec_Node := New_Node (N_Record_Definition, Token_Ptr);
3198
3199       --  Null record case
3200
3201       if Token = Tok_Null then
3202          Scan; -- past NULL
3203          T_Record;
3204          Set_Null_Present (Rec_Node, True);
3205
3206       --  Catch incomplete declaration to prevent cascaded errors, see
3207       --  ACATS B393002 for an example.
3208
3209       elsif Token = Tok_Semicolon then
3210          Error_Msg_AP ("missing record definition");
3211
3212       --  Case starting with RECORD keyword. Build scope stack entry. For the
3213       --  column, we use the first non-blank character on the line, to deal
3214       --  with situations such as:
3215
3216       --    type X is record
3217       --      ...
3218       --    end record;
3219
3220       --  which is not official RM indentation, but is not uncommon usage, and
3221       --  in particular is standard GNAT coding style, so handle it nicely.
3222
3223       else
3224          Push_Scope_Stack;
3225          Scope.Table (Scope.Last).Etyp := E_Record;
3226          Scope.Table (Scope.Last).Ecol := Start_Column;
3227          Scope.Table (Scope.Last).Sloc := Token_Ptr;
3228          Scope.Table (Scope.Last).Labl := Error;
3229          Scope.Table (Scope.Last).Junk := (Token /= Tok_Record);
3230
3231          T_Record;
3232
3233          Set_Component_List (Rec_Node, P_Component_List);
3234
3235          loop
3236             exit when Check_End;
3237             Discard_Junk_Node (P_Component_List);
3238          end loop;
3239       end if;
3240
3241       return Rec_Node;
3242    end P_Record_Definition;
3243
3244    -------------------------
3245    -- 3.8  Component List --
3246    -------------------------
3247
3248    --  COMPONENT_LIST ::=
3249    --    COMPONENT_ITEM {COMPONENT_ITEM}
3250    --  | {COMPONENT_ITEM} VARIANT_PART
3251    --  | null;
3252
3253    --  Error recovery: cannot raise Error_Resync
3254
3255    function P_Component_List return Node_Id is
3256       Component_List_Node : Node_Id;
3257       Decls_List          : List_Id;
3258       Scan_State          : Saved_Scan_State;
3259
3260    begin
3261       Component_List_Node := New_Node (N_Component_List, Token_Ptr);
3262       Decls_List := New_List;
3263
3264       if Token = Tok_Null then
3265          Scan; -- past NULL
3266          TF_Semicolon;
3267          P_Pragmas_Opt (Decls_List);
3268          Set_Null_Present (Component_List_Node, True);
3269          return Component_List_Node;
3270
3271       else
3272          P_Pragmas_Opt (Decls_List);
3273
3274          if Token /= Tok_Case then
3275             Component_Scan_Loop : loop
3276                P_Component_Items (Decls_List);
3277                P_Pragmas_Opt (Decls_List);
3278
3279                exit Component_Scan_Loop when Token = Tok_End
3280                  or else Token = Tok_Case
3281                  or else Token = Tok_When;
3282
3283                --  We are done if we do not have an identifier. However, if
3284                --  we have a misspelled reserved identifier that is in a column
3285                --  to the right of the record definition, we will treat it as
3286                --  an identifier. It turns out to be too dangerous in practice
3287                --  to accept such a mis-spelled identifier which does not have
3288                --  this additional clue that confirms the incorrect spelling.
3289
3290                if Token /= Tok_Identifier then
3291                   if Start_Column > Scope.Table (Scope.Last).Ecol
3292                     and then Is_Reserved_Identifier
3293                   then
3294                      Save_Scan_State (Scan_State); -- at reserved id
3295                      Scan; -- possible reserved id
3296
3297                      if Token = Tok_Comma or else Token = Tok_Colon then
3298                         Restore_Scan_State (Scan_State);
3299                         Scan_Reserved_Identifier (Force_Msg => True);
3300
3301                      --  Note reserved identifier used as field name after
3302                      --  all because not followed by colon or comma
3303
3304                      else
3305                         Restore_Scan_State (Scan_State);
3306                         exit Component_Scan_Loop;
3307                      end if;
3308
3309                   --  Non-identifier that definitely was not reserved id
3310
3311                   else
3312                      exit Component_Scan_Loop;
3313                   end if;
3314                end if;
3315             end loop Component_Scan_Loop;
3316          end if;
3317
3318          if Token = Tok_Case then
3319             Set_Variant_Part (Component_List_Node, P_Variant_Part);
3320
3321             --  Check for junk after variant part
3322
3323             if Token = Tok_Identifier then
3324                Save_Scan_State (Scan_State);
3325                Scan; -- past identifier
3326
3327                if Token = Tok_Colon then
3328                   Restore_Scan_State (Scan_State);
3329                   Error_Msg_SC ("component may not follow variant part");
3330                   Discard_Junk_Node (P_Component_List);
3331
3332                elsif Token = Tok_Case then
3333                   Restore_Scan_State (Scan_State);
3334                   Error_Msg_SC ("only one variant part allowed in a record");
3335                   Discard_Junk_Node (P_Component_List);
3336
3337                else
3338                   Restore_Scan_State (Scan_State);
3339                end if;
3340             end if;
3341          end if;
3342       end if;
3343
3344       Set_Component_Items (Component_List_Node, Decls_List);
3345       return Component_List_Node;
3346    end P_Component_List;
3347
3348    -------------------------
3349    -- 3.8  Component Item --
3350    -------------------------
3351
3352    --  COMPONENT_ITEM ::= COMPONENT_DECLARATION | REPRESENTATION_CLAUSE
3353
3354    --  COMPONENT_DECLARATION ::=
3355    --    DEFINING_IDENTIFIER_LIST : COMPONENT_DEFINITION
3356    --      [:= DEFAULT_EXPRESSION]
3357    --        [ASPECT_SPECIFICATIONS];
3358
3359    --  COMPONENT_DEFINITION ::=
3360    --    [aliased] [NULL_EXCLUSION] SUBTYPE_INDICATION | ACCESS_DEFINITION
3361
3362    --  Error recovery: cannot raise Error_Resync, if an error occurs,
3363    --  the scan is positioned past the following semicolon.
3364
3365    --  Note: we do not yet allow representation clauses to appear as component
3366    --  items, do we need to add this capability sometime in the future ???
3367
3368    procedure P_Component_Items (Decls : List_Id) is
3369       Aliased_Present  : Boolean := False;
3370       CompDef_Node     : Node_Id;
3371       Decl_Node        : Node_Id;
3372       Scan_State       : Saved_Scan_State;
3373       Not_Null_Present : Boolean := False;
3374       Num_Idents       : Nat;
3375       Ident            : Nat;
3376       Ident_Sloc       : Source_Ptr;
3377
3378       Idents : array (Int range 1 .. 4096) of Entity_Id;
3379       --  This array holds the list of defining identifiers. The upper bound
3380       --  of 4096 is intended to be essentially infinite, and we do not even
3381       --  bother to check for it being exceeded.
3382
3383    begin
3384       if Token /= Tok_Identifier then
3385          Error_Msg_SC ("component declaration expected");
3386          Resync_Past_Semicolon;
3387          return;
3388       end if;
3389
3390       Ident_Sloc := Token_Ptr;
3391       Idents (1) := P_Defining_Identifier (C_Comma_Colon);
3392       Num_Idents := 1;
3393
3394       while Comma_Present loop
3395          Num_Idents := Num_Idents + 1;
3396          Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
3397       end loop;
3398
3399       --  If there are multiple identifiers, we repeatedly scan the
3400       --  type and initialization expression information by resetting
3401       --  the scan pointer (so that we get completely separate trees
3402       --  for each occurrence).
3403
3404       if Num_Idents > 1 then
3405          Save_Scan_State (Scan_State);
3406       end if;
3407
3408       T_Colon;
3409
3410       --  Loop through defining identifiers in list
3411
3412       Ident := 1;
3413       Ident_Loop : loop
3414
3415          --  The following block is present to catch Error_Resync
3416          --  which causes the parse to be reset past the semicolon
3417
3418          begin
3419             Decl_Node := New_Node (N_Component_Declaration, Ident_Sloc);
3420             Set_Defining_Identifier (Decl_Node, Idents (Ident));
3421
3422             if Token = Tok_Constant then
3423                Error_Msg_SC ("constant components are not permitted");
3424                Scan;
3425             end if;
3426
3427             CompDef_Node := New_Node (N_Component_Definition, Token_Ptr);
3428
3429             if Token_Name = Name_Aliased then
3430                Check_95_Keyword (Tok_Aliased, Tok_Identifier);
3431             end if;
3432
3433             if Token = Tok_Aliased then
3434                Aliased_Present := True;
3435                Scan; -- past ALIASED
3436             end if;
3437
3438             Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231/AI-254)
3439
3440             --  Ada 2005 (AI-230): Access Definition case
3441
3442             if Token = Tok_Access then
3443                if Ada_Version < Ada_2005 then
3444                   Error_Msg_SP
3445                     ("generalized use of anonymous access types " &
3446                      "is an Ada 2005 extension");
3447                   Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
3448                end if;
3449
3450                if Aliased_Present then
3451                   Error_Msg_SP ("ALIASED not allowed here");
3452                end if;
3453
3454                Set_Subtype_Indication (CompDef_Node, Empty);
3455                Set_Aliased_Present    (CompDef_Node, False);
3456                Set_Access_Definition  (CompDef_Node,
3457                  P_Access_Definition (Not_Null_Present));
3458             else
3459
3460                Set_Access_Definition      (CompDef_Node, Empty);
3461                Set_Aliased_Present        (CompDef_Node, Aliased_Present);
3462                Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
3463
3464                if Token = Tok_Array then
3465                   Error_Msg_SC ("anonymous arrays not allowed as components");
3466                   raise Error_Resync;
3467                end if;
3468
3469                Set_Subtype_Indication (CompDef_Node,
3470                  P_Subtype_Indication (Not_Null_Present));
3471             end if;
3472
3473             Set_Component_Definition (Decl_Node, CompDef_Node);
3474             Set_Expression           (Decl_Node, Init_Expr_Opt);
3475
3476             if Ident > 1 then
3477                Set_Prev_Ids (Decl_Node, True);
3478             end if;
3479
3480             if Ident < Num_Idents then
3481                Set_More_Ids (Decl_Node, True);
3482             end if;
3483
3484             Append (Decl_Node, Decls);
3485
3486          exception
3487             when Error_Resync =>
3488                if Token /= Tok_End then
3489                   Resync_Past_Semicolon;
3490                end if;
3491          end;
3492
3493          exit Ident_Loop when Ident = Num_Idents;
3494          Ident := Ident + 1;
3495          Restore_Scan_State (Scan_State);
3496          T_Colon;
3497       end loop Ident_Loop;
3498
3499       P_Aspect_Specifications (Decl_Node);
3500    end P_Component_Items;
3501
3502    --------------------------------
3503    -- 3.8  Component Declaration --
3504    --------------------------------
3505
3506    --  Parsed by P_Component_Items (3.8)
3507
3508    -------------------------
3509    -- 3.8.1  Variant Part --
3510    -------------------------
3511
3512    --  VARIANT_PART ::=
3513    --    case discriminant_DIRECT_NAME is
3514    --      VARIANT
3515    --      {VARIANT}
3516    --    end case;
3517
3518    --  The caller has checked that the initial token is CASE
3519
3520    --  Error recovery: cannot raise Error_Resync
3521
3522    function P_Variant_Part return Node_Id is
3523       Variant_Part_Node : Node_Id;
3524       Variants_List     : List_Id;
3525       Case_Node         : Node_Id;
3526
3527    begin
3528       Variant_Part_Node := New_Node (N_Variant_Part, Token_Ptr);
3529       Push_Scope_Stack;
3530       Scope.Table (Scope.Last).Etyp := E_Case;
3531       Scope.Table (Scope.Last).Sloc := Token_Ptr;
3532       Scope.Table (Scope.Last).Ecol := Start_Column;
3533
3534       Scan; -- past CASE
3535       Case_Node := P_Expression;
3536       Set_Name (Variant_Part_Node, Case_Node);
3537
3538       if Nkind (Case_Node) /= N_Identifier then
3539          Set_Name (Variant_Part_Node, Error);
3540          Error_Msg ("discriminant name expected", Sloc (Case_Node));
3541
3542       elsif Paren_Count (Case_Node) /= 0 then
3543          Error_Msg
3544            ("|discriminant name may not be parenthesized",
3545                     Sloc (Case_Node));
3546          Set_Paren_Count (Case_Node, 0);
3547       end if;
3548
3549       TF_Is;
3550       Variants_List := New_List;
3551       P_Pragmas_Opt (Variants_List);
3552
3553       --  Test missing variant
3554
3555       if Token = Tok_End then
3556          Error_Msg_BC ("WHEN expected (must have at least one variant)");
3557       else
3558          Append (P_Variant, Variants_List);
3559       end if;
3560
3561       --  Loop through variants, note that we allow if in place of when,
3562       --  this error will be detected and handled in P_Variant.
3563
3564       loop
3565          P_Pragmas_Opt (Variants_List);
3566
3567          if Token /= Tok_When
3568            and then Token /= Tok_If
3569            and then Token /= Tok_Others
3570          then
3571             exit when Check_End;
3572          end if;
3573
3574          Append (P_Variant, Variants_List);
3575       end loop;
3576
3577       Set_Variants (Variant_Part_Node, Variants_List);
3578       return Variant_Part_Node;
3579    end P_Variant_Part;
3580
3581    --------------------
3582    -- 3.8.1  Variant --
3583    --------------------
3584
3585    --  VARIANT ::=
3586    --    when DISCRETE_CHOICE_LIST =>
3587    --      COMPONENT_LIST
3588
3589    --  Error recovery: cannot raise Error_Resync
3590
3591    --  The initial token on entry is either WHEN, IF or OTHERS
3592
3593    function P_Variant return Node_Id is
3594       Variant_Node : Node_Id;
3595
3596    begin
3597       --  Special check to recover nicely from use of IF in place of WHEN
3598
3599       if Token = Tok_If then
3600          T_When;
3601          Scan; -- past IF
3602       else
3603          T_When;
3604       end if;
3605
3606       Variant_Node := New_Node (N_Variant, Prev_Token_Ptr);
3607       Set_Discrete_Choices (Variant_Node, P_Discrete_Choice_List);
3608       TF_Arrow;
3609       Set_Component_List (Variant_Node, P_Component_List);
3610       return Variant_Node;
3611    end P_Variant;
3612
3613    ---------------------------------
3614    -- 3.8.1  Discrete Choice List --
3615    ---------------------------------
3616
3617    --  DISCRETE_CHOICE_LIST ::= DISCRETE_CHOICE {| DISCRETE_CHOICE}
3618
3619    --  DISCRETE_CHOICE ::= EXPRESSION | DISCRETE_RANGE | others
3620
3621    --  Note: in Ada 83, the expression must be a simple expression
3622
3623    --  Error recovery: cannot raise Error_Resync
3624
3625    function P_Discrete_Choice_List return List_Id is
3626       Choices     : List_Id;
3627       Expr_Node   : Node_Id;
3628       Choice_Node : Node_Id;
3629
3630    begin
3631       Choices := New_List;
3632       loop
3633          if Token = Tok_Others then
3634             Append (New_Node (N_Others_Choice, Token_Ptr), Choices);
3635             Scan; -- past OTHERS
3636
3637          else
3638             begin
3639                --  Scan out expression or range attribute
3640
3641                Expr_Node := P_Expression_Or_Range_Attribute;
3642                Ignore (Tok_Right_Paren);
3643
3644                if Token = Tok_Colon
3645                  and then Nkind (Expr_Node) = N_Identifier
3646                then
3647                   Error_Msg_SP ("label not permitted in this context");
3648                   Scan; -- past colon
3649
3650                --  Range attribute
3651
3652                elsif Expr_Form = EF_Range_Attr then
3653                   Append (Expr_Node, Choices);
3654
3655                --  Explicit range
3656
3657                elsif Token = Tok_Dot_Dot then
3658                   Check_Simple_Expression (Expr_Node);
3659                   Choice_Node := New_Node (N_Range, Token_Ptr);
3660                   Set_Low_Bound (Choice_Node, Expr_Node);
3661                   Scan; -- past ..
3662                   Expr_Node := P_Expression_No_Right_Paren;
3663                   Check_Simple_Expression (Expr_Node);
3664                   Set_High_Bound (Choice_Node, Expr_Node);
3665                   Append (Choice_Node, Choices);
3666
3667                --  Simple name, must be subtype, so range allowed
3668
3669                elsif Expr_Form = EF_Simple_Name then
3670                   if Token = Tok_Range then
3671                      Append (P_Subtype_Indication (Expr_Node), Choices);
3672
3673                   elsif Token in Token_Class_Consk then
3674                      Error_Msg_SC
3675                        ("the only constraint allowed here " &
3676                         "is a range constraint");
3677                      Discard_Junk_Node (P_Constraint_Opt);
3678                      Append (Expr_Node, Choices);
3679
3680                   else
3681                      Append (Expr_Node, Choices);
3682                   end if;
3683
3684                --  Expression
3685
3686                else
3687                   --  In Ada 2012 mode, the expression must be a simple
3688                   --  expression. The resaon for this restriction (i.e. going
3689                   --  back to the Ada 83 rule) is to avoid ambiguities when set
3690                   --  membership operations are allowed, consider the
3691                   --  following:
3692
3693                   --     when A in 1 .. 10 | 12 =>
3694
3695                   --  This is ambiguous without parentheses, so we require one
3696                   --  of the following two parenthesized forms to disambuguate:
3697
3698                   --  one of the following:
3699
3700                   --     when (A in 1 .. 10 | 12) =>
3701                   --     when (A in 1 .. 10) | 12 =>
3702
3703                   --  To solve this, in Ada 2012 mode, we disallow the use of
3704                   --  membership operations in expressions in choices.
3705
3706                   --  Technically in the grammar, the expression must match the
3707                   --  grammar for restricted expression.
3708
3709                   if Ada_Version >= Ada_2012 then
3710                      Check_Restricted_Expression (Expr_Node);
3711
3712                   --  In Ada 83 mode, the syntax required a simple expression
3713
3714                   else
3715                      Check_Simple_Expression_In_Ada_83 (Expr_Node);
3716                   end if;
3717
3718                   Append (Expr_Node, Choices);
3719                end if;
3720
3721             exception
3722                when Error_Resync =>
3723                   Resync_Choice;
3724                   return Error_List;
3725             end;
3726          end if;
3727
3728          if Token = Tok_Comma then
3729             Error_Msg_SC -- CODEFIX
3730               (""","" should be ""'|""");
3731          else
3732             exit when Token /= Tok_Vertical_Bar;
3733          end if;
3734
3735          Scan; -- past | or comma
3736       end loop;
3737
3738       return Choices;
3739    end P_Discrete_Choice_List;
3740
3741    ----------------------------
3742    -- 3.8.1  Discrete Choice --
3743    ----------------------------
3744
3745    --  Parsed by P_Discrete_Choice_List (3.8.1)
3746
3747    ----------------------------------
3748    -- 3.9.1  Record Extension Part --
3749    ----------------------------------
3750
3751    --  RECORD_EXTENSION_PART ::= with RECORD_DEFINITION
3752
3753    --  Parsed by P_Derived_Type_Def_Or_Private_Ext_Decl (3.4)
3754
3755    --------------------------------------
3756    -- 3.9.4  Interface Type Definition --
3757    --------------------------------------
3758
3759    --  INTERFACE_TYPE_DEFINITION ::=
3760    --    [limited | task | protected | synchronized] interface
3761    --      [and INTERFACE_LIST]
3762
3763    --  Error recovery: cannot raise Error_Resync
3764
3765    function P_Interface_Type_Definition
3766      (Abstract_Present : Boolean) return Node_Id
3767    is
3768       Typedef_Node : Node_Id;
3769
3770    begin
3771       if Ada_Version < Ada_2005 then
3772          Error_Msg_SP ("abstract interface is an Ada 2005 extension");
3773          Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
3774       end if;
3775
3776       if Abstract_Present then
3777          Error_Msg_SP
3778            ("ABSTRACT not allowed in interface type definition " &
3779             "(RM 3.9.4(2/2))");
3780       end if;
3781
3782       Scan; -- past INTERFACE
3783
3784       --  Ada 2005 (AI-345): In case of interfaces with a null list of
3785       --  interfaces we build a record_definition node.
3786
3787       if Token = Tok_Semicolon then
3788          Typedef_Node := New_Node (N_Record_Definition, Token_Ptr);
3789
3790          Set_Abstract_Present  (Typedef_Node);
3791          Set_Tagged_Present    (Typedef_Node);
3792          Set_Null_Present      (Typedef_Node);
3793          Set_Interface_Present (Typedef_Node);
3794
3795       --  Ada 2005 (AI-251): In case of not-synchronized interfaces that have
3796       --  a list of interfaces we build a derived_type_definition node. This
3797       --  simplifies the semantic analysis (and hence further maintenance)
3798
3799       else
3800          if Token /= Tok_And then
3801             Error_Msg_AP ("AND expected");
3802          else
3803             Scan; -- past AND
3804          end if;
3805
3806          Typedef_Node := New_Node (N_Derived_Type_Definition, Token_Ptr);
3807
3808          Set_Abstract_Present   (Typedef_Node);
3809          Set_Interface_Present  (Typedef_Node);
3810          Set_Subtype_Indication (Typedef_Node, P_Qualified_Simple_Name);
3811
3812          Set_Record_Extension_Part (Typedef_Node,
3813            New_Node (N_Record_Definition, Token_Ptr));
3814          Set_Null_Present (Record_Extension_Part (Typedef_Node));
3815
3816          if Token = Tok_And then
3817             Set_Interface_List (Typedef_Node, New_List);
3818             Scan; -- past AND
3819
3820             loop
3821                Append (P_Qualified_Simple_Name,
3822                        Interface_List (Typedef_Node));
3823                exit when Token /= Tok_And;
3824                Scan; -- past AND
3825             end loop;
3826          end if;
3827       end if;
3828
3829       return Typedef_Node;
3830    end P_Interface_Type_Definition;
3831
3832    ----------------------------------
3833    -- 3.10  Access Type Definition --
3834    ----------------------------------
3835
3836    --  ACCESS_TYPE_DEFINITION ::=
3837    --    ACCESS_TO_OBJECT_DEFINITION
3838    --  | ACCESS_TO_SUBPROGRAM_DEFINITION
3839
3840    --  ACCESS_TO_OBJECT_DEFINITION ::=
3841    --    [NULL_EXCLUSION] access [GENERAL_ACCESS_MODIFIER] SUBTYPE_INDICATION
3842
3843    --  GENERAL_ACCESS_MODIFIER ::= all | constant
3844
3845    --  ACCESS_TO_SUBPROGRAM_DEFINITION
3846    --    [NULL_EXCLUSION] access [protected] procedure PARAMETER_PROFILE
3847    --  | [NULL_EXCLUSION] access [protected] function
3848    --    PARAMETER_AND_RESULT_PROFILE
3849
3850    --  PARAMETER_PROFILE ::= [FORMAL_PART]
3851
3852    --  PARAMETER_AND_RESULT_PROFILE ::= [FORMAL_PART] RETURN SUBTYPE_MARK
3853
3854    --  Ada 2005 (AI-254): If Header_Already_Parsed then the caller has already
3855    --  parsed the null_exclusion part and has also removed the ACCESS token;
3856    --  otherwise the caller has just checked that the initial token is ACCESS
3857
3858    --  Error recovery: can raise Error_Resync
3859
3860    function P_Access_Type_Definition
3861      (Header_Already_Parsed : Boolean := False) return Node_Id
3862    is
3863       Access_Loc       : constant Source_Ptr := Token_Ptr;
3864       Prot_Flag        : Boolean;
3865       Not_Null_Present : Boolean := False;
3866       Type_Def_Node    : Node_Id;
3867       Result_Not_Null  : Boolean;
3868       Result_Node      : Node_Id;
3869
3870       procedure Check_Junk_Subprogram_Name;
3871       --  Used in access to subprogram definition cases to check for an
3872       --  identifier or operator symbol that does not belong.
3873
3874       --------------------------------
3875       -- Check_Junk_Subprogram_Name --
3876       --------------------------------
3877
3878       procedure Check_Junk_Subprogram_Name is
3879          Saved_State : Saved_Scan_State;
3880
3881       begin
3882          if Token = Tok_Identifier or else Token = Tok_Operator_Symbol then
3883             Save_Scan_State (Saved_State);
3884             Scan; -- past possible junk subprogram name
3885
3886             if Token = Tok_Left_Paren or else Token = Tok_Semicolon then
3887                Error_Msg_SP ("unexpected subprogram name ignored");
3888                return;
3889
3890             else
3891                Restore_Scan_State (Saved_State);
3892             end if;
3893          end if;
3894       end Check_Junk_Subprogram_Name;
3895
3896    --  Start of processing for P_Access_Type_Definition
3897
3898    begin
3899       if not Header_Already_Parsed then
3900          Not_Null_Present := P_Null_Exclusion;         --  Ada 2005 (AI-231)
3901          Scan; -- past ACCESS
3902       end if;
3903
3904       if Token_Name = Name_Protected then
3905          Check_95_Keyword (Tok_Protected, Tok_Procedure);
3906          Check_95_Keyword (Tok_Protected, Tok_Function);
3907       end if;
3908
3909       Prot_Flag := (Token = Tok_Protected);
3910
3911       if Prot_Flag then
3912          Scan; -- past PROTECTED
3913
3914          if Token /= Tok_Procedure and then Token /= Tok_Function then
3915             Error_Msg_SC -- CODEFIX
3916               ("FUNCTION or PROCEDURE expected");
3917          end if;
3918       end if;
3919
3920       if Token = Tok_Procedure then
3921          if Ada_Version = Ada_83 then
3922             Error_Msg_SC ("(Ada 83) access to procedure not allowed!");
3923          end if;
3924
3925          Type_Def_Node := New_Node (N_Access_Procedure_Definition, Access_Loc);
3926          Set_Null_Exclusion_Present (Type_Def_Node, Not_Null_Present);
3927          Scan; -- past PROCEDURE
3928          Check_Junk_Subprogram_Name;
3929          Set_Parameter_Specifications (Type_Def_Node, P_Parameter_Profile);
3930          Set_Protected_Present (Type_Def_Node, Prot_Flag);
3931
3932       elsif Token = Tok_Function then
3933          if Ada_Version = Ada_83 then
3934             Error_Msg_SC ("(Ada 83) access to function not allowed!");
3935          end if;
3936
3937          Type_Def_Node := New_Node (N_Access_Function_Definition, Access_Loc);
3938          Set_Null_Exclusion_Present (Type_Def_Node, Not_Null_Present);
3939          Scan; -- past FUNCTION
3940          Check_Junk_Subprogram_Name;
3941          Set_Parameter_Specifications (Type_Def_Node, P_Parameter_Profile);
3942          Set_Protected_Present (Type_Def_Node, Prot_Flag);
3943          TF_Return;
3944
3945          Result_Not_Null := P_Null_Exclusion;     --  Ada 2005 (AI-231)
3946
3947          --  Ada 2005 (AI-318-02)
3948
3949          if Token = Tok_Access then
3950             if Ada_Version < Ada_2005 then
3951                Error_Msg_SC
3952                  ("anonymous access result type is an Ada 2005 extension");
3953                Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
3954             end if;
3955
3956             Result_Node := P_Access_Definition (Result_Not_Null);
3957
3958          else
3959             Result_Node := P_Subtype_Mark;
3960             No_Constraint;
3961
3962             --  A null exclusion on the result type must be recorded in a flag
3963             --  distinct from the one used for the access-to-subprogram type's
3964             --  null exclusion.
3965
3966             Set_Null_Exclusion_In_Return_Present
3967               (Type_Def_Node, Result_Not_Null);
3968          end if;
3969
3970          Set_Result_Definition (Type_Def_Node, Result_Node);
3971
3972       else
3973          Type_Def_Node :=
3974            New_Node (N_Access_To_Object_Definition, Access_Loc);
3975          Set_Null_Exclusion_Present (Type_Def_Node, Not_Null_Present);
3976
3977          if Token = Tok_All or else Token = Tok_Constant then
3978             if Ada_Version = Ada_83 then
3979                Error_Msg_SC ("(Ada 83) access modifier not allowed!");
3980             end if;
3981
3982             if Token = Tok_All then
3983                Set_All_Present (Type_Def_Node, True);
3984
3985             else
3986                Set_Constant_Present (Type_Def_Node, True);
3987             end if;
3988
3989             Scan; -- past ALL or CONSTANT
3990          end if;
3991
3992          Set_Subtype_Indication (Type_Def_Node,
3993             P_Subtype_Indication (Not_Null_Present));
3994       end if;
3995
3996       return Type_Def_Node;
3997    end P_Access_Type_Definition;
3998
3999    ---------------------------------------
4000    -- 3.10  Access To Object Definition --
4001    ---------------------------------------
4002
4003    --  Parsed by P_Access_Type_Definition (3.10)
4004
4005    -----------------------------------
4006    -- 3.10  General Access Modifier --
4007    -----------------------------------
4008
4009    --  Parsed by P_Access_Type_Definition (3.10)
4010
4011    -------------------------------------------
4012    -- 3.10  Access To Subprogram Definition --
4013    -------------------------------------------
4014
4015    --  Parsed by P_Access_Type_Definition (3.10)
4016
4017    -----------------------------
4018    -- 3.10  Access Definition --
4019    -----------------------------
4020
4021    --  ACCESS_DEFINITION ::=
4022    --    [NULL_EXCLUSION] access [GENERAL_ACCESS_MODIFIER] SUBTYPE_MARK
4023    --  | ACCESS_TO_SUBPROGRAM_DEFINITION
4024    --
4025    --  ACCESS_TO_SUBPROGRAM_DEFINITION
4026    --    [NULL_EXCLUSION] access [protected] procedure PARAMETER_PROFILE
4027    --  | [NULL_EXCLUSION] access [protected] function
4028    --    PARAMETER_AND_RESULT_PROFILE
4029
4030    --  The caller has parsed the null-exclusion part and it has also checked
4031    --  that the next token is ACCESS
4032
4033    --  Error recovery: cannot raise Error_Resync
4034
4035    function P_Access_Definition
4036      (Null_Exclusion_Present : Boolean) return Node_Id
4037    is
4038       Def_Node  : Node_Id;
4039       Subp_Node : Node_Id;
4040
4041    begin
4042       Def_Node := New_Node (N_Access_Definition, Token_Ptr);
4043       Scan; -- past ACCESS
4044
4045       --  Ada 2005 (AI-254): Access_To_Subprogram_Definition
4046
4047       if Token = Tok_Protected
4048         or else Token = Tok_Procedure
4049         or else Token = Tok_Function
4050       then
4051          if Ada_Version < Ada_2005 then
4052             Error_Msg_SP ("access-to-subprogram is an Ada 2005 extension");
4053             Error_Msg_SP ("\unit should be compiled with -gnat05 switch");
4054          end if;
4055
4056          Subp_Node := P_Access_Type_Definition (Header_Already_Parsed => True);
4057          Set_Null_Exclusion_Present (Subp_Node, Null_Exclusion_Present);
4058          Set_Access_To_Subprogram_Definition (Def_Node, Subp_Node);
4059
4060       --  Ada 2005 (AI-231)
4061       --  [NULL_EXCLUSION] access [GENERAL_ACCESS_MODIFIER] SUBTYPE_MARK
4062
4063       else
4064          Set_Null_Exclusion_Present (Def_Node, Null_Exclusion_Present);
4065
4066          if Token = Tok_All then
4067             if Ada_Version < Ada_2005 then
4068                Error_Msg_SP
4069                  ("ALL is not permitted for anonymous access types");
4070             end if;
4071
4072             Scan; -- past ALL
4073             Set_All_Present (Def_Node);
4074
4075          elsif Token = Tok_Constant then
4076             if Ada_Version < Ada_2005 then
4077                Error_Msg_SP ("access-to-constant is an Ada 2005 extension");
4078                Error_Msg_SP ("\unit should be compiled with -gnat05 switch");
4079             end if;
4080
4081             Scan; -- past CONSTANT
4082             Set_Constant_Present (Def_Node);
4083          end if;
4084
4085          Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
4086          No_Constraint;
4087       end if;
4088
4089       return Def_Node;
4090    end P_Access_Definition;
4091
4092    -----------------------------------------
4093    -- 3.10.1  Incomplete Type Declaration --
4094    -----------------------------------------
4095
4096    --  Parsed by P_Type_Declaration (3.2.1)
4097
4098    ----------------------------
4099    -- 3.11  Declarative Part --
4100    ----------------------------
4101
4102    --  DECLARATIVE_PART ::= {DECLARATIVE_ITEM}
4103
4104    --  Error recovery: cannot raise Error_Resync (because P_Declarative_Items
4105    --  handles errors, and returns cleanly after an error has occurred)
4106
4107    function P_Declarative_Part return List_Id is
4108       Decls : List_Id;
4109       Done  : Boolean;
4110
4111    begin
4112       --  Indicate no bad declarations detected yet. This will be reset by
4113       --  P_Declarative_Items if a bad declaration is discovered.
4114
4115       Missing_Begin_Msg := No_Error_Msg;
4116
4117       --  Get rid of active SIS entry from outer scope. This means we will
4118       --  miss some nested cases, but it doesn't seem worth the effort. See
4119       --  discussion in Par for further details
4120
4121       SIS_Entry_Active := False;
4122       Decls := New_List;
4123
4124       --  Loop to scan out the declarations
4125
4126       loop
4127          P_Declarative_Items (Decls, Done, In_Spec => False);
4128          exit when Done;
4129       end loop;
4130
4131       --  Get rid of active SIS entry which is left set only if we scanned a
4132       --  procedure declaration and have not found the body. We could give
4133       --  an error message, but that really would be usurping the role of
4134       --  semantic analysis (this really is a missing body case).
4135
4136       SIS_Entry_Active := False;
4137       return Decls;
4138    end P_Declarative_Part;
4139
4140    ----------------------------
4141    -- 3.11  Declarative Item --
4142    ----------------------------
4143
4144    --  DECLARATIVE_ITEM ::= BASIC_DECLARATIVE_ITEM | BODY
4145
4146    --  Can return Error if a junk declaration is found, or Empty if no
4147    --  declaration is found (i.e. a token ending declarations, such as
4148    --  BEGIN or END is encountered).
4149
4150    --  Error recovery: cannot raise Error_Resync. If an error resync occurs,
4151    --  then the scan is set past the next semicolon and Error is returned.
4152
4153    procedure P_Declarative_Items
4154      (Decls   : List_Id;
4155       Done    : out Boolean;
4156       In_Spec : Boolean)
4157    is
4158       Scan_State : Saved_Scan_State;
4159
4160    begin
4161       if Style_Check then
4162          Style.Check_Indentation;
4163       end if;
4164
4165       case Token is
4166
4167          when Tok_Function =>
4168             Check_Bad_Layout;
4169             Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
4170             Done := False;
4171
4172          when Tok_For =>
4173             Check_Bad_Layout;
4174
4175             --  Check for loop (premature statement)
4176
4177             Save_Scan_State (Scan_State);
4178             Scan; -- past FOR
4179
4180             if Token = Tok_Identifier then
4181                Scan; -- past identifier
4182
4183                if Token = Tok_In then
4184                   Restore_Scan_State (Scan_State);
4185                   Statement_When_Declaration_Expected (Decls, Done, In_Spec);
4186                   return;
4187                end if;
4188             end if;
4189
4190             --  Not a loop, so must be rep clause
4191
4192             Restore_Scan_State (Scan_State);
4193             Append (P_Representation_Clause, Decls);
4194             Done := False;
4195
4196          when Tok_Generic =>
4197             Check_Bad_Layout;
4198             Append (P_Generic, Decls);
4199             Done := False;
4200
4201          when Tok_Identifier =>
4202             Check_Bad_Layout;
4203
4204             --  Special check for misuse of overriding not in Ada 2005 mode
4205
4206             if Token_Name = Name_Overriding
4207               and then not Next_Token_Is (Tok_Colon)
4208             then
4209                Error_Msg_SC ("overriding indicator is an Ada 2005 extension");
4210                Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
4211
4212                Token := Tok_Overriding;
4213                Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
4214                Done := False;
4215
4216             --  Normal case, no overriding, or overriding followed by colon
4217
4218             else
4219                P_Identifier_Declarations (Decls, Done, In_Spec);
4220             end if;
4221
4222          --  Ada2005: A subprogram declaration can start with "not" or
4223          --  "overriding". In older versions, "overriding" is handled
4224          --  like an identifier, with the appropriate messages.
4225
4226          when Tok_Not =>
4227             Check_Bad_Layout;
4228             Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
4229             Done := False;
4230
4231          when Tok_Overriding =>
4232             Check_Bad_Layout;
4233             Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
4234             Done := False;
4235
4236          when Tok_Package =>
4237             Check_Bad_Layout;
4238             Append (P_Package (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
4239             Done := False;
4240
4241          when Tok_Pragma =>
4242             Append (P_Pragma, Decls);
4243             Done := False;
4244
4245          when Tok_Procedure =>
4246             Check_Bad_Layout;
4247             Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
4248             Done := False;
4249
4250          when Tok_Protected =>
4251             Check_Bad_Layout;
4252             Scan; -- past PROTECTED
4253             Append (P_Protected, Decls);
4254             Done := False;
4255
4256          when Tok_Subtype =>
4257             Check_Bad_Layout;
4258             Append (P_Subtype_Declaration, Decls);
4259             Done := False;
4260
4261          when Tok_Task =>
4262             Check_Bad_Layout;
4263             Scan; -- past TASK
4264             Append (P_Task, Decls);
4265             Done := False;
4266
4267          when Tok_Type =>
4268             Check_Bad_Layout;
4269             Append (P_Type_Declaration, Decls);
4270             Done := False;
4271
4272          when Tok_Use =>
4273             Check_Bad_Layout;
4274             Append (P_Use_Clause, Decls);
4275             Done := False;
4276
4277          when Tok_With =>
4278             Check_Bad_Layout;
4279             Error_Msg_SC ("WITH can only appear in context clause");
4280             raise Error_Resync;
4281
4282          --  BEGIN terminates the scan of a sequence of declarations unless
4283          --  there is a missing subprogram body, see section on handling
4284          --  semicolon in place of IS. We only treat the begin as satisfying
4285          --  the subprogram declaration if it falls in the expected column
4286          --  or to its right.
4287
4288          when Tok_Begin =>
4289             if SIS_Entry_Active and then Start_Column >= SIS_Ecol then
4290
4291                --  Here we have the case where a BEGIN is encountered during
4292                --  declarations in a declarative part, or at the outer level,
4293                --  and there is a subprogram declaration outstanding for which
4294                --  no body has been supplied. This is the case where we assume
4295                --  that the semicolon in the subprogram declaration should
4296                --  really have been is. The active SIS entry describes the
4297                --  subprogram declaration. On return the declaration has been
4298                --  modified to become a body.
4299
4300                declare
4301                   Specification_Node : Node_Id;
4302                   Decl_Node          : Node_Id;
4303                   Body_Node          : Node_Id;
4304
4305                begin
4306                   --  First issue the error message. If we had a missing
4307                   --  semicolon in the declaration, then change the message
4308                   --  to <missing "is">
4309
4310                   if SIS_Missing_Semicolon_Message /= No_Error_Msg then
4311                      Change_Error_Text     -- Replace: "missing "";"" "
4312                        (SIS_Missing_Semicolon_Message, "missing ""is""");
4313
4314                   --  Otherwise we saved the semicolon position, so complain
4315
4316                   else
4317                      Error_Msg -- CODEFIX
4318                        ("|"";"" should be IS", SIS_Semicolon_Sloc);
4319                   end if;
4320
4321                   --  The next job is to fix up any declarations that occurred
4322                   --  between the procedure header and the BEGIN. These got
4323                   --  chained to the outer declarative region (immediately
4324                   --  after the procedure declaration) and they should be
4325                   --  chained to the subprogram itself, which is a body
4326                   --  rather than a spec.
4327
4328                   Specification_Node := Specification (SIS_Declaration_Node);
4329                   Change_Node (SIS_Declaration_Node, N_Subprogram_Body);
4330                   Body_Node := SIS_Declaration_Node;
4331                   Set_Specification (Body_Node, Specification_Node);
4332                   Set_Declarations (Body_Node, New_List);
4333
4334                   loop
4335                      Decl_Node := Remove_Next (Body_Node);
4336                      exit when Decl_Node = Empty;
4337                      Append (Decl_Node, Declarations (Body_Node));
4338                   end loop;
4339
4340                   --  Now make the scope table entry for the Begin-End and
4341                   --  scan it out
4342
4343                   Push_Scope_Stack;
4344                   Scope.Table (Scope.Last).Sloc := SIS_Sloc;
4345                   Scope.Table (Scope.Last).Etyp := E_Name;
4346                   Scope.Table (Scope.Last).Ecol := SIS_Ecol;
4347                   Scope.Table (Scope.Last).Labl := SIS_Labl;
4348                   Scope.Table (Scope.Last).Lreq := False;
4349                   SIS_Entry_Active := False;
4350                   Scan; -- past BEGIN
4351                   Set_Handled_Statement_Sequence (Body_Node,
4352                     P_Handled_Sequence_Of_Statements);
4353                   End_Statements (Handled_Statement_Sequence (Body_Node));
4354                end;
4355
4356                Done := False;
4357
4358             else
4359                Done := True;
4360             end if;
4361
4362          --  Normally an END terminates the scan for basic declarative items.
4363          --  The one exception is END RECORD, which is probably left over from
4364          --  some other junk.
4365
4366          when Tok_End =>
4367             Save_Scan_State (Scan_State); -- at END
4368             Scan; -- past END
4369
4370             if Token = Tok_Record then
4371                Error_Msg_SP ("no RECORD for this `end record`!");
4372                Scan; -- past RECORD
4373                TF_Semicolon;
4374
4375             else
4376                Restore_Scan_State (Scan_State); -- to END
4377                Done := True;
4378             end if;
4379
4380          --  The following tokens which can only be the start of a statement
4381          --  are considered to end a declarative part (i.e. we have a missing
4382          --  BEGIN situation). We are fairly conservative in making this
4383          --  judgment, because it is a real mess to go into statement mode
4384          --  prematurely in response to a junk declaration.
4385
4386          when Tok_Abort     |
4387               Tok_Accept    |
4388               Tok_Declare   |
4389               Tok_Delay     |
4390               Tok_Exit      |
4391               Tok_Goto      |
4392               Tok_If        |
4393               Tok_Loop      |
4394               Tok_Null      |
4395               Tok_Requeue   |
4396               Tok_Select    |
4397               Tok_While     =>
4398
4399             --  But before we decide that it's a statement, let's check for
4400             --  a reserved word misused as an identifier.
4401
4402             if Is_Reserved_Identifier then
4403                Save_Scan_State (Scan_State);
4404                Scan; -- past the token
4405
4406                --  If reserved identifier not followed by colon or comma, then
4407                --  this is most likely an assignment statement to the bad id.
4408
4409                if Token /= Tok_Colon and then Token /= Tok_Comma then
4410                   Restore_Scan_State (Scan_State);
4411                   Statement_When_Declaration_Expected (Decls, Done, In_Spec);
4412                   return;
4413
4414                --  Otherwise we have a declaration of the bad id
4415
4416                else
4417                   Restore_Scan_State (Scan_State);
4418                   Scan_Reserved_Identifier (Force_Msg => True);
4419                   P_Identifier_Declarations (Decls, Done, In_Spec);
4420                end if;
4421
4422             --  If not reserved identifier, then it's definitely a statement
4423
4424             else
4425                Statement_When_Declaration_Expected (Decls, Done, In_Spec);
4426                return;
4427             end if;
4428
4429          --  The token RETURN may well also signal a missing BEGIN situation,
4430          --  however, we never let it end the declarative part, because it may
4431          --  also be part of a half-baked function declaration.
4432
4433          when Tok_Return =>
4434             Error_Msg_SC ("misplaced RETURN statement");
4435             raise Error_Resync;
4436
4437          --  PRIVATE definitely terminates the declarations in a spec,
4438          --  and is an error in a body.
4439
4440          when Tok_Private =>
4441             if In_Spec then
4442                Done := True;
4443             else
4444                Error_Msg_SC ("PRIVATE not allowed in body");
4445                Scan; -- past PRIVATE
4446             end if;
4447
4448          --  An end of file definitely terminates the declarations!
4449
4450          when Tok_EOF =>
4451             Done := True;
4452
4453          --  The remaining tokens do not end the scan, but cannot start a
4454          --  valid declaration, so we signal an error and resynchronize.
4455          --  But first check for misuse of a reserved identifier.
4456
4457          when others =>
4458
4459             --  Here we check for a reserved identifier
4460
4461             if Is_Reserved_Identifier then
4462                Save_Scan_State (Scan_State);
4463                Scan; -- past the token
4464
4465                if Token /= Tok_Colon and then Token /= Tok_Comma then
4466                   Restore_Scan_State (Scan_State);
4467                   Set_Declaration_Expected;
4468                   raise Error_Resync;
4469                else
4470                   Restore_Scan_State (Scan_State);
4471                   Scan_Reserved_Identifier (Force_Msg => True);
4472                   Check_Bad_Layout;
4473                   P_Identifier_Declarations (Decls, Done, In_Spec);
4474                end if;
4475
4476             else
4477                Set_Declaration_Expected;
4478                raise Error_Resync;
4479             end if;
4480       end case;
4481
4482    --  To resynchronize after an error, we scan to the next semicolon and
4483    --  return with Done = False, indicating that there may still be more
4484    --  valid declarations to come.
4485
4486    exception
4487       when Error_Resync =>
4488          Resync_Past_Semicolon;
4489          Done := False;
4490    end P_Declarative_Items;
4491
4492    ----------------------------------
4493    -- 3.11  Basic Declarative Item --
4494    ----------------------------------
4495
4496    --  BASIC_DECLARATIVE_ITEM ::=
4497    --    BASIC_DECLARATION | REPRESENTATION_CLAUSE | USE_CLAUSE
4498
4499    --  Scan zero or more basic declarative items
4500
4501    --  Error recovery: cannot raise Error_Resync. If an error is detected, then
4502    --  the scan pointer is repositioned past the next semicolon, and the scan
4503    --  for declarative items continues.
4504
4505    function P_Basic_Declarative_Items return List_Id is
4506       Decl  : Node_Id;
4507       Decls : List_Id;
4508       Kind  : Node_Kind;
4509       Done  : Boolean;
4510
4511    begin
4512       --  Indicate no bad declarations detected yet in the current context:
4513       --  visible or private declarations of a package spec.
4514
4515       Missing_Begin_Msg := No_Error_Msg;
4516
4517       --  Get rid of active SIS entry from outer scope. This means we will
4518       --  miss some nested cases, but it doesn't seem worth the effort. See
4519       --  discussion in Par for further details
4520
4521       SIS_Entry_Active := False;
4522
4523       --  Loop to scan out declarations
4524
4525       Decls := New_List;
4526
4527       loop
4528          P_Declarative_Items (Decls, Done, In_Spec => True);
4529          exit when Done;
4530       end loop;
4531
4532       --  Get rid of active SIS entry. This is set only if we have scanned a
4533       --  procedure declaration and have not found the body. We could give
4534       --  an error message, but that really would be usurping the role of
4535       --  semantic analysis (this really is a case of a missing body).
4536
4537       SIS_Entry_Active := False;
4538
4539       --  Test for assorted illegal declarations not diagnosed elsewhere
4540
4541       Decl := First (Decls);
4542
4543       while Present (Decl) loop
4544          Kind := Nkind (Decl);
4545
4546          --  Test for body scanned, not acceptable as basic decl item
4547
4548          if Kind = N_Subprogram_Body or else
4549             Kind = N_Package_Body or else
4550             Kind = N_Task_Body or else
4551             Kind = N_Protected_Body
4552          then
4553             Error_Msg ("proper body not allowed in package spec", Sloc (Decl));
4554
4555          --  Test for body stub scanned, not acceptable as basic decl item
4556
4557          elsif Kind in N_Body_Stub then
4558             Error_Msg ("body stub not allowed in package spec", Sloc (Decl));
4559
4560          elsif Kind = N_Assignment_Statement then
4561             Error_Msg
4562               ("assignment statement not allowed in package spec",
4563                  Sloc (Decl));
4564          end if;
4565
4566          Next (Decl);
4567       end loop;
4568
4569       return Decls;
4570    end P_Basic_Declarative_Items;
4571
4572    ----------------
4573    -- 3.11  Body --
4574    ----------------
4575
4576    --  For proper body, see below
4577    --  For body stub, see 10.1.3
4578
4579    -----------------------
4580    -- 3.11  Proper Body --
4581    -----------------------
4582
4583    --  Subprogram body is parsed by P_Subprogram (6.1)
4584    --  Package body is parsed by P_Package (7.1)
4585    --  Task body is parsed by P_Task (9.1)
4586    --  Protected body is parsed by P_Protected (9.4)
4587
4588    ------------------------------
4589    -- Set_Declaration_Expected --
4590    ------------------------------
4591
4592    procedure Set_Declaration_Expected is
4593    begin
4594       Error_Msg_SC ("declaration expected");
4595
4596       if Missing_Begin_Msg = No_Error_Msg then
4597          Missing_Begin_Msg := Get_Msg_Id;
4598       end if;
4599    end Set_Declaration_Expected;
4600
4601    ----------------------
4602    -- Skip_Declaration --
4603    ----------------------
4604
4605    procedure Skip_Declaration (S : List_Id) is
4606       Dummy_Done : Boolean;
4607       pragma Warnings (Off, Dummy_Done);
4608    begin
4609       P_Declarative_Items (S, Dummy_Done, False);
4610    end Skip_Declaration;
4611
4612    -----------------------------------------
4613    -- Statement_When_Declaration_Expected --
4614    -----------------------------------------
4615
4616    procedure Statement_When_Declaration_Expected
4617      (Decls   : List_Id;
4618       Done    : out Boolean;
4619       In_Spec : Boolean)
4620    is
4621    begin
4622       --  Case of second occurrence of statement in one declaration sequence
4623
4624       if Missing_Begin_Msg /= No_Error_Msg then
4625
4626          --  In the procedure spec case, just ignore it, we only give one
4627          --  message for the first occurrence, since otherwise we may get
4628          --  horrible cascading if BODY was missing in the header line.
4629
4630          if In_Spec then
4631             null;
4632
4633          --  In the declarative part case, take a second statement as a sure
4634          --  sign that we really have a missing BEGIN, and end the declarative
4635          --  part now. Note that the caller will fix up the first message to
4636          --  say "missing BEGIN" so that's how the error will be signalled.
4637
4638          else
4639             Done := True;
4640             return;
4641          end if;
4642
4643       --  Case of first occurrence of unexpected statement
4644
4645       else
4646          --  If we are in a package spec, then give message of statement
4647          --  not allowed in package spec. This message never gets changed.
4648
4649          if In_Spec then
4650             Error_Msg_SC ("statement not allowed in package spec");
4651
4652          --  If in declarative part, then we give the message complaining
4653          --  about finding a statement when a declaration is expected. This
4654          --  gets changed to a complaint about a missing BEGIN if we later
4655          --  find that no BEGIN is present.
4656
4657          else
4658             Error_Msg_SC ("statement not allowed in declarative part");
4659          end if;
4660
4661          --  Capture message Id. This is used for two purposes, first to
4662          --  stop multiple messages, see test above, and second, to allow
4663          --  the replacement of the message in the declarative part case.
4664
4665          Missing_Begin_Msg := Get_Msg_Id;
4666       end if;
4667
4668       --  In all cases except the case in which we decided to terminate the
4669       --  declaration sequence on a second error, we scan out the statement
4670       --  and append it to the list of declarations (note that the semantics
4671       --  can handle statements in a declaration list so if we proceed to
4672       --  call the semantic phase, all will be (reasonably) well!
4673
4674       Append_List_To (Decls, P_Sequence_Of_Statements (SS_Unco));
4675
4676       --  Done is set to False, since we want to continue the scan of
4677       --  declarations, hoping that this statement was a temporary glitch.
4678       --  If we indeed are now in the statement part (i.e. this was a missing
4679       --  BEGIN, then it's not terrible, we will simply keep calling this
4680       --  procedure to process the statements one by one, and then finally
4681       --  hit the missing BEGIN, which will clean up the error message.
4682
4683       Done := False;
4684    end Statement_When_Declaration_Expected;
4685
4686 end Ch3;