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