gcc/ada/par-tchk.adb

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