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 ("missing ""='>""");
  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       if Token = Tok_Is then
 261          Scan;
 262
 263          Ignore (Tok_Semicolon);
 264
 265       --  Allow OF, => or = to substitute for IS with complaint
 266
 267       elsif Token = Tok_Arrow
 268         or else Token = Tok_Of
 269         or else Token = Tok_Equal
 270       then
 271          Error_Msg_SC ("missing IS");
 272          Scan; -- token used in place of IS
 273       else
 274          Wrong_Token (Tok_Is, AP);
 275       end if;
 276
 277       while Token = Tok_Is loop
 278          Error_Msg_SC ("extra IS ignored");
 279          Scan;
 280       end loop;
 281    end T_Is;
 282
 283    ------------------
 284    -- T_Left_Paren --
 285    ------------------
 286
 287    procedure T_Left_Paren is
 288    begin
 289       if Token = Tok_Left_Paren then
 290          Scan;
 291       else
 292          Error_Msg_AP ("missing ""(""");
 293       end if;
 294    end T_Left_Paren;
 295
 296    ------------
 297    -- T_Loop --
 298    ------------
 299
 300    procedure T_Loop is
 301    begin
 302       if Token = Tok_Do then
 303          Error_Msg_SC ("LOOP expected");
 304          Scan;
 305       else
 306          Check_Token (Tok_Loop, AP);
 307       end if;
 308    end T_Loop;
 309
 310    -----------
 311    -- T_Mod --
 312    -----------
 313
 314    procedure T_Mod is
 315    begin
 316       Check_Token (Tok_Mod, AP);
 317    end T_Mod;
 318
 319    -----------
 320    -- T_New --
 321    -----------
 322
 323    procedure T_New is
 324    begin
 325       Check_Token (Tok_New, AP);
 326    end T_New;
 327
 328    ----------
 329    -- T_Of --
 330    ----------
 331
 332    procedure T_Of is
 333    begin
 334       Check_Token (Tok_Of, AP);
 335    end T_Of;
 336
 337    ----------
 338    -- T_Or --
 339    ----------
 340
 341    procedure T_Or is
 342    begin
 343       Check_Token (Tok_Or, AP);
 344    end T_Or;
 345
 346    ---------------
 347    -- T_Private --
 348    ---------------
 349
 350    procedure T_Private is
 351    begin
 352       Check_Token (Tok_Private, SC);
 353    end T_Private;
 354
 355    -------------
 356    -- T_Range --
 357    -------------
 358
 359    procedure T_Range is
 360    begin
 361       Check_Token (Tok_Range, AP);
 362    end T_Range;
 363
 364    --------------
 365    -- T_Record --
 366    --------------
 367
 368    procedure T_Record is
 369    begin
 370       Check_Token (Tok_Record, AP);
 371    end T_Record;
 372
 373    -------------------
 374    -- T_Right_Paren --
 375    -------------------
 376
 377    procedure T_Right_Paren is
 378    begin
 379       if Token = Tok_Right_Paren then
 380          Scan;
 381       else
 382          Error_Msg_AP ("missing "")""");
 383       end if;
 384    end T_Right_Paren;
 385
 386    -----------------
 387    -- T_Semicolon --
 388    -----------------
 389
 390    procedure T_Semicolon is
 391    begin
 392
 393       if Token = Tok_Semicolon then
 394          Scan;
 395
 396          if Token = Tok_Semicolon then
 397             Error_Msg_SC ("extra "";"" ignored");
 398             Scan;
 399          end if;
 400
 401          return;
 402
 403       elsif Token = Tok_Colon then
 404          Error_Msg_SC (""":"" should be "";""");
 405          Scan;
 406          return;
 407
 408       elsif Token = Tok_Comma then
 409          Error_Msg_SC (""","" should be "";""");
 410          Scan;
 411          return;
 412
 413       elsif Token = Tok_Dot then
 414          Error_Msg_SC ("""."" should be "";""");
 415          Scan;
 416          return;
 417
 418       --  An interesting little kludge here. If the previous token is a
 419       --  semicolon, then there is no way that we can legitimately need another
 420       --  semicolon. This could only arise in an error situation where an error
 421       --  has already been signalled. By simply ignoring the request for a
 422       --  semicolon in this case, we avoid some spurious missing semicolon
 423       --  messages.
 424
 425       elsif Prev_Token = Tok_Semicolon then
 426          return;
 427
 428       --  If the current token is | then this is a reasonable place to suggest
 429       --  the possibility of a "C" confusion.
 430
 431       elsif Token = Tok_Vertical_Bar then
 432          Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?");
 433          Resync_Past_Semicolon;
 434          return;
 435
 436       --  Deal with pragma. If pragma is not at start of line, it is considered
 437       --  misplaced otherwise we treat it as a normal missing semicolong case.
 438
 439       elsif Token = Tok_Pragma
 440         and then not Token_Is_At_Start_Of_Line
 441       then
 442          P_Pragmas_Misplaced;
 443
 444          if Token = Tok_Semicolon then
 445             Scan;
 446             return;
 447          end if;
 448       end if;
 449
 450       --  If none of those tests return, we really have a missing semicolon
 451
 452       Error_Msg_AP ("|missing "";""");
 453       return;
 454    end T_Semicolon;
 455
 456    ------------
 457    -- T_Then --
 458    ------------
 459
 460    procedure T_Then is
 461    begin
 462       Check_Token (Tok_Then, AP);
 463    end T_Then;
 464
 465    ------------
 466    -- T_Type --
 467    ------------
 468
 469    procedure T_Type is
 470    begin
 471       Check_Token (Tok_Type, BC);
 472    end T_Type;
 473
 474    -----------
 475    -- T_Use --
 476    -----------
 477
 478    procedure T_Use is
 479    begin
 480       Check_Token (Tok_Use, SC);
 481    end T_Use;
 482
 483    ------------
 484    -- T_When --
 485    ------------
 486
 487    procedure T_When is
 488    begin
 489       Check_Token (Tok_When, SC);
 490    end T_When;
 491
 492    ------------
 493    -- T_With --
 494    ------------
 495
 496    procedure T_With is
 497    begin
 498       Check_Token (Tok_With, BC);
 499    end T_With;
 500
 501    --------------
 502    -- TF_Arrow --
 503    --------------
 504
 505    procedure TF_Arrow is
 506       Scan_State : Saved_Scan_State;
 507
 508    begin
 509       if Token = Tok_Arrow then
 510          Scan; -- skip arrow and we are done
 511
 512       elsif Token = Tok_Colon_Equal then
 513          T_Arrow; -- Let T_Arrow give the message
 514
 515       else
 516          T_Arrow; -- give missing arrow message
 517          Save_Scan_State (Scan_State); -- at start of junk tokens
 518
 519          loop
 520             if Prev_Token_Ptr < Current_Line_Start
 521               or else Token = Tok_Semicolon
 522               or else Token = Tok_EOF
 523             then
 524                Restore_Scan_State (Scan_State); -- to where we were!
 525                return;
 526             end if;
 527
 528             Scan; -- continue search!
 529
 530             if Token = Tok_Arrow then
 531                Scan; -- past arrow
 532                return;
 533             end if;
 534          end loop;
 535       end if;
 536    end TF_Arrow;
 537
 538    -----------
 539    -- TF_Is --
 540    -----------
 541
 542    procedure TF_Is is
 543       Scan_State : Saved_Scan_State;
 544
 545    begin
 546       if Token = Tok_Is then
 547          T_Is; -- past IS and we are done
 548
 549       --  Allow OF or => or = in place of IS (with error message)
 550
 551       elsif Token = Tok_Of
 552         or else Token = Tok_Arrow
 553         or else Token = Tok_Equal
 554       then
 555          T_Is; -- give missing IS message and skip bad token
 556
 557       else
 558          T_Is; -- give missing IS message
 559          Save_Scan_State (Scan_State); -- at start of junk tokens
 560
 561          loop
 562             if Prev_Token_Ptr < Current_Line_Start
 563               or else Token = Tok_Semicolon
 564               or else Token = Tok_EOF
 565             then
 566                Restore_Scan_State (Scan_State); -- to where we were!
 567                return;
 568             end if;
 569
 570             Scan; -- continue search!
 571
 572             if Token = Tok_Is
 573               or else Token = Tok_Of
 574               or else Token = Tok_Arrow
 575             then
 576                Scan; -- past IS or OF or =>
 577                return;
 578             end if;
 579          end loop;
 580       end if;
 581    end TF_Is;
 582
 583    -------------
 584    -- TF_Loop --
 585    -------------
 586
 587    procedure TF_Loop is
 588       Scan_State : Saved_Scan_State;
 589
 590    begin
 591       if Token = Tok_Loop then
 592          Scan; -- past LOOP and we are done
 593
 594       --  Allow DO or THEN in place of LOOP
 595
 596       elsif Token = Tok_Then or else Token = Tok_Do then
 597          T_Loop; -- give missing LOOP message
 598
 599       else
 600          T_Loop; -- give missing LOOP message
 601          Save_Scan_State (Scan_State); -- at start of junk tokens
 602
 603          loop
 604             if Prev_Token_Ptr < Current_Line_Start
 605               or else Token = Tok_Semicolon
 606               or else Token = Tok_EOF
 607             then
 608                Restore_Scan_State (Scan_State); -- to where we were!
 609                return;
 610             end if;
 611
 612             Scan; -- continue search!
 613
 614             if Token = Tok_Loop or else Token = Tok_Then then
 615                Scan; -- past loop or then (message already generated)
 616                return;
 617             end if;
 618          end loop;
 619       end if;
 620    end TF_Loop;
 621
 622    --------------
 623    -- TF_Return--
 624    --------------
 625
 626    procedure TF_Return is
 627       Scan_State : Saved_Scan_State;
 628
 629    begin
 630       if Token = Tok_Return then
 631          Scan; -- skip RETURN and we are done
 632
 633       else
 634          Error_Msg_SC ("missing RETURN");
 635          Save_Scan_State (Scan_State); -- at start of junk tokens
 636
 637          loop
 638             if Prev_Token_Ptr < Current_Line_Start
 639               or else Token = Tok_Semicolon
 640               or else Token = Tok_EOF
 641             then
 642                Restore_Scan_State (Scan_State); -- to where we were!
 643                return;
 644             end if;
 645
 646             Scan; -- continue search!
 647
 648             if Token = Tok_Return then
 649                Scan; -- past RETURN
 650                return;
 651             end if;
 652          end loop;
 653       end if;
 654    end TF_Return;
 655
 656    ------------------
 657    -- TF_Semicolon --
 658    ------------------
 659
 660    procedure TF_Semicolon is
 661       Scan_State : Saved_Scan_State;
 662
 663    begin
 664       if Token = Tok_Semicolon then
 665          T_Semicolon;
 666          return;
 667
 668       --  An interesting little kludge here. If the previous token is a
 669       --  semicolon, then there is no way that we can legitimately need
 670       --  another semicolon. This could only arise in an error situation
 671       --  where an error has already been signalled. By simply ignoring
 672       --  the request for a semicolon in this case, we avoid some spurious
 673       --  missing semicolon messages.
 674
 675       elsif Prev_Token = Tok_Semicolon then
 676          return;
 677
 678       else
 679          --  Deal with pragma. If pragma is not at start of line, it is
 680          --  considered misplaced otherwise we treat it as a normal
 681          --  missing semicolong case.
 682
 683          if Token = Tok_Pragma
 684            and then not Token_Is_At_Start_Of_Line
 685          then
 686             P_Pragmas_Misplaced;
 687
 688             if Token = Tok_Semicolon then
 689                T_Semicolon;
 690                return;
 691             end if;
 692          end if;
 693
 694          --  Here we definitely have a missing semicolon, so give message
 695
 696          T_Semicolon;
 697
 698          --  Scan out junk on rest of line. Scan stops on END keyword, since
 699          --  that seems to help avoid cascaded errors.
 700
 701          Save_Scan_State (Scan_State); -- at start of junk tokens
 702
 703          loop
 704             if Prev_Token_Ptr < Current_Line_Start
 705               or else Token = Tok_EOF
 706               or else Token = Tok_End
 707             then
 708                Restore_Scan_State (Scan_State); -- to where we were
 709                return;
 710             end if;
 711
 712             Scan; -- continue search
 713
 714             if Token = Tok_Semicolon then
 715                T_Semicolon;
 716                return;
 717
 718             elsif Token in Token_Class_After_SM then
 719                return;
 720             end if;
 721          end loop;
 722       end if;
 723    end TF_Semicolon;
 724
 725    -------------
 726    -- TF_Then --
 727    -------------
 728
 729    procedure TF_Then is
 730       Scan_State : Saved_Scan_State;
 731
 732    begin
 733       if Token = Tok_Then then
 734          Scan; -- past THEN and we are done
 735
 736       else
 737          T_Then; -- give missing THEN message
 738          Save_Scan_State (Scan_State); -- at start of junk tokens
 739
 740          loop
 741             if Prev_Token_Ptr < Current_Line_Start
 742               or else Token = Tok_Semicolon
 743               or else Token = Tok_EOF
 744             then
 745                Restore_Scan_State (Scan_State); -- to where we were
 746                return;
 747             end if;
 748
 749             Scan; -- continue search!
 750
 751             if Token = Tok_Then then
 752                Scan; -- past THEN
 753                return;
 754             end if;
 755          end loop;
 756       end if;
 757    end TF_Then;
 758
 759    ------------
 760    -- TF_Use --
 761    ------------
 762
 763    procedure TF_Use is
 764       Scan_State : Saved_Scan_State;
 765
 766    begin
 767       if Token = Tok_Use then
 768          Scan; -- past USE and we are done
 769
 770       else
 771          T_Use; -- give USE expected message
 772          Save_Scan_State (Scan_State); -- at start of junk tokens
 773
 774          loop
 775             if Prev_Token_Ptr < Current_Line_Start
 776               or else Token = Tok_Semicolon
 777               or else Token = Tok_EOF
 778             then
 779                Restore_Scan_State (Scan_State); -- to where we were
 780                return;
 781             end if;
 782
 783             Scan; -- continue search!
 784
 785             if Token = Tok_Use then
 786                Scan; -- past use
 787                return;
 788             end if;
 789          end loop;
 790       end if;
 791    end TF_Use;
 792
 793    ------------------
 794    -- U_Left_Paren --
 795    ------------------
 796
 797    procedure U_Left_Paren is
 798    begin
 799       if Token = Tok_Left_Paren then
 800          Scan;
 801       else
 802          Error_Msg_AP ("missing ""(""!");
 803       end if;
 804    end U_Left_Paren;
 805
 806    -------------------
 807    -- U_Right_Paren --
 808    -------------------
 809
 810    procedure U_Right_Paren is
 811    begin
 812       if Token = Tok_Right_Paren then
 813          Scan;
 814       else
 815          Error_Msg_AP ("missing "")""!");
 816       end if;
 817    end U_Right_Paren;
 818
 819    -----------------
 820    -- Wrong_Token --
 821    -----------------
 822
 823    procedure Wrong_Token (T : Token_Type; P : Position) is
 824       Missing  : constant String := "missing ";
 825       Image    : constant String := Token_Type'Image (T);
 826       Tok_Name : constant String := Image (5 .. Image'Length);
 827       M        : constant String := Missing & Tok_Name;
 828
 829    begin
 830       if Token = Tok_Semicolon then
 831          Scan;
 832
 833          if Token = T then
 834             Error_Msg_SP ("extra "";"" ignored");
 835             Scan;
 836          else
 837             Error_Msg_SP (M);
 838          end if;
 839
 840       elsif Token = Tok_Comma then
 841          Scan;
 842
 843          if Token = T then
 844             Error_Msg_SP ("extra "","" ignored");
 845             Scan;
 846
 847          else
 848             Error_Msg_SP (M);
 849          end if;
 850
 851       else
 852          case P is
 853             when SC => Error_Msg_SC (M);
 854             when BC => Error_Msg_BC (M);
 855             when AP => Error_Msg_AP (M);
 856          end case;
 857       end if;
 858    end Wrong_Token;
 859
 860 end Tchk;