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