1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P A R . T C H K -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26-- Token scan routines 27 28-- Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync 29 30separate (Par) 31package body Tchk is 32 33 type Position is (SC, BC, AP); 34 -- Specify position of error message (see Error_Msg_SC/BC/AP) 35 36 ----------------------- 37 -- Local Subprograms -- 38 ----------------------- 39 40 procedure Check_Token (T : Token_Type; P : Position); 41 pragma Inline (Check_Token); 42 -- Called by T_xx routines to check for reserved keyword token. P is the 43 -- position of the error message if the token is missing (see Wrong_Token) 44 45 procedure Wrong_Token (T : Token_Type; P : Position); 46 -- Called when scanning a reserved keyword when the keyword is not present. 47 -- T is the token type for the keyword, and P indicates the position to be 48 -- used to place a message relative to the current token if the keyword is 49 -- not located nearby. 50 51 ----------------- 52 -- Check_Token -- 53 ----------------- 54 55 procedure Check_Token (T : Token_Type; P : Position) is 56 begin 57 if Token = T then 58 Scan; 59 return; 60 else 61 Wrong_Token (T, P); 62 end if; 63 end Check_Token; 64 65 ------------- 66 -- T_Abort -- 67 ------------- 68 69 procedure T_Abort is 70 begin 71 Check_Token (Tok_Abort, SC); 72 end T_Abort; 73 74 ------------- 75 -- T_Arrow -- 76 ------------- 77 78 procedure T_Arrow is 79 begin 80 if Token = Tok_Arrow then 81 Scan; 82 83 -- A little recovery helper, accept then in place of => 84 85 elsif Token = Tok_Then then 86 Error_Msg_BC -- CODEFIX 87 ("|THEN should be ""='>"""); 88 Scan; -- past THEN used in place of => 89 90 elsif Token = Tok_Colon_Equal then 91 Error_Msg_SC -- CODEFIX 92 ("|"":="" should be ""='>"""); 93 Scan; -- past := used in place of => 94 95 else 96 Error_Msg_AP -- CODEFIX 97 ("missing ""='>"""); 98 end if; 99 end T_Arrow; 100 101 ---------- 102 -- T_At -- 103 ---------- 104 105 procedure T_At is 106 begin 107 Check_Token (Tok_At, SC); 108 end T_At; 109 110 ------------ 111 -- T_Body -- 112 ------------ 113 114 procedure T_Body is 115 begin 116 Check_Token (Tok_Body, BC); 117 end T_Body; 118 119 ----------- 120 -- T_Box -- 121 ----------- 122 123 procedure T_Box is 124 begin 125 if Token = Tok_Box then 126 Scan; 127 else 128 Error_Msg_AP -- CODEFIX 129 ("missing ""'<'>"""); 130 end if; 131 end T_Box; 132 133 ------------- 134 -- T_Colon -- 135 ------------- 136 137 procedure T_Colon is 138 begin 139 if Token = Tok_Colon then 140 Scan; 141 else 142 Error_Msg_AP -- CODEFIX 143 ("missing "":"""); 144 end if; 145 end T_Colon; 146 147 ------------------- 148 -- T_Colon_Equal -- 149 ------------------- 150 151 procedure T_Colon_Equal is 152 begin 153 if Token = Tok_Colon_Equal then 154 Scan; 155 156 elsif Token = Tok_Equal then 157 Error_Msg_SC -- CODEFIX 158 ("|""="" should be "":="""); 159 Scan; 160 161 elsif Token = Tok_Colon then 162 Error_Msg_SC -- CODEFIX 163 ("|"":"" should be "":="""); 164 Scan; 165 166 elsif Token = Tok_Is then 167 Error_Msg_SC -- CODEFIX 168 ("|IS should be "":="""); 169 Scan; 170 171 else 172 Error_Msg_AP -- CODEFIX 173 ("missing "":="""); 174 end if; 175 end T_Colon_Equal; 176 177 ------------- 178 -- T_Comma -- 179 ------------- 180 181 procedure T_Comma is 182 begin 183 if Token = Tok_Comma then 184 Scan; 185 186 else 187 if Token = Tok_Pragma then 188 P_Pragmas_Misplaced; 189 end if; 190 191 if Token = Tok_Comma then 192 Scan; 193 else 194 Error_Msg_AP -- CODEFIX 195 ("missing "","""); 196 end if; 197 end if; 198 199 if Token = Tok_Pragma then 200 P_Pragmas_Misplaced; 201 end if; 202 end T_Comma; 203 204 --------------- 205 -- T_Dot_Dot -- 206 --------------- 207 208 procedure T_Dot_Dot is 209 begin 210 if Token = Tok_Dot_Dot then 211 Scan; 212 else 213 Error_Msg_AP -- CODEFIX 214 ("missing "".."""); 215 end if; 216 end T_Dot_Dot; 217 218 ----------- 219 -- T_For -- 220 ----------- 221 222 procedure T_For is 223 begin 224 Check_Token (Tok_For, AP); 225 end T_For; 226 227 ----------------------- 228 -- T_Greater_Greater -- 229 ----------------------- 230 231 procedure T_Greater_Greater is 232 begin 233 if Token = Tok_Greater_Greater then 234 Scan; 235 else 236 Error_Msg_AP -- CODEFIX 237 ("missing ""'>'>"""); 238 end if; 239 end T_Greater_Greater; 240 241 ------------------ 242 -- T_Identifier -- 243 ------------------ 244 245 procedure T_Identifier is 246 begin 247 if Token = Tok_Identifier then 248 Scan; 249 elsif Token in Token_Class_Literal then 250 Error_Msg_SC ("identifier expected"); 251 Scan; 252 else 253 Error_Msg_AP ("identifier expected"); 254 end if; 255 end T_Identifier; 256 257 ---------- 258 -- T_In -- 259 ---------- 260 261 procedure T_In is 262 begin 263 Check_Token (Tok_In, AP); 264 end T_In; 265 266 ---------- 267 -- T_Is -- 268 ---------- 269 270 procedure T_Is is 271 begin 272 Ignore (Tok_Semicolon); 273 274 -- If we have IS scan past it 275 276 if Token = Tok_Is then 277 Scan; 278 279 -- And ignore any following semicolons 280 281 Ignore (Tok_Semicolon); 282 283 -- Allow OF, => or = to substitute for IS with complaint 284 285 elsif Token = Tok_Arrow then 286 Error_Msg_SC -- CODEFIX 287 ("|""=>"" should be IS"); 288 Scan; -- past => 289 290 elsif Token = Tok_Of then 291 Error_Msg_SC -- CODEFIX 292 ("|OF should be IS"); 293 Scan; -- past OF 294 295 elsif Token = Tok_Equal then 296 Error_Msg_SC -- CODEFIX 297 ("|""="" should be IS"); 298 Scan; -- past = 299 300 else 301 Wrong_Token (Tok_Is, AP); 302 end if; 303 304 -- Ignore extra IS keywords 305 306 while Token = Tok_Is loop 307 Error_Msg_SC -- CODEFIX 308 ("|extra IS ignored"); 309 Scan; 310 end loop; 311 end T_Is; 312 313 ------------------ 314 -- T_Left_Paren -- 315 ------------------ 316 317 procedure T_Left_Paren is 318 begin 319 if Token = Tok_Left_Paren then 320 Scan; 321 else 322 Error_Msg_AP -- CODEFIX 323 ("missing ""("""); 324 end if; 325 end T_Left_Paren; 326 327 ------------ 328 -- T_Loop -- 329 ------------ 330 331 procedure T_Loop is 332 begin 333 if Token = Tok_Do then 334 Error_Msg_SC -- CODEFIX 335 ("LOOP expected"); 336 Scan; 337 else 338 Check_Token (Tok_Loop, AP); 339 end if; 340 end T_Loop; 341 342 ----------- 343 -- T_Mod -- 344 ----------- 345 346 procedure T_Mod is 347 begin 348 Check_Token (Tok_Mod, AP); 349 end T_Mod; 350 351 ----------- 352 -- T_New -- 353 ----------- 354 355 procedure T_New is 356 begin 357 Check_Token (Tok_New, AP); 358 end T_New; 359 360 ---------- 361 -- T_Of -- 362 ---------- 363 364 procedure T_Of is 365 begin 366 Check_Token (Tok_Of, AP); 367 end T_Of; 368 369 ---------- 370 -- T_Or -- 371 ---------- 372 373 procedure T_Or is 374 begin 375 Check_Token (Tok_Or, AP); 376 end T_Or; 377 378 --------------- 379 -- T_Private -- 380 --------------- 381 382 procedure T_Private is 383 begin 384 Check_Token (Tok_Private, SC); 385 end T_Private; 386 387 ------------- 388 -- T_Range -- 389 ------------- 390 391 procedure T_Range is 392 begin 393 Check_Token (Tok_Range, AP); 394 end T_Range; 395 396 -------------- 397 -- T_Record -- 398 -------------- 399 400 procedure T_Record is 401 begin 402 Check_Token (Tok_Record, AP); 403 end T_Record; 404 405 --------------------- 406 -- T_Right_Bracket -- 407 --------------------- 408 409 procedure T_Right_Bracket is 410 begin 411 if Token = Tok_Right_Bracket then 412 Scan; 413 else 414 Error_Msg_AP -- CODEFIX 415 ("|missing ""']'"""); 416 end if; 417 end T_Right_Bracket; 418 419 ------------------- 420 -- T_Right_Paren -- 421 ------------------- 422 423 procedure T_Right_Paren is 424 begin 425 if Token = Tok_Right_Paren then 426 Scan; 427 else 428 Error_Msg_AP -- CODEFIX 429 ("|missing "")"""); 430 end if; 431 end T_Right_Paren; 432 433 ----------------- 434 -- T_Semicolon -- 435 ----------------- 436 437 procedure T_Semicolon is 438 begin 439 if Token = Tok_Semicolon then 440 Scan; 441 442 if Token = Tok_Semicolon then 443 Error_Msg_SC -- CODEFIX 444 ("|extra "";"" ignored"); 445 Scan; 446 end if; 447 448 return; 449 450 elsif Token = Tok_Colon then 451 Error_Msg_SC -- CODEFIX 452 ("|"":"" should be "";"""); 453 Scan; 454 return; 455 456 elsif Token = Tok_Comma then 457 Error_Msg_SC -- CODEFIX 458 ("|"","" should be "";"""); 459 Scan; 460 return; 461 462 elsif Token = Tok_Dot then 463 Error_Msg_SC -- CODEFIX 464 ("|""."" should be "";"""); 465 Scan; 466 return; 467 468 -- An interesting little case. If the previous token is a semicolon, 469 -- then there is no way that we can legitimately need another semicolon. 470 -- This could only arise in an situation where an error has already been 471 -- signalled. By simply ignoring the request for a semicolon in this 472 -- case, we avoid some spurious missing semicolon messages. 473 474 elsif Prev_Token = Tok_Semicolon then 475 return; 476 477 -- If the current token is | then this is a reasonable place to suggest 478 -- the possibility of a "C" confusion. 479 480 elsif Token = Tok_Vertical_Bar then 481 Error_Msg_SC -- CODEFIX 482 ("unexpected occurrence of ""'|"", did you mean OR'?"); 483 Resync_Past_Semicolon; 484 return; 485 486 -- Deal with pragma. If pragma is not at start of line, it is considered 487 -- misplaced otherwise we treat it as a normal missing semicolon case. 488 489 elsif Token = Tok_Pragma and then not Token_Is_At_Start_Of_Line then 490 P_Pragmas_Misplaced; 491 492 if Token = Tok_Semicolon then 493 Scan; 494 return; 495 end if; 496 end if; 497 498 -- If none of those tests return, we really have a missing semicolon 499 500 Error_Msg_AP -- CODEFIX 501 ("|missing "";"""); 502 return; 503 end T_Semicolon; 504 505 ------------ 506 -- T_Then -- 507 ------------ 508 509 procedure T_Then is 510 begin 511 Check_Token (Tok_Then, AP); 512 end T_Then; 513 514 ------------ 515 -- T_Type -- 516 ------------ 517 518 procedure T_Type is 519 begin 520 Check_Token (Tok_Type, BC); 521 end T_Type; 522 523 ----------- 524 -- T_Use -- 525 ----------- 526 527 procedure T_Use is 528 begin 529 Check_Token (Tok_Use, SC); 530 end T_Use; 531 532 ------------ 533 -- T_When -- 534 ------------ 535 536 procedure T_When is 537 begin 538 Check_Token (Tok_When, SC); 539 end T_When; 540 541 ------------ 542 -- T_With -- 543 ------------ 544 545 procedure T_With is 546 begin 547 Check_Token (Tok_With, BC); 548 end T_With; 549 550 -------------- 551 -- TF_Arrow -- 552 -------------- 553 554 procedure TF_Arrow is 555 Scan_State : Saved_Scan_State; 556 557 begin 558 if Token = Tok_Arrow then 559 Scan; -- skip arrow and we are done 560 561 elsif Token = Tok_Colon_Equal then 562 T_Arrow; -- Let T_Arrow give the message 563 564 else 565 T_Arrow; -- give missing arrow message 566 Save_Scan_State (Scan_State); -- at start of junk tokens 567 568 loop 569 if Prev_Token_Ptr < Current_Line_Start 570 or else Token = Tok_Semicolon 571 or else Token = Tok_EOF 572 then 573 Restore_Scan_State (Scan_State); -- to where we were 574 return; 575 end if; 576 577 Scan; -- continue search 578 579 if Token = Tok_Arrow then 580 Scan; -- past arrow 581 return; 582 end if; 583 end loop; 584 end if; 585 end TF_Arrow; 586 587 ----------- 588 -- TF_Is -- 589 ----------- 590 591 procedure TF_Is is 592 Scan_State : Saved_Scan_State; 593 594 begin 595 if Token = Tok_Is then 596 T_Is; -- past IS and we are done 597 598 -- Allow OF or => or = in place of IS (with error message) 599 600 elsif Token = Tok_Of 601 or else Token = Tok_Arrow 602 or else Token = Tok_Equal 603 then 604 T_Is; -- give missing IS message and skip bad token 605 606 else 607 T_Is; -- give missing IS message 608 Save_Scan_State (Scan_State); -- at start of junk tokens 609 610 loop 611 if Prev_Token_Ptr < Current_Line_Start 612 or else Token = Tok_Semicolon 613 or else Token = Tok_EOF 614 then 615 Restore_Scan_State (Scan_State); -- to where we were 616 return; 617 end if; 618 619 Scan; -- continue search 620 621 if Token = Tok_Is 622 or else Token = Tok_Of 623 or else Token = Tok_Arrow 624 then 625 Scan; -- past IS or OF or => 626 return; 627 end if; 628 end loop; 629 end if; 630 end TF_Is; 631 632 ------------- 633 -- TF_Loop -- 634 ------------- 635 636 procedure TF_Loop is 637 Scan_State : Saved_Scan_State; 638 639 begin 640 if Token = Tok_Loop then 641 Scan; -- past LOOP and we are done 642 643 -- Allow DO or THEN in place of LOOP 644 645 elsif Token = Tok_Then or else Token = Tok_Do then 646 T_Loop; -- give missing LOOP message 647 648 else 649 T_Loop; -- give missing LOOP message 650 Save_Scan_State (Scan_State); -- at start of junk tokens 651 652 loop 653 if Prev_Token_Ptr < Current_Line_Start 654 or else Token = Tok_Semicolon 655 or else Token = Tok_EOF 656 then 657 Restore_Scan_State (Scan_State); -- to where we were 658 return; 659 end if; 660 661 Scan; -- continue search 662 663 if Token = Tok_Loop or else Token = Tok_Then then 664 Scan; -- past loop or then (message already generated) 665 return; 666 end if; 667 end loop; 668 end if; 669 end TF_Loop; 670 671 -------------- 672 -- TF_Return-- 673 -------------- 674 675 procedure TF_Return is 676 Scan_State : Saved_Scan_State; 677 678 begin 679 if Token = Tok_Return then 680 Scan; -- skip RETURN and we are done 681 682 else 683 Error_Msg_SC -- CODEFIX 684 ("missing RETURN"); 685 Save_Scan_State (Scan_State); -- at start of junk tokens 686 687 loop 688 if Prev_Token_Ptr < Current_Line_Start 689 or else Token = Tok_Semicolon 690 or else Token = Tok_EOF 691 then 692 Restore_Scan_State (Scan_State); -- to where we were 693 return; 694 end if; 695 696 Scan; -- continue search 697 698 if Token = Tok_Return then 699 Scan; -- past RETURN 700 return; 701 end if; 702 end loop; 703 end if; 704 end TF_Return; 705 706 ------------------ 707 -- TF_Semicolon -- 708 ------------------ 709 710 procedure TF_Semicolon is 711 Scan_State : Saved_Scan_State; 712 713 begin 714 if Token = Tok_Semicolon then 715 T_Semicolon; 716 return; 717 718 -- An interesting little test here. If the previous token is a 719 -- semicolon, then there is no way that we can legitimately need 720 -- another semicolon. This could only arise in an error situation 721 -- where an error has already been signalled. By simply ignoring 722 -- the request for a semicolon in this case, we avoid some spurious 723 -- missing semicolon messages. 724 725 elsif Prev_Token = Tok_Semicolon then 726 return; 727 728 else 729 -- Deal with pragma. If pragma is not at start of line, it is 730 -- considered misplaced otherwise we treat it as a normal 731 -- missing semicolon case. 732 733 if Token = Tok_Pragma 734 and then not Token_Is_At_Start_Of_Line 735 then 736 P_Pragmas_Misplaced; 737 738 if Token = Tok_Semicolon then 739 T_Semicolon; 740 return; 741 end if; 742 end if; 743 744 -- Here we definitely have a missing semicolon, so give message 745 746 T_Semicolon; 747 748 -- Scan out junk on rest of line. Scan stops on END keyword, since 749 -- that seems to help avoid cascaded errors. 750 751 Save_Scan_State (Scan_State); -- at start of junk tokens 752 753 loop 754 if Prev_Token_Ptr < Current_Line_Start 755 or else Token = Tok_EOF 756 or else Token = Tok_End 757 then 758 Restore_Scan_State (Scan_State); -- to where we were 759 return; 760 end if; 761 762 Scan; -- continue search 763 764 if Token = Tok_Semicolon then 765 T_Semicolon; 766 return; 767 768 elsif Token in Token_Class_After_SM then 769 return; 770 end if; 771 end loop; 772 end if; 773 end TF_Semicolon; 774 775 ------------- 776 -- TF_Then -- 777 ------------- 778 779 procedure TF_Then is 780 Scan_State : Saved_Scan_State; 781 782 begin 783 if Token = Tok_Then then 784 Scan; -- past THEN and we are done 785 786 else 787 T_Then; -- give missing THEN message 788 Save_Scan_State (Scan_State); -- at start of junk tokens 789 790 loop 791 if Prev_Token_Ptr < Current_Line_Start 792 or else Token = Tok_Semicolon 793 or else Token = Tok_EOF 794 then 795 Restore_Scan_State (Scan_State); -- to where we were 796 return; 797 end if; 798 799 Scan; -- continue search 800 801 if Token = Tok_Then then 802 Scan; -- past THEN 803 return; 804 end if; 805 end loop; 806 end if; 807 end TF_Then; 808 809 ------------ 810 -- TF_Use -- 811 ------------ 812 813 procedure TF_Use is 814 Scan_State : Saved_Scan_State; 815 816 begin 817 if Token = Tok_Use then 818 Scan; -- past USE and we are done 819 820 else 821 T_Use; -- give USE expected message 822 Save_Scan_State (Scan_State); -- at start of junk tokens 823 824 loop 825 if Prev_Token_Ptr < Current_Line_Start 826 or else Token = Tok_Semicolon 827 or else Token = Tok_EOF 828 then 829 Restore_Scan_State (Scan_State); -- to where we were 830 return; 831 end if; 832 833 Scan; -- continue search 834 835 if Token = Tok_Use then 836 Scan; -- past use 837 return; 838 end if; 839 end loop; 840 end if; 841 end TF_Use; 842 843 ------------------ 844 -- U_Left_Paren -- 845 ------------------ 846 847 procedure U_Left_Paren is 848 begin 849 if Token = Tok_Left_Paren then 850 Scan; 851 else 852 Error_Msg_AP -- CODEFIX 853 ("missing ""(""!"); 854 end if; 855 end U_Left_Paren; 856 857 ------------------- 858 -- U_Right_Paren -- 859 ------------------- 860 861 procedure U_Right_Paren is 862 begin 863 if Token = Tok_Right_Paren then 864 Scan; 865 else 866 Error_Msg_AP -- CODEFIX 867 ("|missing "")""!"); 868 end if; 869 end U_Right_Paren; 870 871 ----------------- 872 -- Wrong_Token -- 873 ----------------- 874 875 procedure Wrong_Token (T : Token_Type; P : Position) is 876 Missing : constant String := "missing "; 877 Image : constant String := Token_Type'Image (T); 878 Tok_Name : constant String := Image (5 .. Image'Length); 879 M : constant String := Missing & Tok_Name; 880 881 begin 882 if Token = Tok_Semicolon then 883 Scan; 884 885 if Token = T then 886 Error_Msg_SP -- CODEFIX 887 ("|extra "";"" ignored"); 888 Scan; 889 else 890 Error_Msg_SP (M); 891 end if; 892 893 elsif Token = Tok_Comma then 894 Scan; 895 896 if Token = T then 897 Error_Msg_SP -- CODEFIX 898 ("|extra "","" ignored"); 899 Scan; 900 901 else 902 Error_Msg_SP (M); 903 end if; 904 905 else 906 case P is 907 when SC => Error_Msg_SC (M); 908 when BC => Error_Msg_BC (M); 909 when AP => Error_Msg_AP (M); 910 end case; 911 end if; 912 end Wrong_Token; 913 914end Tchk; 915