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