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