gcc/ada/par-ch13.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P A R . C H 1 3                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2012, 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 separate (Par)
  31 package body Ch13 is
  32
  33    --  Local functions, used only in this chapter
  34
  35    function P_Component_Clause return Node_Id;
  36    function P_Mod_Clause return Node_Id;
  37
  38    -----------------------------------
  39    -- Aspect_Specifications_Present --
  40    -----------------------------------
  41
  42    function Aspect_Specifications_Present
  43      (Strict : Boolean := Ada_Version < Ada_2012) return Boolean
  44    is
  45       Scan_State : Saved_Scan_State;
  46       Result     : Boolean;
  47
  48    begin
  49       --  Definitely must have WITH to consider aspect specs to be present
  50
  51       --  Note that this means that if we have a semicolon, we immediately
  52       --  return False. There is a case in which this is not optimal, namely
  53       --  something like
  54
  55       --    type R is new Integer;
  56       --      with bla bla;
  57
  58       --  where the semicolon is redundant, but scanning forward for it would
  59       --  be too expensive. Instead we pick up the aspect specifications later
  60       --  as a bogus declaration, and diagnose the semicolon at that point.
  61
  62       if Token /= Tok_With then
  63          return False;
  64       end if;
  65
  66       --  Have a WITH, see if it looks like an aspect specification
  67
  68       Save_Scan_State (Scan_State);
  69       Scan; -- past WITH
  70
  71       --  If no identifier, then consider that we definitely do not have an
  72       --  aspect specification.
  73
  74       if Token /= Tok_Identifier then
  75          Result := False;
  76
  77       --  This is where we pay attention to the Strict mode. Normally when we
  78       --  are in Ada 2012 mode, Strict is False, and we consider that we have
  79       --  an aspect specification if the identifier is an aspect name (even if
  80       --  not followed by =>) or the identifier is not an aspect name but is
  81       --  followed by =>. P_Aspect_Specifications will generate messages if the
  82       --  aspect specification is ill-formed.
  83
  84       elsif not Strict then
  85          if Get_Aspect_Id (Token_Name) /= No_Aspect then
  86             Result := True;
  87          else
  88             Scan; -- past identifier
  89             Result := Token = Tok_Arrow;
  90          end if;
  91
  92       --  If earlier than Ada 2012, check for valid aspect identifier (possibly
  93       --  completed with 'CLASS) followed by an arrow, and consider that this
  94       --  is still an aspect specification so we give an appropriate message.
  95
  96       else
  97          if Get_Aspect_Id (Token_Name) = No_Aspect then
  98             Result := False;
  99
 100          else
 101             Scan; -- past aspect name
 102
 103             Result := False;
 104
 105             if Token = Tok_Arrow then
 106                Result := True;
 107
 108             --  The identifier may be the name of a boolean aspect with a
 109             --  defaulted True value. Further checks when analyzing aspect
 110             --  specification.
 111
 112             elsif Token = Tok_Comma then
 113                Result := True;
 114
 115             elsif Token = Tok_Apostrophe then
 116                Scan; -- past apostrophe
 117
 118                if Token = Tok_Identifier
 119                  and then Token_Name = Name_Class
 120                then
 121                   Scan; -- past CLASS
 122
 123                   if Token = Tok_Arrow then
 124                      Result := True;
 125                   end if;
 126                end if;
 127             end if;
 128
 129             if Result then
 130                Restore_Scan_State (Scan_State);
 131                Error_Msg_SC ("|aspect specification is an Ada 2012 feature");
 132                Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
 133                return True;
 134             end if;
 135          end if;
 136       end if;
 137
 138       Restore_Scan_State (Scan_State);
 139       return Result;
 140    end Aspect_Specifications_Present;
 141
 142    -------------------------------
 143    -- Get_Aspect_Specifications --
 144    -------------------------------
 145
 146    function Get_Aspect_Specifications
 147      (Semicolon : Boolean := True) return List_Id
 148    is
 149       Aspects : List_Id;
 150       Aspect  : Node_Id;
 151       A_Id    : Aspect_Id;
 152       OK      : Boolean;
 153
 154    begin
 155       Aspects := Empty_List;
 156
 157       --  Check if aspect specification present
 158
 159       if not Aspect_Specifications_Present then
 160          if Semicolon then
 161             TF_Semicolon;
 162          end if;
 163
 164          return Aspects;
 165       end if;
 166
 167       Scan; -- past WITH
 168       Aspects := Empty_List;
 169
 170       loop
 171          OK := True;
 172
 173          if Token /= Tok_Identifier then
 174             Error_Msg_SC ("aspect identifier expected");
 175
 176             if Semicolon then
 177                Resync_Past_Semicolon;
 178             end if;
 179
 180             return Aspects;
 181          end if;
 182
 183          --  We have an identifier (which should be an aspect identifier)
 184
 185          A_Id := Get_Aspect_Id (Token_Name);
 186          Aspect :=
 187            Make_Aspect_Specification (Token_Ptr,
 188              Identifier => Token_Node);
 189
 190          --  No valid aspect identifier present
 191
 192          if A_Id = No_Aspect then
 193             Error_Msg_SC ("aspect identifier expected");
 194
 195             --  Check bad spelling
 196
 197             for J in Aspect_Id_Exclude_No_Aspect loop
 198                if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
 199                   Error_Msg_Name_1 := Aspect_Names (J);
 200                   Error_Msg_SC -- CODEFIX
 201                     ("\possible misspelling of%");
 202                   exit;
 203                end if;
 204             end loop;
 205
 206             Scan; -- past incorrect identifier
 207
 208             if Token = Tok_Apostrophe then
 209                Scan; -- past '
 210                Scan; -- past presumably CLASS
 211             end if;
 212
 213             if Token = Tok_Arrow then
 214                Scan; -- Past arrow
 215                Set_Expression (Aspect, P_Expression);
 216                OK := False;
 217
 218             elsif Token = Tok_Comma then
 219                OK := False;
 220
 221             else
 222                if Semicolon then
 223                   Resync_Past_Semicolon;
 224                end if;
 225
 226                return Aspects;
 227             end if;
 228
 229          --  OK aspect scanned
 230
 231          else
 232             Scan; -- past identifier
 233
 234             --  Check for 'Class present
 235
 236             if Token = Tok_Apostrophe then
 237                if not Class_Aspect_OK (A_Id) then
 238                   Error_Msg_Node_1 := Identifier (Aspect);
 239                   Error_Msg_SC ("aspect& does not permit attribute here");
 240                   Scan; -- past apostrophe
 241                   Scan; -- past presumed CLASS
 242                   OK := False;
 243
 244                else
 245                   Scan; -- past apostrophe
 246
 247                   if Token /= Tok_Identifier
 248                     or else Token_Name /= Name_Class
 249                   then
 250                      Error_Msg_SC ("Class attribute expected here");
 251                      OK := False;
 252
 253                      if Token = Tok_Identifier then
 254                         Scan; -- past identifier not CLASS
 255                      end if;
 256
 257                   else
 258                      Scan; -- past CLASS
 259                      Set_Class_Present (Aspect);
 260                   end if;
 261                end if;
 262             end if;
 263
 264             --  Test case of missing aspect definition
 265
 266             if Token = Tok_Comma
 267               or else Token = Tok_Semicolon
 268             then
 269                if Aspect_Argument (A_Id) /= Optional then
 270                   Error_Msg_Node_1 := Identifier (Aspect);
 271                   Error_Msg_AP ("aspect& requires an aspect definition");
 272                   OK := False;
 273                end if;
 274
 275             elsif not Semicolon and then Token /= Tok_Arrow then
 276                if Aspect_Argument (A_Id) /= Optional then
 277
 278                   --  The name or expression may be there, but the arrow is
 279                   --  missing. Skip to the end of the declaration.
 280
 281                   T_Arrow;
 282                   Resync_To_Semicolon;
 283                end if;
 284
 285             --  Here we have an aspect definition
 286
 287             else
 288                if Token = Tok_Arrow then
 289                   Scan; -- past arrow
 290                else
 291                   T_Arrow;
 292                   OK := False;
 293                end if;
 294
 295                if Aspect_Argument (A_Id) = Name then
 296                   Set_Expression (Aspect, P_Name);
 297                else
 298                   Set_Expression (Aspect, P_Expression);
 299                end if;
 300             end if;
 301
 302             --  If OK clause scanned, add it to the list
 303
 304             if OK then
 305                Append (Aspect, Aspects);
 306             end if;
 307
 308             if Token = Tok_Comma then
 309                Scan; -- past comma
 310                goto Continue;
 311
 312             --  Recognize the case where a comma is missing between two
 313             --  aspects, issue an error and proceed with next aspect.
 314
 315             elsif Token = Tok_Identifier
 316               and then Get_Aspect_Id (Token_Name) /= No_Aspect
 317             then
 318                declare
 319                   Scan_State : Saved_Scan_State;
 320
 321                begin
 322                   Save_Scan_State (Scan_State);
 323                   Scan; -- past identifier
 324
 325                   if Token = Tok_Arrow then
 326                      Restore_Scan_State (Scan_State);
 327                      Error_Msg_AP -- CODEFIX
 328                        ("|missing "",""");
 329                      goto Continue;
 330
 331                   else
 332                      Restore_Scan_State (Scan_State);
 333                   end if;
 334                end;
 335
 336             --  Recognize the case where a semicolon was mistyped for a comma
 337             --  between two aspects, issue an error and proceed with next
 338             --  aspect.
 339
 340             elsif Token = Tok_Semicolon then
 341                declare
 342                   Scan_State : Saved_Scan_State;
 343
 344                begin
 345                   Save_Scan_State (Scan_State);
 346                   Scan; -- past semicolon
 347
 348                   if Token = Tok_Identifier
 349                     and then Get_Aspect_Id (Token_Name) /= No_Aspect
 350                   then
 351                      Scan; -- past identifier
 352
 353                      if Token = Tok_Arrow then
 354                         Restore_Scan_State (Scan_State);
 355                         Error_Msg_SC -- CODEFIX
 356                           ("|"";"" should be "",""");
 357                         Scan; -- past semicolon
 358                         goto Continue;
 359
 360                      else
 361                         Restore_Scan_State (Scan_State);
 362                      end if;
 363
 364                   else
 365                      Restore_Scan_State (Scan_State);
 366                   end if;
 367                end;
 368             end if;
 369
 370             --  Must be terminator character
 371
 372             if Semicolon then
 373                T_Semicolon;
 374             end if;
 375
 376             exit;
 377
 378          <<Continue>>
 379             null;
 380          end if;
 381       end loop;
 382
 383       return Aspects;
 384
 385    end Get_Aspect_Specifications;
 386
 387    --------------------------------------------
 388    -- 13.1  Representation Clause (also I.7) --
 389    --------------------------------------------
 390
 391    --  REPRESENTATION_CLAUSE ::=
 392    --    ATTRIBUTE_DEFINITION_CLAUSE
 393    --  | ENUMERATION_REPRESENTATION_CLAUSE
 394    --  | RECORD_REPRESENTATION_CLAUSE
 395    --  | AT_CLAUSE
 396
 397    --  ATTRIBUTE_DEFINITION_CLAUSE ::=
 398    --    for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
 399    --  | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
 400
 401    --  Note: in Ada 83, the expression must be a simple expression
 402
 403    --  AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
 404
 405    --  Note: in Ada 83, the expression must be a simple expression
 406
 407    --  ENUMERATION_REPRESENTATION_CLAUSE ::=
 408    --    for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
 409
 410    --  ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
 411
 412    --  RECORD_REPRESENTATION_CLAUSE ::=
 413    --    for first_subtype_LOCAL_NAME use
 414    --      record [MOD_CLAUSE]
 415    --        {COMPONENT_CLAUSE}
 416    --      end record;
 417
 418    --  Note: for now we allow only a direct name as the local name in the
 419    --  above constructs. This probably needs changing later on ???
 420
 421    --  The caller has checked that the initial token is FOR
 422
 423    --  Error recovery: cannot raise Error_Resync, if an error occurs,
 424    --  the scan is repositioned past the next semicolon.
 425
 426    function P_Representation_Clause return Node_Id is
 427       For_Loc         : Source_Ptr;
 428       Name_Node       : Node_Id;
 429       Prefix_Node     : Node_Id;
 430       Attr_Name       : Name_Id;
 431       Identifier_Node : Node_Id;
 432       Rep_Clause_Node : Node_Id;
 433       Expr_Node       : Node_Id;
 434       Record_Items    : List_Id;
 435
 436    begin
 437       For_Loc := Token_Ptr;
 438       Scan; -- past FOR
 439
 440       --  Note that the name in a representation clause is always a simple
 441       --  name, even in the attribute case, see AI-300 which made this so!
 442
 443       Identifier_Node := P_Identifier (C_Use);
 444
 445       --  Check case of qualified name to give good error message
 446
 447       if Token = Tok_Dot then
 448          Error_Msg_SC
 449             ("representation clause requires simple name!");
 450
 451          loop
 452             exit when Token /= Tok_Dot;
 453             Scan; -- past dot
 454             Discard_Junk_Node (P_Identifier);
 455          end loop;
 456       end if;
 457
 458       --  Attribute Definition Clause
 459
 460       if Token = Tok_Apostrophe then
 461
 462          --  Allow local names of the form a'b'.... This enables
 463          --  us to parse class-wide streams attributes correctly.
 464
 465          Name_Node := Identifier_Node;
 466          while Token = Tok_Apostrophe loop
 467
 468             Scan; -- past apostrophe
 469
 470             Identifier_Node := Token_Node;
 471             Attr_Name := No_Name;
 472
 473             if Token = Tok_Identifier then
 474                Attr_Name := Token_Name;
 475
 476                --  Note that the parser must complain in case of an internal
 477                --  attribute name that comes from source since internal names
 478                --  are meant to be used only by the compiler.
 479
 480                if not Is_Attribute_Name (Attr_Name)
 481                  and then (not Is_Internal_Attribute_Name (Attr_Name)
 482                             or else Comes_From_Source (Token_Node))
 483                then
 484                   Signal_Bad_Attribute;
 485                end if;
 486
 487                if Style_Check then
 488                   Style.Check_Attribute_Name (False);
 489                end if;
 490
 491             --  Here for case of attribute designator is not an identifier
 492
 493             else
 494                if Token = Tok_Delta then
 495                   Attr_Name := Name_Delta;
 496
 497                elsif Token = Tok_Digits then
 498                   Attr_Name := Name_Digits;
 499
 500                elsif Token = Tok_Access then
 501                   Attr_Name := Name_Access;
 502
 503                else
 504                   Error_Msg_AP ("attribute designator expected");
 505                   raise Error_Resync;
 506                end if;
 507
 508                if Style_Check then
 509                   Style.Check_Attribute_Name (True);
 510                end if;
 511             end if;
 512
 513             --  We come here with an OK attribute scanned, and the
 514             --  corresponding Attribute identifier node stored in Ident_Node.
 515
 516             Prefix_Node := Name_Node;
 517             Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
 518             Set_Prefix (Name_Node, Prefix_Node);
 519             Set_Attribute_Name (Name_Node, Attr_Name);
 520             Scan;
 521          end loop;
 522
 523          Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
 524          Set_Name (Rep_Clause_Node, Prefix_Node);
 525          Set_Chars (Rep_Clause_Node, Attr_Name);
 526          T_Use;
 527
 528          Expr_Node := P_Expression_No_Right_Paren;
 529          Check_Simple_Expression_In_Ada_83 (Expr_Node);
 530          Set_Expression (Rep_Clause_Node, Expr_Node);
 531
 532       else
 533          TF_Use;
 534          Rep_Clause_Node := Empty;
 535
 536          --  AT follows USE (At Clause)
 537
 538          if Token = Tok_At then
 539             Scan; -- past AT
 540             Rep_Clause_Node := New_Node (N_At_Clause, For_Loc);
 541             Set_Identifier (Rep_Clause_Node, Identifier_Node);
 542             Expr_Node := P_Expression_No_Right_Paren;
 543             Check_Simple_Expression_In_Ada_83 (Expr_Node);
 544             Set_Expression (Rep_Clause_Node, Expr_Node);
 545
 546          --  RECORD follows USE (Record Representation Clause)
 547
 548          elsif Token = Tok_Record then
 549             Record_Items := P_Pragmas_Opt;
 550             Rep_Clause_Node :=
 551               New_Node (N_Record_Representation_Clause, For_Loc);
 552             Set_Identifier (Rep_Clause_Node, Identifier_Node);
 553
 554             Push_Scope_Stack;
 555             Scope.Table (Scope.Last).Etyp := E_Record;
 556             Scope.Table (Scope.Last).Ecol := Start_Column;
 557             Scope.Table (Scope.Last).Sloc := Token_Ptr;
 558             Scan; -- past RECORD
 559             Record_Items := P_Pragmas_Opt;
 560
 561             --  Possible Mod Clause
 562
 563             if Token = Tok_At then
 564                Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause);
 565                Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items);
 566                Record_Items := P_Pragmas_Opt;
 567             end if;
 568
 569             if No (Record_Items) then
 570                Record_Items := New_List;
 571             end if;
 572
 573             Set_Component_Clauses (Rep_Clause_Node, Record_Items);
 574
 575             --  Loop through component clauses
 576
 577             loop
 578                if Token not in Token_Class_Name then
 579                   exit when Check_End;
 580                end if;
 581
 582                Append (P_Component_Clause, Record_Items);
 583                P_Pragmas_Opt (Record_Items);
 584             end loop;
 585
 586          --  Left paren follows USE (Enumeration Representation Clause)
 587
 588          elsif Token = Tok_Left_Paren then
 589             Rep_Clause_Node :=
 590               New_Node (N_Enumeration_Representation_Clause, For_Loc);
 591             Set_Identifier (Rep_Clause_Node, Identifier_Node);
 592             Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate);
 593
 594          --  Some other token follows FOR (invalid representation clause)
 595
 596          else
 597             Error_Msg_SC ("invalid representation clause");
 598             raise Error_Resync;
 599          end if;
 600       end if;
 601
 602       TF_Semicolon;
 603       return Rep_Clause_Node;
 604
 605    exception
 606       when Error_Resync =>
 607          Resync_Past_Semicolon;
 608          return Error;
 609
 610    end P_Representation_Clause;
 611
 612    ----------------------
 613    -- 13.1  Local Name --
 614    ----------------------
 615
 616    --  Local name is always parsed by its parent. In the case of its use in
 617    --  pragmas, the check for a local name is handled in Par.Prag and allows
 618    --  all the possible forms of local name. For the uses in chapter 13, we
 619    --  currently only allow a direct name, but this should probably change???
 620
 621    ---------------------------
 622    -- 13.1  At Clause (I.7) --
 623    ---------------------------
 624
 625    --  Parsed by P_Representation_Clause (13.1)
 626
 627    ---------------------------------------
 628    -- 13.3  Attribute Definition Clause --
 629    ---------------------------------------
 630
 631    --  Parsed by P_Representation_Clause (13.1)
 632
 633    --------------------------------
 634    -- 13.1  Aspect Specification --
 635    --------------------------------
 636
 637    --  ASPECT_SPECIFICATION ::=
 638    --    with ASPECT_MARK [=> ASPECT_DEFINITION] {,
 639    --         ASPECT_MARK [=> ASPECT_DEFINITION] }
 640
 641    --  ASPECT_MARK ::= aspect_IDENTIFIER['Class]
 642
 643    --  ASPECT_DEFINITION ::= NAME | EXPRESSION
 644
 645    --  Error recovery: cannot raise Error_Resync
 646
 647    procedure P_Aspect_Specifications
 648      (Decl      : Node_Id;
 649       Semicolon : Boolean := True)
 650    is
 651       Aspects : List_Id;
 652       Ptr     : Source_Ptr;
 653
 654    begin
 655       --  Aspect Specification is present
 656
 657       Ptr := Token_Ptr;
 658
 659       --  Here we have an aspect specification to scan, note that we don't
 660       --  set the flag till later, because it may turn out that we have no
 661       --  valid aspects in the list.
 662
 663       Aspects := Get_Aspect_Specifications (Semicolon);
 664
 665       --  Here if aspects present
 666
 667       if Is_Non_Empty_List (Aspects) then
 668
 669          --  If Decl is Empty, we just ignore the aspects (the caller in this
 670          --  case has always issued an appropriate error message).
 671
 672          if Decl = Empty then
 673             null;
 674
 675          --  If Decl is Error, we ignore the aspects, and issue a message
 676
 677          elsif Decl = Error then
 678             Error_Msg ("aspect specifications not allowed here", Ptr);
 679
 680          --  Here aspects are allowed, and we store them
 681
 682          else
 683             Set_Parent (Aspects, Decl);
 684             Set_Aspect_Specifications (Decl, Aspects);
 685          end if;
 686       end if;
 687    end P_Aspect_Specifications;
 688
 689    ---------------------------------------------
 690    -- 13.4  Enumeration Representation Clause --
 691    ---------------------------------------------
 692
 693    --  Parsed by P_Representation_Clause (13.1)
 694
 695    ---------------------------------
 696    -- 13.4  Enumeration Aggregate --
 697    ---------------------------------
 698
 699    --  Parsed by P_Representation_Clause (13.1)
 700
 701    ------------------------------------------
 702    -- 13.5.1  Record Representation Clause --
 703    ------------------------------------------
 704
 705    --  Parsed by P_Representation_Clause (13.1)
 706
 707    ------------------------------
 708    -- 13.5.1  Mod Clause (I.8) --
 709    ------------------------------
 710
 711    --  MOD_CLAUSE ::= at mod static_EXPRESSION;
 712
 713    --  Note: in Ada 83, the expression must be a simple expression
 714
 715    --  The caller has checked that the initial Token is AT
 716
 717    --  Error recovery: cannot raise Error_Resync
 718
 719    --  Note: the caller is responsible for setting the Pragmas_Before field
 720
 721    function P_Mod_Clause return Node_Id is
 722       Mod_Node  : Node_Id;
 723       Expr_Node : Node_Id;
 724
 725    begin
 726       Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
 727       Scan; -- past AT
 728       T_Mod;
 729       Expr_Node := P_Expression_No_Right_Paren;
 730       Check_Simple_Expression_In_Ada_83 (Expr_Node);
 731       Set_Expression (Mod_Node, Expr_Node);
 732       TF_Semicolon;
 733       return Mod_Node;
 734    end P_Mod_Clause;
 735
 736    ------------------------------
 737    -- 13.5.1  Component Clause --
 738    ------------------------------
 739
 740    --  COMPONENT_CLAUSE ::=
 741    --    COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
 742    --      range FIRST_BIT .. LAST_BIT;
 743
 744    --  COMPONENT_CLAUSE_COMPONENT_NAME ::=
 745    --    component_DIRECT_NAME
 746    --  | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
 747    --  | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
 748
 749    --  POSITION ::= static_EXPRESSION
 750
 751    --  Note: in Ada 83, the expression must be a simple expression
 752
 753    --  FIRST_BIT ::= static_SIMPLE_EXPRESSION
 754    --  LAST_BIT ::= static_SIMPLE_EXPRESSION
 755
 756    --  Note: the AARM V2.0 grammar has an error at this point, it uses
 757    --  EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
 758
 759    --  Error recovery: cannot raise Error_Resync
 760
 761    function P_Component_Clause return Node_Id is
 762       Component_Node : Node_Id;
 763       Comp_Name      : Node_Id;
 764       Expr_Node      : Node_Id;
 765
 766    begin
 767       Component_Node := New_Node (N_Component_Clause, Token_Ptr);
 768       Comp_Name := P_Name;
 769
 770       if Nkind (Comp_Name) = N_Identifier
 771         or else Nkind (Comp_Name) = N_Attribute_Reference
 772       then
 773          Set_Component_Name (Component_Node, Comp_Name);
 774       else
 775          Error_Msg_N
 776            ("component name must be direct name or attribute", Comp_Name);
 777          Set_Component_Name (Component_Node, Error);
 778       end if;
 779
 780       Set_Sloc (Component_Node, Token_Ptr);
 781       T_At;
 782       Expr_Node := P_Expression_No_Right_Paren;
 783       Check_Simple_Expression_In_Ada_83 (Expr_Node);
 784       Set_Position (Component_Node, Expr_Node);
 785       T_Range;
 786       Expr_Node := P_Expression_No_Right_Paren;
 787       Check_Simple_Expression_In_Ada_83 (Expr_Node);
 788       Set_First_Bit (Component_Node, Expr_Node);
 789       T_Dot_Dot;
 790       Expr_Node := P_Expression_No_Right_Paren;
 791       Check_Simple_Expression_In_Ada_83 (Expr_Node);
 792       Set_Last_Bit (Component_Node, Expr_Node);
 793       TF_Semicolon;
 794       return Component_Node;
 795    end P_Component_Clause;
 796
 797    ----------------------
 798    -- 13.5.1  Position --
 799    ----------------------
 800
 801    --  Parsed by P_Component_Clause (13.5.1)
 802
 803    -----------------------
 804    -- 13.5.1  First Bit --
 805    -----------------------
 806
 807    --  Parsed by P_Component_Clause (13.5.1)
 808
 809    ----------------------
 810    -- 13.5.1  Last Bit --
 811    ----------------------
 812
 813    --  Parsed by P_Component_Clause (13.5.1)
 814
 815    --------------------------
 816    -- 13.8  Code Statement --
 817    --------------------------
 818
 819    --  CODE_STATEMENT ::= QUALIFIED_EXPRESSION
 820
 821    --  On entry the caller has scanned the SUBTYPE_MARK (passed in as the
 822    --  single argument, and the scan points to the apostrophe.
 823
 824    --  Error recovery: can raise Error_Resync
 825
 826    function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
 827       Node1 : Node_Id;
 828
 829    begin
 830       Scan; -- past apostrophe
 831
 832       --  If left paren, then we have a possible code statement
 833
 834       if Token = Tok_Left_Paren then
 835          Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark));
 836          Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark));
 837          TF_Semicolon;
 838          return Node1;
 839
 840       --  Otherwise we have an illegal range attribute. Note that P_Name
 841       --  ensures that Token = Tok_Range is the only possibility left here.
 842
 843       else
 844          Error_Msg_SC ("RANGE attribute illegal here!");
 845          raise Error_Resync;
 846       end if;
 847    end P_Code_Statement;
 848
 849 end Ch13;