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-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 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_Paren -- 407 ------------------- 408 409 procedure T_Right_Paren is 410 begin 411 if Token = Tok_Right_Paren then 412 Scan; 413 else 414 Error_Msg_AP -- CODEFIX 415 ("|missing "")"""); 416 end if; 417 end T_Right_Paren; 418 419 ----------------- 420 -- T_Semicolon -- 421 ----------------- 422 423 procedure T_Semicolon is 424 begin 425 426 if Token = Tok_Semicolon then 427 Scan; 428 429 if Token = Tok_Semicolon then 430 Error_Msg_SC -- CODEFIX 431 ("|extra "";"" ignored"); 432 Scan; 433 end if; 434 435 return; 436 437 elsif Token = Tok_Colon then 438 Error_Msg_SC -- CODEFIX 439 ("|"":"" should be "";"""); 440 Scan; 441 return; 442 443 elsif Token = Tok_Comma then 444 Error_Msg_SC -- CODEFIX 445 ("|"","" should be "";"""); 446 Scan; 447 return; 448 449 elsif Token = Tok_Dot then 450 Error_Msg_SC -- CODEFIX 451 ("|""."" should be "";"""); 452 Scan; 453 return; 454 455 -- An interesting little case. If the previous token is a semicolon, 456 -- then there is no way that we can legitimately need another semicolon. 457 -- This could only arise in an situation where an error has already been 458 -- signalled. By simply ignoring the request for a semicolon in this 459 -- case, we avoid some spurious missing semicolon messages. 460 461 elsif Prev_Token = Tok_Semicolon then 462 return; 463 464 -- If the current token is | then this is a reasonable place to suggest 465 -- the possibility of a "C" confusion. 466 467 elsif Token = Tok_Vertical_Bar then 468 Error_Msg_SC -- CODEFIX 469 ("unexpected occurrence of ""'|"", did you mean OR'?"); 470 Resync_Past_Semicolon; 471 return; 472 473 -- Deal with pragma. If pragma is not at start of line, it is considered 474 -- misplaced otherwise we treat it as a normal missing semicolon case. 475 476 elsif Token = Tok_Pragma and then not Token_Is_At_Start_Of_Line then 477 P_Pragmas_Misplaced; 478 479 if Token = Tok_Semicolon then 480 Scan; 481 return; 482 end if; 483 end if; 484 485 -- If none of those tests return, we really have a missing semicolon 486 487 Error_Msg_AP -- CODEFIX 488 ("|missing "";"""); 489 return; 490 end T_Semicolon; 491 492 ------------ 493 -- T_Then -- 494 ------------ 495 496 procedure T_Then is 497 begin 498 Check_Token (Tok_Then, AP); 499 end T_Then; 500 501 ------------ 502 -- T_Type -- 503 ------------ 504 505 procedure T_Type is 506 begin 507 Check_Token (Tok_Type, BC); 508 end T_Type; 509 510 ----------- 511 -- T_Use -- 512 ----------- 513 514 procedure T_Use is 515 begin 516 Check_Token (Tok_Use, SC); 517 end T_Use; 518 519 ------------ 520 -- T_When -- 521 ------------ 522 523 procedure T_When is 524 begin 525 Check_Token (Tok_When, SC); 526 end T_When; 527 528 ------------ 529 -- T_With -- 530 ------------ 531 532 procedure T_With is 533 begin 534 Check_Token (Tok_With, BC); 535 end T_With; 536 537 -------------- 538 -- TF_Arrow -- 539 -------------- 540 541 procedure TF_Arrow is 542 Scan_State : Saved_Scan_State; 543 544 begin 545 if Token = Tok_Arrow then 546 Scan; -- skip arrow and we are done 547 548 elsif Token = Tok_Colon_Equal then 549 T_Arrow; -- Let T_Arrow give the message 550 551 else 552 T_Arrow; -- give missing arrow message 553 Save_Scan_State (Scan_State); -- at start of junk tokens 554 555 loop 556 if Prev_Token_Ptr < Current_Line_Start 557 or else Token = Tok_Semicolon 558 or else Token = Tok_EOF 559 then 560 Restore_Scan_State (Scan_State); -- to where we were 561 return; 562 end if; 563 564 Scan; -- continue search 565 566 if Token = Tok_Arrow then 567 Scan; -- past arrow 568 return; 569 end if; 570 end loop; 571 end if; 572 end TF_Arrow; 573 574 ----------- 575 -- TF_Is -- 576 ----------- 577 578 procedure TF_Is is 579 Scan_State : Saved_Scan_State; 580 581 begin 582 if Token = Tok_Is then 583 T_Is; -- past IS and we are done 584 585 -- Allow OF or => or = in place of IS (with error message) 586 587 elsif Token = Tok_Of 588 or else Token = Tok_Arrow 589 or else Token = Tok_Equal 590 then 591 T_Is; -- give missing IS message and skip bad token 592 593 else 594 T_Is; -- give missing IS message 595 Save_Scan_State (Scan_State); -- at start of junk tokens 596 597 loop 598 if Prev_Token_Ptr < Current_Line_Start 599 or else Token = Tok_Semicolon 600 or else Token = Tok_EOF 601 then 602 Restore_Scan_State (Scan_State); -- to where we were 603 return; 604 end if; 605 606 Scan; -- continue search 607 608 if Token = Tok_Is 609 or else Token = Tok_Of 610 or else Token = Tok_Arrow 611 then 612 Scan; -- past IS or OF or => 613 return; 614 end if; 615 end loop; 616 end if; 617 end TF_Is; 618 619 ------------- 620 -- TF_Loop -- 621 ------------- 622 623 procedure TF_Loop is 624 Scan_State : Saved_Scan_State; 625 626 begin 627 if Token = Tok_Loop then 628 Scan; -- past LOOP and we are done 629 630 -- Allow DO or THEN in place of LOOP 631 632 elsif Token = Tok_Then or else Token = Tok_Do then 633 T_Loop; -- give missing LOOP message 634 635 else 636 T_Loop; -- give missing LOOP message 637 Save_Scan_State (Scan_State); -- at start of junk tokens 638 639 loop 640 if Prev_Token_Ptr < Current_Line_Start 641 or else Token = Tok_Semicolon 642 or else Token = Tok_EOF 643 then 644 Restore_Scan_State (Scan_State); -- to where we were 645 return; 646 end if; 647 648 Scan; -- continue search 649 650 if Token = Tok_Loop or else Token = Tok_Then then 651 Scan; -- past loop or then (message already generated) 652 return; 653 end if; 654 end loop; 655 end if; 656 end TF_Loop; 657 658 -------------- 659 -- TF_Return-- 660 -------------- 661 662 procedure TF_Return is 663 Scan_State : Saved_Scan_State; 664 665 begin 666 if Token = Tok_Return then 667 Scan; -- skip RETURN and we are done 668 669 else 670 Error_Msg_SC -- CODEFIX 671 ("missing RETURN"); 672 Save_Scan_State (Scan_State); -- at start of junk tokens 673 674 loop 675 if Prev_Token_Ptr < Current_Line_Start 676 or else Token = Tok_Semicolon 677 or else Token = Tok_EOF 678 then 679 Restore_Scan_State (Scan_State); -- to where we were 680 return; 681 end if; 682 683 Scan; -- continue search 684 685 if Token = Tok_Return then 686 Scan; -- past RETURN 687 return; 688 end if; 689 end loop; 690 end if; 691 end TF_Return; 692 693 ------------------ 694 -- TF_Semicolon -- 695 ------------------ 696 697 procedure TF_Semicolon is 698 Scan_State : Saved_Scan_State; 699 700 begin 701 if Token = Tok_Semicolon then 702 T_Semicolon; 703 return; 704 705 -- An interesting little test here. If the previous token is a 706 -- semicolon, then there is no way that we can legitimately need 707 -- another semicolon. This could only arise in an error situation 708 -- where an error has already been signalled. By simply ignoring 709 -- the request for a semicolon in this case, we avoid some spurious 710 -- missing semicolon messages. 711 712 elsif Prev_Token = Tok_Semicolon then 713 return; 714 715 else 716 -- Deal with pragma. If pragma is not at start of line, it is 717 -- considered misplaced otherwise we treat it as a normal 718 -- missing semicolon case. 719 720 if Token = Tok_Pragma 721 and then not Token_Is_At_Start_Of_Line 722 then 723 P_Pragmas_Misplaced; 724 725 if Token = Tok_Semicolon then 726 T_Semicolon; 727 return; 728 end if; 729 end if; 730 731 -- Here we definitely have a missing semicolon, so give message 732 733 T_Semicolon; 734 735 -- Scan out junk on rest of line. Scan stops on END keyword, since 736 -- that seems to help avoid cascaded errors. 737 738 Save_Scan_State (Scan_State); -- at start of junk tokens 739 740 loop 741 if Prev_Token_Ptr < Current_Line_Start 742 or else Token = Tok_EOF 743 or else Token = Tok_End 744 then 745 Restore_Scan_State (Scan_State); -- to where we were 746 return; 747 end if; 748 749 Scan; -- continue search 750 751 if Token = Tok_Semicolon then 752 T_Semicolon; 753 return; 754 755 elsif Token in Token_Class_After_SM then 756 return; 757 end if; 758 end loop; 759 end if; 760 end TF_Semicolon; 761 762 ------------- 763 -- TF_Then -- 764 ------------- 765 766 procedure TF_Then is 767 Scan_State : Saved_Scan_State; 768 769 begin 770 if Token = Tok_Then then 771 Scan; -- past THEN and we are done 772 773 else 774 T_Then; -- give missing THEN message 775 Save_Scan_State (Scan_State); -- at start of junk tokens 776 777 loop 778 if Prev_Token_Ptr < Current_Line_Start 779 or else Token = Tok_Semicolon 780 or else Token = Tok_EOF 781 then 782 Restore_Scan_State (Scan_State); -- to where we were 783 return; 784 end if; 785 786 Scan; -- continue search 787 788 if Token = Tok_Then then 789 Scan; -- past THEN 790 return; 791 end if; 792 end loop; 793 end if; 794 end TF_Then; 795 796 ------------ 797 -- TF_Use -- 798 ------------ 799 800 procedure TF_Use is 801 Scan_State : Saved_Scan_State; 802 803 begin 804 if Token = Tok_Use then 805 Scan; -- past USE and we are done 806 807 else 808 T_Use; -- give USE expected message 809 Save_Scan_State (Scan_State); -- at start of junk tokens 810 811 loop 812 if Prev_Token_Ptr < Current_Line_Start 813 or else Token = Tok_Semicolon 814 or else Token = Tok_EOF 815 then 816 Restore_Scan_State (Scan_State); -- to where we were 817 return; 818 end if; 819 820 Scan; -- continue search 821 822 if Token = Tok_Use then 823 Scan; -- past use 824 return; 825 end if; 826 end loop; 827 end if; 828 end TF_Use; 829 830 ------------------ 831 -- U_Left_Paren -- 832 ------------------ 833 834 procedure U_Left_Paren is 835 begin 836 if Token = Tok_Left_Paren then 837 Scan; 838 else 839 Error_Msg_AP -- CODEFIX 840 ("missing ""(""!"); 841 end if; 842 end U_Left_Paren; 843 844 ------------------- 845 -- U_Right_Paren -- 846 ------------------- 847 848 procedure U_Right_Paren is 849 begin 850 if Token = Tok_Right_Paren then 851 Scan; 852 else 853 Error_Msg_AP -- CODEFIX 854 ("|missing "")""!"); 855 end if; 856 end U_Right_Paren; 857 858 ----------------- 859 -- Wrong_Token -- 860 ----------------- 861 862 procedure Wrong_Token (T : Token_Type; P : Position) is 863 Missing : constant String := "missing "; 864 Image : constant String := Token_Type'Image (T); 865 Tok_Name : constant String := Image (5 .. Image'Length); 866 M : constant String := Missing & Tok_Name; 867 868 begin 869 if Token = Tok_Semicolon then 870 Scan; 871 872 if Token = T then 873 Error_Msg_SP -- CODEFIX 874 ("|extra "";"" ignored"); 875 Scan; 876 else 877 Error_Msg_SP (M); 878 end if; 879 880 elsif Token = Tok_Comma then 881 Scan; 882 883 if Token = T then 884 Error_Msg_SP -- CODEFIX 885 ("|extra "","" ignored"); 886 Scan; 887 888 else 889 Error_Msg_SP (M); 890 end if; 891 892 else 893 case P is 894 when SC => Error_Msg_SC (M); 895 when BC => Error_Msg_BC (M); 896 when AP => Error_Msg_AP (M); 897 end case; 898 end if; 899 end Wrong_Token; 900 901end Tchk; 902