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-2019, 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 or Refined_Depends aspect 524 525 if A_Id = Aspect_Depends 526 or else A_Id = Aspect_Refined_Depends 527 then 528 Inside_Depends := True; 529 end if; 530 531 -- Parse the aspect definition depening on the expected 532 -- argument kind. 533 534 if Aspect_Argument (A_Id) = Name 535 or else Aspect_Argument (A_Id) = Optional_Name 536 then 537 Set_Expression (Aspect, P_Name); 538 539 else 540 pragma Assert 541 (Aspect_Argument (A_Id) = Expression 542 or else 543 Aspect_Argument (A_Id) = Optional_Expression); 544 Set_Expression (Aspect, P_Expression); 545 end if; 546 547 -- Unconditionally reset flag for Inside_Depends 548 549 Inside_Depends := False; 550 end if; 551 552 -- Add the aspect to the resulting list only when it was properly 553 -- parsed. 554 555 if OK then 556 Append (Aspect, Aspects); 557 end if; 558 end if; 559 560 -- Merge here after good or bad aspect (we should be at a comma 561 -- or a semicolon, but there might be other possible errors). 562 563 -- The aspect specification list contains more than one aspect 564 565 if Token = Tok_Comma then 566 Scan; -- past comma 567 goto Continue; 568 569 -- Check for a missing comma between two aspects. Emit an error 570 -- and proceed to the next aspect. 571 572 elsif Token = Tok_Identifier 573 and then Get_Aspect_Id (Token_Name) /= No_Aspect 574 then 575 declare 576 Scan_State : Saved_Scan_State; 577 578 begin 579 Save_Scan_State (Scan_State); 580 Scan; -- past identifier 581 582 -- Attempt to detect ' or => following a potential aspect 583 -- mark. 584 585 if Token = Tok_Apostrophe or else Token = Tok_Arrow then 586 Restore_Scan_State (Scan_State); 587 Error_Msg_AP -- CODEFIX 588 ("|missing "","""); 589 goto Continue; 590 591 -- The construct following the current aspect is not an 592 -- aspect. 593 594 else 595 Restore_Scan_State (Scan_State); 596 end if; 597 end; 598 599 -- Check for a mistyped semicolon in place of a comma between two 600 -- aspects. Emit an error and proceed to the next aspect. 601 602 elsif Token = Tok_Semicolon then 603 declare 604 Scan_State : Saved_Scan_State; 605 606 begin 607 Save_Scan_State (Scan_State); 608 Scan; -- past semicolon 609 610 if Token = Tok_Identifier 611 and then Get_Aspect_Id (Token_Name) /= No_Aspect 612 then 613 Scan; -- past identifier 614 615 -- Attempt to detect ' or => following potential aspect mark 616 617 if Token = Tok_Apostrophe or else Token = Tok_Arrow then 618 Restore_Scan_State (Scan_State); 619 Error_Msg_SC -- CODEFIX 620 ("|"";"" should be "","""); 621 Scan; -- past semicolon 622 goto Continue; 623 end if; 624 end if; 625 626 -- Construct following the current aspect is not an aspect 627 628 Restore_Scan_State (Scan_State); 629 end; 630 end if; 631 632 -- Require semicolon if caller expects to scan this out 633 634 if Semicolon then 635 T_Semicolon; 636 end if; 637 638 exit; 639 640 <<Continue>> 641 null; 642 end loop; 643 644 return Aspects; 645 end Get_Aspect_Specifications; 646 647 -------------------------------------------- 648 -- 13.1 Representation Clause (also I.7) -- 649 -------------------------------------------- 650 651 -- REPRESENTATION_CLAUSE ::= 652 -- ATTRIBUTE_DEFINITION_CLAUSE 653 -- | ENUMERATION_REPRESENTATION_CLAUSE 654 -- | RECORD_REPRESENTATION_CLAUSE 655 -- | AT_CLAUSE 656 657 -- ATTRIBUTE_DEFINITION_CLAUSE ::= 658 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION; 659 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME; 660 661 -- Note: in Ada 83, the expression must be a simple expression 662 663 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION; 664 665 -- Note: in Ada 83, the expression must be a simple expression 666 667 -- ENUMERATION_REPRESENTATION_CLAUSE ::= 668 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE; 669 670 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE 671 672 -- RECORD_REPRESENTATION_CLAUSE ::= 673 -- for first_subtype_LOCAL_NAME use 674 -- record [MOD_CLAUSE] 675 -- {COMPONENT_CLAUSE} 676 -- end record; 677 678 -- Note: for now we allow only a direct name as the local name in the 679 -- above constructs. This probably needs changing later on ??? 680 681 -- The caller has checked that the initial token is FOR 682 683 -- Error recovery: cannot raise Error_Resync, if an error occurs, 684 -- the scan is repositioned past the next semicolon. 685 686 function P_Representation_Clause return Node_Id is 687 For_Loc : Source_Ptr; 688 Name_Node : Node_Id; 689 Prefix_Node : Node_Id; 690 Attr_Name : Name_Id; 691 Identifier_Node : Node_Id; 692 Rep_Clause_Node : Node_Id; 693 Expr_Node : Node_Id; 694 Record_Items : List_Id; 695 696 begin 697 For_Loc := Token_Ptr; 698 Scan; -- past FOR 699 700 -- Note that the name in a representation clause is always a simple 701 -- name, even in the attribute case, see AI-300 which made this so. 702 703 Identifier_Node := P_Identifier (C_Use); 704 705 -- Check case of qualified name to give good error message 706 707 if Token = Tok_Dot then 708 Error_Msg_SC 709 ("representation clause requires simple name!"); 710 711 loop 712 exit when Token /= Tok_Dot; 713 Scan; -- past dot 714 Discard_Junk_Node (P_Identifier); 715 end loop; 716 end if; 717 718 -- Attribute Definition Clause 719 720 if Token = Tok_Apostrophe then 721 722 -- Allow local names of the form a'b'.... This enables 723 -- us to parse class-wide streams attributes correctly. 724 725 Name_Node := Identifier_Node; 726 while Token = Tok_Apostrophe loop 727 728 Scan; -- past apostrophe 729 730 Identifier_Node := Token_Node; 731 Attr_Name := No_Name; 732 733 if Token = Tok_Identifier then 734 Attr_Name := Token_Name; 735 736 -- Note that the parser must complain in case of an internal 737 -- attribute name that comes from source since internal names 738 -- are meant to be used only by the compiler. 739 740 if not Is_Attribute_Name (Attr_Name) 741 and then (not Is_Internal_Attribute_Name (Attr_Name) 742 or else Comes_From_Source (Token_Node)) 743 then 744 Signal_Bad_Attribute; 745 end if; 746 747 if Style_Check then 748 Style.Check_Attribute_Name (False); 749 end if; 750 751 -- Here for case of attribute designator is not an identifier 752 753 else 754 if Token = Tok_Delta then 755 Attr_Name := Name_Delta; 756 757 elsif Token = Tok_Digits then 758 Attr_Name := Name_Digits; 759 760 elsif Token = Tok_Access then 761 Attr_Name := Name_Access; 762 763 else 764 Error_Msg_AP ("attribute designator expected"); 765 raise Error_Resync; 766 end if; 767 768 if Style_Check then 769 Style.Check_Attribute_Name (True); 770 end if; 771 end if; 772 773 -- Here we have an OK attribute scanned, and the corresponding 774 -- Attribute identifier node is stored in Ident_Node. 775 776 Prefix_Node := Name_Node; 777 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr); 778 Set_Prefix (Name_Node, Prefix_Node); 779 Set_Attribute_Name (Name_Node, Attr_Name); 780 Scan; 781 782 -- Check for Address clause which needs to be marked for use in 783 -- optimizing performance of Exp_Util.Following_Address_Clause. 784 785 if Attr_Name = Name_Address 786 and then Nkind (Prefix_Node) = N_Identifier 787 then 788 Set_Name_Table_Boolean1 (Chars (Prefix_Node), True); 789 end if; 790 end loop; 791 792 Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc); 793 Set_Name (Rep_Clause_Node, Prefix_Node); 794 Set_Chars (Rep_Clause_Node, Attr_Name); 795 T_Use; 796 797 Expr_Node := P_Expression_No_Right_Paren; 798 Check_Simple_Expression_In_Ada_83 (Expr_Node); 799 Set_Expression (Rep_Clause_Node, Expr_Node); 800 801 else 802 TF_Use; 803 Rep_Clause_Node := Empty; 804 805 -- AT follows USE (At Clause) 806 807 if Token = Tok_At then 808 Scan; -- past AT 809 Rep_Clause_Node := New_Node (N_At_Clause, For_Loc); 810 Set_Identifier (Rep_Clause_Node, Identifier_Node); 811 Expr_Node := P_Expression_No_Right_Paren; 812 Check_Simple_Expression_In_Ada_83 (Expr_Node); 813 Set_Expression (Rep_Clause_Node, Expr_Node); 814 815 -- Mark occurrence of address clause (used to optimize performance 816 -- of Exp_Util.Following_Address_Clause). 817 818 Set_Name_Table_Boolean1 (Chars (Identifier_Node), True); 819 820 -- RECORD follows USE (Record Representation Clause) 821 822 elsif Token = Tok_Record then 823 Record_Items := P_Pragmas_Opt; 824 Rep_Clause_Node := 825 New_Node (N_Record_Representation_Clause, For_Loc); 826 Set_Identifier (Rep_Clause_Node, Identifier_Node); 827 828 Push_Scope_Stack; 829 Scope.Table (Scope.Last).Etyp := E_Record; 830 Scope.Table (Scope.Last).Ecol := Start_Column; 831 Scope.Table (Scope.Last).Sloc := Token_Ptr; 832 Scan; -- past RECORD 833 Record_Items := P_Pragmas_Opt; 834 835 -- Possible Mod Clause 836 837 if Token = Tok_At then 838 Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause); 839 Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items); 840 Record_Items := P_Pragmas_Opt; 841 end if; 842 843 if No (Record_Items) then 844 Record_Items := New_List; 845 end if; 846 847 Set_Component_Clauses (Rep_Clause_Node, Record_Items); 848 849 -- Loop through component clauses 850 851 loop 852 if Token not in Token_Class_Name then 853 exit when Check_End; 854 end if; 855 856 Append (P_Component_Clause, Record_Items); 857 P_Pragmas_Opt (Record_Items); 858 end loop; 859 860 -- Left paren follows USE (Enumeration Representation Clause) 861 862 elsif Token = Tok_Left_Paren then 863 Rep_Clause_Node := 864 New_Node (N_Enumeration_Representation_Clause, For_Loc); 865 Set_Identifier (Rep_Clause_Node, Identifier_Node); 866 Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate); 867 868 -- Some other token follows FOR (invalid representation clause) 869 870 else 871 Error_Msg_SC ("invalid representation clause"); 872 raise Error_Resync; 873 end if; 874 end if; 875 876 TF_Semicolon; 877 return Rep_Clause_Node; 878 879 exception 880 when Error_Resync => 881 Resync_Past_Semicolon; 882 return Error; 883 884 end P_Representation_Clause; 885 886 ---------------------- 887 -- 13.1 Local Name -- 888 ---------------------- 889 890 -- Local name is always parsed by its parent. In the case of its use in 891 -- pragmas, the check for a local name is handled in Par.Prag and allows 892 -- all the possible forms of local name. For the uses in chapter 13, we 893 -- currently only allow a direct name, but this should probably change??? 894 895 --------------------------- 896 -- 13.1 At Clause (I.7) -- 897 --------------------------- 898 899 -- Parsed by P_Representation_Clause (13.1) 900 901 --------------------------------------- 902 -- 13.3 Attribute Definition Clause -- 903 --------------------------------------- 904 905 -- Parsed by P_Representation_Clause (13.1) 906 907 -------------------------------- 908 -- 13.1 Aspect Specification -- 909 -------------------------------- 910 911 -- ASPECT_SPECIFICATION ::= 912 -- with ASPECT_MARK [=> ASPECT_DEFINITION] {, 913 -- ASPECT_MARK [=> ASPECT_DEFINITION] } 914 915 -- ASPECT_MARK ::= aspect_IDENTIFIER['Class] 916 917 -- ASPECT_DEFINITION ::= NAME | EXPRESSION 918 919 -- Error recovery: cannot raise Error_Resync 920 921 procedure P_Aspect_Specifications 922 (Decl : Node_Id; 923 Semicolon : Boolean := True) 924 is 925 Aspects : List_Id; 926 Ptr : Source_Ptr; 927 928 begin 929 -- Aspect Specification is present 930 931 Ptr := Token_Ptr; 932 933 -- Here we have an aspect specification to scan, note that we don't 934 -- set the flag till later, because it may turn out that we have no 935 -- valid aspects in the list. 936 937 Aspects := Get_Aspect_Specifications (Semicolon); 938 939 -- Here if aspects present 940 941 if Is_Non_Empty_List (Aspects) then 942 943 -- If Decl is Empty, we just ignore the aspects (the caller in this 944 -- case has always issued an appropriate error message). 945 946 if Decl = Empty then 947 null; 948 949 -- If Decl is Error, we ignore the aspects, and issue a message 950 951 elsif Decl = Error then 952 Error_Msg ("aspect specifications not allowed here", Ptr); 953 954 -- Here aspects are allowed, and we store them 955 956 else 957 Set_Parent (Aspects, Decl); 958 Set_Aspect_Specifications (Decl, Aspects); 959 end if; 960 end if; 961 end P_Aspect_Specifications; 962 963 --------------------------------------------- 964 -- 13.4 Enumeration Representation Clause -- 965 --------------------------------------------- 966 967 -- Parsed by P_Representation_Clause (13.1) 968 969 --------------------------------- 970 -- 13.4 Enumeration Aggregate -- 971 --------------------------------- 972 973 -- Parsed by P_Representation_Clause (13.1) 974 975 ------------------------------------------ 976 -- 13.5.1 Record Representation Clause -- 977 ------------------------------------------ 978 979 -- Parsed by P_Representation_Clause (13.1) 980 981 ------------------------------ 982 -- 13.5.1 Mod Clause (I.8) -- 983 ------------------------------ 984 985 -- MOD_CLAUSE ::= at mod static_EXPRESSION; 986 987 -- Note: in Ada 83, the expression must be a simple expression 988 989 -- The caller has checked that the initial Token is AT 990 991 -- Error recovery: cannot raise Error_Resync 992 993 -- Note: the caller is responsible for setting the Pragmas_Before field 994 995 function P_Mod_Clause return Node_Id is 996 Mod_Node : Node_Id; 997 Expr_Node : Node_Id; 998 999 begin 1000 Mod_Node := New_Node (N_Mod_Clause, Token_Ptr); 1001 Scan; -- past AT 1002 T_Mod; 1003 Expr_Node := P_Expression_No_Right_Paren; 1004 Check_Simple_Expression_In_Ada_83 (Expr_Node); 1005 Set_Expression (Mod_Node, Expr_Node); 1006 TF_Semicolon; 1007 return Mod_Node; 1008 end P_Mod_Clause; 1009 1010 ------------------------------ 1011 -- 13.5.1 Component Clause -- 1012 ------------------------------ 1013 1014 -- COMPONENT_CLAUSE ::= 1015 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION 1016 -- range FIRST_BIT .. LAST_BIT; 1017 1018 -- COMPONENT_CLAUSE_COMPONENT_NAME ::= 1019 -- component_DIRECT_NAME 1020 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR 1021 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR 1022 1023 -- POSITION ::= static_EXPRESSION 1024 1025 -- Note: in Ada 83, the expression must be a simple expression 1026 1027 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION 1028 -- LAST_BIT ::= static_SIMPLE_EXPRESSION 1029 1030 -- Note: the AARM V2.0 grammar has an error at this point, it uses 1031 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT 1032 1033 -- Error recovery: cannot raise Error_Resync 1034 1035 function P_Component_Clause return Node_Id is 1036 Component_Node : Node_Id; 1037 Comp_Name : Node_Id; 1038 Expr_Node : Node_Id; 1039 1040 begin 1041 Component_Node := New_Node (N_Component_Clause, Token_Ptr); 1042 Comp_Name := P_Name; 1043 1044 if Nkind (Comp_Name) = N_Identifier 1045 or else Nkind (Comp_Name) = N_Attribute_Reference 1046 then 1047 Set_Component_Name (Component_Node, Comp_Name); 1048 else 1049 Error_Msg_N 1050 ("component name must be direct name or attribute", Comp_Name); 1051 Set_Component_Name (Component_Node, Error); 1052 end if; 1053 1054 Set_Sloc (Component_Node, Token_Ptr); 1055 T_At; 1056 Expr_Node := P_Expression_No_Right_Paren; 1057 Check_Simple_Expression_In_Ada_83 (Expr_Node); 1058 Set_Position (Component_Node, Expr_Node); 1059 T_Range; 1060 Expr_Node := P_Expression_No_Right_Paren; 1061 Check_Simple_Expression_In_Ada_83 (Expr_Node); 1062 Set_First_Bit (Component_Node, Expr_Node); 1063 T_Dot_Dot; 1064 Expr_Node := P_Expression_No_Right_Paren; 1065 Check_Simple_Expression_In_Ada_83 (Expr_Node); 1066 Set_Last_Bit (Component_Node, Expr_Node); 1067 TF_Semicolon; 1068 return Component_Node; 1069 end P_Component_Clause; 1070 1071 ---------------------- 1072 -- 13.5.1 Position -- 1073 ---------------------- 1074 1075 -- Parsed by P_Component_Clause (13.5.1) 1076 1077 ----------------------- 1078 -- 13.5.1 First Bit -- 1079 ----------------------- 1080 1081 -- Parsed by P_Component_Clause (13.5.1) 1082 1083 ---------------------- 1084 -- 13.5.1 Last Bit -- 1085 ---------------------- 1086 1087 -- Parsed by P_Component_Clause (13.5.1) 1088 1089 -------------------------- 1090 -- 13.8 Code Statement -- 1091 -------------------------- 1092 1093 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION 1094 1095 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the 1096 -- single argument, and the scan points to the apostrophe. 1097 1098 -- Error recovery: can raise Error_Resync 1099 1100 function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is 1101 Node1 : Node_Id; 1102 1103 begin 1104 Scan; -- past apostrophe 1105 1106 -- If left paren, then we have a possible code statement 1107 1108 if Token = Tok_Left_Paren then 1109 Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark)); 1110 Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark)); 1111 TF_Semicolon; 1112 return Node1; 1113 1114 -- Otherwise we have an illegal range attribute. Note that P_Name 1115 -- ensures that Token = Tok_Range is the only possibility left here. 1116 1117 else 1118 Error_Msg_SC ("RANGE attribute illegal here!"); 1119 raise Error_Resync; 1120 end if; 1121 end P_Code_Statement; 1122 1123end Ch13; 1124