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