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-2013, 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 26pragma Style_Checks (All_Checks); 27-- Turn off subprogram body ordering check. Subprograms are in order 28-- by RM section rather than alphabetical 29 30separate (Par) 31package 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 =>, by a comma, or by a semicolon. The last two cases 82 -- correspond to (misspelled) Boolean aspects with a defaulted value of 83 -- True. P_Aspect_Specifications will generate messages if the aspect 84 -- specification is ill-formed. 85 86 elsif not Strict then 87 if Get_Aspect_Id (Token_Name) /= No_Aspect then 88 Result := True; 89 else 90 Scan; -- past identifier 91 Result := Token = Tok_Arrow or else 92 Token = Tok_Comma or else 93 Token = Tok_Semicolon; 94 end if; 95 96 -- If earlier than Ada 2012, check for valid aspect identifier (possibly 97 -- completed with 'CLASS) followed by an arrow, and consider that this 98 -- is still an aspect specification so we give an appropriate message. 99 100 else 101 if Get_Aspect_Id (Token_Name) = No_Aspect then 102 Result := False; 103 104 else 105 Scan; -- past aspect name 106 107 Result := False; 108 109 if Token = Tok_Arrow then 110 Result := True; 111 112 -- The identifier may be the name of a boolean aspect with a 113 -- defaulted True value. Further checks when analyzing aspect 114 -- specification, which may include further aspects. 115 116 elsif Token = Tok_Comma or else Token = Tok_Semicolon then 117 Result := True; 118 119 elsif Token = Tok_Apostrophe then 120 Scan; -- past apostrophe 121 122 if Token = Tok_Identifier 123 and then Token_Name = Name_Class 124 then 125 Scan; -- past CLASS 126 127 if Token = Tok_Arrow then 128 Result := True; 129 end if; 130 end if; 131 end if; 132 133 if Result then 134 Restore_Scan_State (Scan_State); 135 Error_Msg_Ada_2012_Feature ("|aspect specification", Token_Ptr); 136 return True; 137 end if; 138 end if; 139 end if; 140 141 Restore_Scan_State (Scan_State); 142 return Result; 143 end Aspect_Specifications_Present; 144 145 ------------------------------- 146 -- Get_Aspect_Specifications -- 147 ------------------------------- 148 149 function Get_Aspect_Specifications 150 (Semicolon : Boolean := True) return List_Id 151 is 152 A_Id : Aspect_Id; 153 Aspect : Node_Id; 154 Aspects : List_Id; 155 OK : Boolean; 156 157 begin 158 Aspects := Empty_List; 159 160 -- Check if aspect specification present 161 162 if not Aspect_Specifications_Present then 163 if Semicolon then 164 TF_Semicolon; 165 end if; 166 167 return Aspects; 168 end if; 169 170 Scan; -- past WITH 171 Aspects := Empty_List; 172 173 loop 174 OK := True; 175 176 -- The aspect mark is not an identifier 177 178 if Token /= Tok_Identifier then 179 Error_Msg_SC ("aspect identifier expected"); 180 181 -- Skip the whole aspect specification list 182 183 if Semicolon then 184 Resync_Past_Semicolon; 185 end if; 186 187 return Aspects; 188 end if; 189 190 A_Id := Get_Aspect_Id (Token_Name); 191 Aspect := 192 Make_Aspect_Specification (Token_Ptr, 193 Identifier => Token_Node); 194 195 -- The aspect mark is not recognized 196 197 if A_Id = No_Aspect then 198 Error_Msg_SC ("aspect identifier expected"); 199 OK := False; 200 201 -- Check bad spelling 202 203 for J in Aspect_Id_Exclude_No_Aspect loop 204 if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then 205 Error_Msg_Name_1 := Aspect_Names (J); 206 Error_Msg_SC -- CODEFIX 207 ("\possible misspelling of%"); 208 exit; 209 end if; 210 end loop; 211 212 Scan; -- past incorrect identifier 213 214 if Token = Tok_Apostrophe then 215 Scan; -- past apostrophe 216 Scan; -- past presumably CLASS 217 end if; 218 219 -- Attempt to parse the aspect definition by assuming it is an 220 -- expression. 221 222 if Token = Tok_Arrow then 223 Scan; -- past arrow 224 Set_Expression (Aspect, P_Expression); 225 226 -- The aspect may behave as a boolean aspect 227 228 elsif Token = Tok_Comma then 229 null; 230 231 -- Otherwise the aspect contains a junk definition 232 233 else 234 if Semicolon then 235 Resync_Past_Semicolon; 236 end if; 237 238 return Aspects; 239 end if; 240 241 -- Aspect mark is OK 242 243 else 244 Scan; -- past identifier 245 246 -- Check for 'Class present 247 248 if Token = Tok_Apostrophe then 249 if Class_Aspect_OK (A_Id) then 250 Scan; -- past apostrophe 251 252 if Token = Tok_Identifier 253 and then Token_Name = Name_Class 254 then 255 Scan; -- past CLASS 256 Set_Class_Present (Aspect); 257 else 258 Error_Msg_SC ("Class attribute expected here"); 259 OK := False; 260 261 if Token = Tok_Identifier then 262 Scan; -- past identifier not CLASS 263 end if; 264 end if; 265 266 -- The aspect does not allow 'Class 267 268 else 269 Error_Msg_Node_1 := Identifier (Aspect); 270 Error_Msg_SC ("aspect& does not permit attribute here"); 271 OK := False; 272 273 Scan; -- past apostrophe 274 Scan; -- past presumably CLASS 275 end if; 276 end if; 277 278 -- Check for a missing aspect definition. Aspects with optional 279 -- definitions are not considered. 280 281 if Token = Tok_Comma or else Token = Tok_Semicolon then 282 if Aspect_Argument (A_Id) /= Optional_Expression 283 and then Aspect_Argument (A_Id) /= Optional_Name 284 then 285 Error_Msg_Node_1 := Identifier (Aspect); 286 Error_Msg_AP ("aspect& requires an aspect definition"); 287 OK := False; 288 end if; 289 290 -- Check for a missing arrow when the aspect has a definition 291 292 elsif not Semicolon and then Token /= Tok_Arrow then 293 if Aspect_Argument (A_Id) /= Optional_Expression 294 and then Aspect_Argument (A_Id) /= Optional_Name 295 then 296 T_Arrow; 297 Resync_To_Semicolon; 298 end if; 299 300 -- Otherwise we have an aspect definition 301 302 else 303 if Token = Tok_Arrow then 304 Scan; -- past arrow 305 else 306 T_Arrow; 307 OK := False; 308 end if; 309 310 -- Detect a common error where the non-null definition of 311 -- aspect Depends, Global, Refined_Depends or Refined_Global 312 -- must be enclosed in parentheses. 313 314 if Token /= Tok_Left_Paren and then Token /= Tok_Null then 315 316 -- [Refined_]Depends 317 318 if A_Id = Aspect_Depends 319 or else 320 A_Id = Aspect_Refined_Depends 321 then 322 Error_Msg_SC -- CODEFIX 323 ("missing ""("""); 324 Resync_Past_Malformed_Aspect; 325 326 -- Return when the current aspect is the last in the list 327 -- of specifications and the list applies to a body. 328 329 if Token = Tok_Is then 330 return Aspects; 331 end if; 332 333 -- [Refined_]Global 334 335 elsif A_Id = Aspect_Global 336 or else 337 A_Id = Aspect_Refined_Global 338 then 339 declare 340 Scan_State : Saved_Scan_State; 341 342 begin 343 Save_Scan_State (Scan_State); 344 Scan; -- past item or mode_selector 345 346 -- Emit an error when the aspect has a mode_selector 347 -- as the moded_global_list must be parenthesized: 348 -- with Global => Output => Item 349 350 if Token = Tok_Arrow then 351 Restore_Scan_State (Scan_State); 352 Error_Msg_SC -- CODEFIX 353 ("missing ""("""); 354 Resync_Past_Malformed_Aspect; 355 356 -- Return when the current aspect is the last in 357 -- the list of specifications and the list applies 358 -- to a body. 359 360 if Token = Tok_Is then 361 return Aspects; 362 end if; 363 364 elsif Token = Tok_Comma then 365 Scan; -- past comma 366 367 -- An item followed by a comma does not need to 368 -- be parenthesized if the next token is a valid 369 -- aspect name: 370 -- with Global => Item, 371 -- Aspect => ... 372 373 if Token = Tok_Identifier 374 and then Get_Aspect_Id (Token_Name) /= No_Aspect 375 then 376 Restore_Scan_State (Scan_State); 377 378 -- Otherwise this is a list of items in which case 379 -- the list must be parenthesized. 380 381 else 382 Restore_Scan_State (Scan_State); 383 Error_Msg_SC -- CODEFIX 384 ("missing ""("""); 385 Resync_Past_Malformed_Aspect; 386 387 -- Return when the current aspect is the last 388 -- in the list of specifications and the list 389 -- applies to a body. 390 391 if Token = Tok_Is then 392 return Aspects; 393 end if; 394 end if; 395 396 -- The definition of [Refined_]Global does not need to 397 -- be parenthesized. 398 399 else 400 Restore_Scan_State (Scan_State); 401 end if; 402 end; 403 end if; 404 end if; 405 406 -- Parse the aspect definition depening on the expected 407 -- argument kind. 408 409 if Aspect_Argument (A_Id) = Name 410 or else Aspect_Argument (A_Id) = Optional_Name 411 then 412 Set_Expression (Aspect, P_Name); 413 414 else 415 pragma Assert 416 (Aspect_Argument (A_Id) = Expression 417 or else 418 Aspect_Argument (A_Id) = Optional_Expression); 419 Set_Expression (Aspect, P_Expression); 420 end if; 421 end if; 422 423 -- Add the aspect to the resulting list only when it was properly 424 -- parsed. 425 426 if OK then 427 Append (Aspect, Aspects); 428 end if; 429 430 -- The aspect specification list contains more than one aspect 431 432 if Token = Tok_Comma then 433 Scan; -- past comma 434 goto Continue; 435 436 -- Check for a missing comma between two aspects. Emit an error 437 -- and proceed to the next aspect. 438 439 elsif Token = Tok_Identifier 440 and then Get_Aspect_Id (Token_Name) /= No_Aspect 441 then 442 declare 443 Scan_State : Saved_Scan_State; 444 445 begin 446 Save_Scan_State (Scan_State); 447 Scan; -- past identifier 448 449 -- Attempt to detect ' or => following a potential aspect 450 -- mark. 451 452 if Token = Tok_Apostrophe or else Token = Tok_Arrow then 453 Restore_Scan_State (Scan_State); 454 Error_Msg_AP -- CODEFIX 455 ("|missing "","""); 456 goto Continue; 457 458 -- The construct following the current aspect is not an 459 -- aspect. 460 461 else 462 Restore_Scan_State (Scan_State); 463 end if; 464 end; 465 466 -- Check for a mistyped semicolon in place of a comma between two 467 -- aspects. Emit an error and proceed to the next aspect. 468 469 elsif Token = Tok_Semicolon then 470 declare 471 Scan_State : Saved_Scan_State; 472 473 begin 474 Save_Scan_State (Scan_State); 475 Scan; -- past semicolon 476 477 if Token = Tok_Identifier 478 and then Get_Aspect_Id (Token_Name) /= No_Aspect 479 then 480 Scan; -- past identifier 481 482 -- Attempt to detect ' or => following a potential aspect 483 -- mark. 484 485 if Token = Tok_Apostrophe or else Token = Tok_Arrow then 486 Restore_Scan_State (Scan_State); 487 Error_Msg_SC -- CODEFIX 488 ("|"";"" should be "","""); 489 Scan; -- past semicolon 490 goto Continue; 491 end if; 492 end if; 493 494 -- The construct following the current aspect is not an 495 -- aspect. 496 497 Restore_Scan_State (Scan_State); 498 end; 499 end if; 500 501 -- Must be terminator character 502 503 if Semicolon then 504 T_Semicolon; 505 end if; 506 507 exit; 508 509 <<Continue>> 510 null; 511 end if; 512 end loop; 513 514 return Aspects; 515 end Get_Aspect_Specifications; 516 517 -------------------------------------------- 518 -- 13.1 Representation Clause (also I.7) -- 519 -------------------------------------------- 520 521 -- REPRESENTATION_CLAUSE ::= 522 -- ATTRIBUTE_DEFINITION_CLAUSE 523 -- | ENUMERATION_REPRESENTATION_CLAUSE 524 -- | RECORD_REPRESENTATION_CLAUSE 525 -- | AT_CLAUSE 526 527 -- ATTRIBUTE_DEFINITION_CLAUSE ::= 528 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION; 529 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME; 530 531 -- Note: in Ada 83, the expression must be a simple expression 532 533 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION; 534 535 -- Note: in Ada 83, the expression must be a simple expression 536 537 -- ENUMERATION_REPRESENTATION_CLAUSE ::= 538 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE; 539 540 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE 541 542 -- RECORD_REPRESENTATION_CLAUSE ::= 543 -- for first_subtype_LOCAL_NAME use 544 -- record [MOD_CLAUSE] 545 -- {COMPONENT_CLAUSE} 546 -- end record; 547 548 -- Note: for now we allow only a direct name as the local name in the 549 -- above constructs. This probably needs changing later on ??? 550 551 -- The caller has checked that the initial token is FOR 552 553 -- Error recovery: cannot raise Error_Resync, if an error occurs, 554 -- the scan is repositioned past the next semicolon. 555 556 function P_Representation_Clause return Node_Id is 557 For_Loc : Source_Ptr; 558 Name_Node : Node_Id; 559 Prefix_Node : Node_Id; 560 Attr_Name : Name_Id; 561 Identifier_Node : Node_Id; 562 Rep_Clause_Node : Node_Id; 563 Expr_Node : Node_Id; 564 Record_Items : List_Id; 565 566 begin 567 For_Loc := Token_Ptr; 568 Scan; -- past FOR 569 570 -- Note that the name in a representation clause is always a simple 571 -- name, even in the attribute case, see AI-300 which made this so. 572 573 Identifier_Node := P_Identifier (C_Use); 574 575 -- Check case of qualified name to give good error message 576 577 if Token = Tok_Dot then 578 Error_Msg_SC 579 ("representation clause requires simple name!"); 580 581 loop 582 exit when Token /= Tok_Dot; 583 Scan; -- past dot 584 Discard_Junk_Node (P_Identifier); 585 end loop; 586 end if; 587 588 -- Attribute Definition Clause 589 590 if Token = Tok_Apostrophe then 591 592 -- Allow local names of the form a'b'.... This enables 593 -- us to parse class-wide streams attributes correctly. 594 595 Name_Node := Identifier_Node; 596 while Token = Tok_Apostrophe loop 597 598 Scan; -- past apostrophe 599 600 Identifier_Node := Token_Node; 601 Attr_Name := No_Name; 602 603 if Token = Tok_Identifier then 604 Attr_Name := Token_Name; 605 606 -- Note that the parser must complain in case of an internal 607 -- attribute name that comes from source since internal names 608 -- are meant to be used only by the compiler. 609 610 if not Is_Attribute_Name (Attr_Name) 611 and then (not Is_Internal_Attribute_Name (Attr_Name) 612 or else Comes_From_Source (Token_Node)) 613 then 614 Signal_Bad_Attribute; 615 end if; 616 617 if Style_Check then 618 Style.Check_Attribute_Name (False); 619 end if; 620 621 -- Here for case of attribute designator is not an identifier 622 623 else 624 if Token = Tok_Delta then 625 Attr_Name := Name_Delta; 626 627 elsif Token = Tok_Digits then 628 Attr_Name := Name_Digits; 629 630 elsif Token = Tok_Access then 631 Attr_Name := Name_Access; 632 633 else 634 Error_Msg_AP ("attribute designator expected"); 635 raise Error_Resync; 636 end if; 637 638 if Style_Check then 639 Style.Check_Attribute_Name (True); 640 end if; 641 end if; 642 643 -- We come here with an OK attribute scanned, and the 644 -- corresponding Attribute identifier node stored in Ident_Node. 645 646 Prefix_Node := Name_Node; 647 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr); 648 Set_Prefix (Name_Node, Prefix_Node); 649 Set_Attribute_Name (Name_Node, Attr_Name); 650 Scan; 651 end loop; 652 653 Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc); 654 Set_Name (Rep_Clause_Node, Prefix_Node); 655 Set_Chars (Rep_Clause_Node, Attr_Name); 656 T_Use; 657 658 Expr_Node := P_Expression_No_Right_Paren; 659 Check_Simple_Expression_In_Ada_83 (Expr_Node); 660 Set_Expression (Rep_Clause_Node, Expr_Node); 661 662 else 663 TF_Use; 664 Rep_Clause_Node := Empty; 665 666 -- AT follows USE (At Clause) 667 668 if Token = Tok_At then 669 Scan; -- past AT 670 Rep_Clause_Node := New_Node (N_At_Clause, For_Loc); 671 Set_Identifier (Rep_Clause_Node, Identifier_Node); 672 Expr_Node := P_Expression_No_Right_Paren; 673 Check_Simple_Expression_In_Ada_83 (Expr_Node); 674 Set_Expression (Rep_Clause_Node, Expr_Node); 675 676 -- RECORD follows USE (Record Representation Clause) 677 678 elsif Token = Tok_Record then 679 Record_Items := P_Pragmas_Opt; 680 Rep_Clause_Node := 681 New_Node (N_Record_Representation_Clause, For_Loc); 682 Set_Identifier (Rep_Clause_Node, Identifier_Node); 683 684 Push_Scope_Stack; 685 Scope.Table (Scope.Last).Etyp := E_Record; 686 Scope.Table (Scope.Last).Ecol := Start_Column; 687 Scope.Table (Scope.Last).Sloc := Token_Ptr; 688 Scan; -- past RECORD 689 Record_Items := P_Pragmas_Opt; 690 691 -- Possible Mod Clause 692 693 if Token = Tok_At then 694 Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause); 695 Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items); 696 Record_Items := P_Pragmas_Opt; 697 end if; 698 699 if No (Record_Items) then 700 Record_Items := New_List; 701 end if; 702 703 Set_Component_Clauses (Rep_Clause_Node, Record_Items); 704 705 -- Loop through component clauses 706 707 loop 708 if Token not in Token_Class_Name then 709 exit when Check_End; 710 end if; 711 712 Append (P_Component_Clause, Record_Items); 713 P_Pragmas_Opt (Record_Items); 714 end loop; 715 716 -- Left paren follows USE (Enumeration Representation Clause) 717 718 elsif Token = Tok_Left_Paren then 719 Rep_Clause_Node := 720 New_Node (N_Enumeration_Representation_Clause, For_Loc); 721 Set_Identifier (Rep_Clause_Node, Identifier_Node); 722 Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate); 723 724 -- Some other token follows FOR (invalid representation clause) 725 726 else 727 Error_Msg_SC ("invalid representation clause"); 728 raise Error_Resync; 729 end if; 730 end if; 731 732 TF_Semicolon; 733 return Rep_Clause_Node; 734 735 exception 736 when Error_Resync => 737 Resync_Past_Semicolon; 738 return Error; 739 740 end P_Representation_Clause; 741 742 ---------------------- 743 -- 13.1 Local Name -- 744 ---------------------- 745 746 -- Local name is always parsed by its parent. In the case of its use in 747 -- pragmas, the check for a local name is handled in Par.Prag and allows 748 -- all the possible forms of local name. For the uses in chapter 13, we 749 -- currently only allow a direct name, but this should probably change??? 750 751 --------------------------- 752 -- 13.1 At Clause (I.7) -- 753 --------------------------- 754 755 -- Parsed by P_Representation_Clause (13.1) 756 757 --------------------------------------- 758 -- 13.3 Attribute Definition Clause -- 759 --------------------------------------- 760 761 -- Parsed by P_Representation_Clause (13.1) 762 763 -------------------------------- 764 -- 13.1 Aspect Specification -- 765 -------------------------------- 766 767 -- ASPECT_SPECIFICATION ::= 768 -- with ASPECT_MARK [=> ASPECT_DEFINITION] {, 769 -- ASPECT_MARK [=> ASPECT_DEFINITION] } 770 771 -- ASPECT_MARK ::= aspect_IDENTIFIER['Class] 772 773 -- ASPECT_DEFINITION ::= NAME | EXPRESSION 774 775 -- Error recovery: cannot raise Error_Resync 776 777 procedure P_Aspect_Specifications 778 (Decl : Node_Id; 779 Semicolon : Boolean := True) 780 is 781 Aspects : List_Id; 782 Ptr : Source_Ptr; 783 784 begin 785 -- Aspect Specification is present 786 787 Ptr := Token_Ptr; 788 789 -- Here we have an aspect specification to scan, note that we don't 790 -- set the flag till later, because it may turn out that we have no 791 -- valid aspects in the list. 792 793 Aspects := Get_Aspect_Specifications (Semicolon); 794 795 -- Here if aspects present 796 797 if Is_Non_Empty_List (Aspects) then 798 799 -- If Decl is Empty, we just ignore the aspects (the caller in this 800 -- case has always issued an appropriate error message). 801 802 if Decl = Empty then 803 null; 804 805 -- If Decl is Error, we ignore the aspects, and issue a message 806 807 elsif Decl = Error then 808 Error_Msg ("aspect specifications not allowed here", Ptr); 809 810 -- Here aspects are allowed, and we store them 811 812 else 813 Set_Parent (Aspects, Decl); 814 Set_Aspect_Specifications (Decl, Aspects); 815 end if; 816 end if; 817 end P_Aspect_Specifications; 818 819 --------------------------------------------- 820 -- 13.4 Enumeration Representation Clause -- 821 --------------------------------------------- 822 823 -- Parsed by P_Representation_Clause (13.1) 824 825 --------------------------------- 826 -- 13.4 Enumeration Aggregate -- 827 --------------------------------- 828 829 -- Parsed by P_Representation_Clause (13.1) 830 831 ------------------------------------------ 832 -- 13.5.1 Record Representation Clause -- 833 ------------------------------------------ 834 835 -- Parsed by P_Representation_Clause (13.1) 836 837 ------------------------------ 838 -- 13.5.1 Mod Clause (I.8) -- 839 ------------------------------ 840 841 -- MOD_CLAUSE ::= at mod static_EXPRESSION; 842 843 -- Note: in Ada 83, the expression must be a simple expression 844 845 -- The caller has checked that the initial Token is AT 846 847 -- Error recovery: cannot raise Error_Resync 848 849 -- Note: the caller is responsible for setting the Pragmas_Before field 850 851 function P_Mod_Clause return Node_Id is 852 Mod_Node : Node_Id; 853 Expr_Node : Node_Id; 854 855 begin 856 Mod_Node := New_Node (N_Mod_Clause, Token_Ptr); 857 Scan; -- past AT 858 T_Mod; 859 Expr_Node := P_Expression_No_Right_Paren; 860 Check_Simple_Expression_In_Ada_83 (Expr_Node); 861 Set_Expression (Mod_Node, Expr_Node); 862 TF_Semicolon; 863 return Mod_Node; 864 end P_Mod_Clause; 865 866 ------------------------------ 867 -- 13.5.1 Component Clause -- 868 ------------------------------ 869 870 -- COMPONENT_CLAUSE ::= 871 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION 872 -- range FIRST_BIT .. LAST_BIT; 873 874 -- COMPONENT_CLAUSE_COMPONENT_NAME ::= 875 -- component_DIRECT_NAME 876 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR 877 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR 878 879 -- POSITION ::= static_EXPRESSION 880 881 -- Note: in Ada 83, the expression must be a simple expression 882 883 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION 884 -- LAST_BIT ::= static_SIMPLE_EXPRESSION 885 886 -- Note: the AARM V2.0 grammar has an error at this point, it uses 887 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT 888 889 -- Error recovery: cannot raise Error_Resync 890 891 function P_Component_Clause return Node_Id is 892 Component_Node : Node_Id; 893 Comp_Name : Node_Id; 894 Expr_Node : Node_Id; 895 896 begin 897 Component_Node := New_Node (N_Component_Clause, Token_Ptr); 898 Comp_Name := P_Name; 899 900 if Nkind (Comp_Name) = N_Identifier 901 or else Nkind (Comp_Name) = N_Attribute_Reference 902 then 903 Set_Component_Name (Component_Node, Comp_Name); 904 else 905 Error_Msg_N 906 ("component name must be direct name or attribute", Comp_Name); 907 Set_Component_Name (Component_Node, Error); 908 end if; 909 910 Set_Sloc (Component_Node, Token_Ptr); 911 T_At; 912 Expr_Node := P_Expression_No_Right_Paren; 913 Check_Simple_Expression_In_Ada_83 (Expr_Node); 914 Set_Position (Component_Node, Expr_Node); 915 T_Range; 916 Expr_Node := P_Expression_No_Right_Paren; 917 Check_Simple_Expression_In_Ada_83 (Expr_Node); 918 Set_First_Bit (Component_Node, Expr_Node); 919 T_Dot_Dot; 920 Expr_Node := P_Expression_No_Right_Paren; 921 Check_Simple_Expression_In_Ada_83 (Expr_Node); 922 Set_Last_Bit (Component_Node, Expr_Node); 923 TF_Semicolon; 924 return Component_Node; 925 end P_Component_Clause; 926 927 ---------------------- 928 -- 13.5.1 Position -- 929 ---------------------- 930 931 -- Parsed by P_Component_Clause (13.5.1) 932 933 ----------------------- 934 -- 13.5.1 First Bit -- 935 ----------------------- 936 937 -- Parsed by P_Component_Clause (13.5.1) 938 939 ---------------------- 940 -- 13.5.1 Last Bit -- 941 ---------------------- 942 943 -- Parsed by P_Component_Clause (13.5.1) 944 945 -------------------------- 946 -- 13.8 Code Statement -- 947 -------------------------- 948 949 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION 950 951 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the 952 -- single argument, and the scan points to the apostrophe. 953 954 -- Error recovery: can raise Error_Resync 955 956 function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is 957 Node1 : Node_Id; 958 959 begin 960 Scan; -- past apostrophe 961 962 -- If left paren, then we have a possible code statement 963 964 if Token = Tok_Left_Paren then 965 Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark)); 966 Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark)); 967 TF_Semicolon; 968 return Node1; 969 970 -- Otherwise we have an illegal range attribute. Note that P_Name 971 -- ensures that Token = Tok_Range is the only possibility left here. 972 973 else 974 Error_Msg_SC ("RANGE attribute illegal here!"); 975 raise Error_Resync; 976 end if; 977 end P_Code_Statement; 978 979end Ch13; 980