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