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-2012, 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. 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
 902 end Tchk;