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-2006, 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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 --  Token scan routines
  28
  29 --  Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync
  30
  31 separate (Par)
  32 package body Tchk is
  33
  34    type Position is (SC, BC, AP);
  35    --  Specify position of error message (see Error_Msg_SC/BC/AP)
  36
  37    -----------------------
  38    -- Local Subprograms --
  39    -----------------------
  40
  41    procedure Check_Token (T : Token_Type; P : Position);
  42    pragma Inline (Check_Token);
  43    --  Called by T_xx routines to check for reserved keyword token. P is the
  44    --  position of the error message if the token is missing (see Wrong_Token)
  45
  46    procedure Wrong_Token (T : Token_Type; P : Position);
  47    --  Called when scanning a reserved keyword when the keyword is not
  48    --  present. T is the token type for the keyword, and P indicates the
  49    --  position to be used to place a message relative to the current
  50    --  token if the keyword is not located nearby.
  51
  52    -----------------
  53    -- Check_Token --
  54    -----------------
  55
  56    procedure Check_Token (T : Token_Type; P : Position) is
  57    begin
  58       if Token = T then
  59          Scan;
  60          return;
  61       else
  62          Wrong_Token (T, P);
  63       end if;
  64    end Check_Token;
  65
  66    -------------
  67    -- T_Abort --
  68    -------------
  69
  70    procedure T_Abort is
  71    begin
  72       Check_Token (Tok_Abort, SC);
  73    end T_Abort;
  74
  75    -------------
  76    -- T_Arrow --
  77    -------------
  78
  79    procedure T_Arrow is
  80    begin
  81       if Token = Tok_Arrow then
  82          Scan;
  83
  84       --  A little recovery helper, accept then in place of =>
  85
  86       elsif Token = Tok_Then then
  87          Error_Msg_BC ("missing ""='>""");
  88          Scan; -- past THEN used in place of =>
  89
  90       elsif Token = Tok_Colon_Equal then
  91          Error_Msg_SC (""":="" should be ""='>""");
  92          Scan; -- past := used in place of =>
  93
  94       else
  95          Error_Msg_AP ("missing ""='>""");
  96       end if;
  97    end T_Arrow;
  98
  99    ----------
 100    -- T_At --
 101    ----------
 102
 103    procedure T_At is
 104    begin
 105       Check_Token (Tok_At, SC);
 106    end T_At;
 107
 108    ------------
 109    -- T_Body --
 110    ------------
 111
 112    procedure T_Body is
 113    begin
 114       Check_Token (Tok_Body, BC);
 115    end T_Body;
 116
 117    -----------
 118    -- T_Box --
 119    -----------
 120
 121    procedure T_Box is
 122    begin
 123       if Token = Tok_Box then
 124          Scan;
 125       else
 126          Error_Msg_AP ("missing ""'<'>""");
 127       end if;
 128    end T_Box;
 129
 130    -------------
 131    -- T_Colon --
 132    -------------
 133
 134    procedure T_Colon is
 135    begin
 136       if Token = Tok_Colon then
 137          Scan;
 138       else
 139          Error_Msg_AP ("missing "":""");
 140       end if;
 141    end T_Colon;
 142
 143    -------------------
 144    -- T_Colon_Equal --
 145    -------------------
 146
 147    procedure T_Colon_Equal is
 148    begin
 149       if Token = Tok_Colon_Equal then
 150          Scan;
 151
 152       elsif Token = Tok_Equal then
 153          Error_Msg_SC ("""="" should be "":=""");
 154          Scan;
 155
 156       elsif Token = Tok_Colon then
 157          Error_Msg_SC (""":"" should be "":=""");
 158          Scan;
 159
 160       elsif Token = Tok_Is then
 161          Error_Msg_SC ("IS should be "":=""");
 162          Scan;
 163
 164       else
 165          Error_Msg_AP ("missing "":=""");
 166       end if;
 167    end T_Colon_Equal;
 168
 169    -------------
 170    -- T_Comma --
 171    -------------
 172
 173    procedure T_Comma is
 174    begin
 175       if Token = Tok_Comma then
 176          Scan;
 177
 178       else
 179          if Token = Tok_Pragma then
 180             P_Pragmas_Misplaced;
 181          end if;
 182
 183          if Token = Tok_Comma then
 184             Scan;
 185          else
 186             Error_Msg_AP ("missing "",""");
 187          end if;
 188       end if;
 189
 190       if Token = Tok_Pragma then
 191          P_Pragmas_Misplaced;
 192       end if;
 193    end T_Comma;
 194
 195    ---------------
 196    -- T_Dot_Dot --
 197    ---------------
 198
 199    procedure T_Dot_Dot is
 200    begin
 201       if Token = Tok_Dot_Dot then
 202          Scan;
 203       else
 204          Error_Msg_AP ("missing ""..""");
 205       end if;
 206    end T_Dot_Dot;
 207
 208    -----------
 209    -- T_For --
 210    -----------
 211
 212    procedure T_For is
 213    begin
 214       Check_Token (Tok_For, AP);
 215    end T_For;
 216
 217    -----------------------
 218    -- T_Greater_Greater --
 219    -----------------------
 220
 221    procedure T_Greater_Greater is
 222    begin
 223       if Token = Tok_Greater_Greater then
 224          Scan;
 225       else
 226          Error_Msg_AP ("missing ""'>'>""");
 227       end if;
 228    end T_Greater_Greater;
 229
 230    ------------------
 231    -- T_Identifier --
 232    ------------------
 233
 234    procedure T_Identifier is
 235    begin
 236       if Token = Tok_Identifier then
 237          Scan;
 238       elsif Token in Token_Class_Literal then
 239          Error_Msg_SC ("identifier expected");
 240          Scan;
 241       else
 242          Error_Msg_AP ("identifier expected");
 243       end if;
 244    end T_Identifier;
 245
 246    ----------
 247    -- T_In --
 248    ----------
 249
 250    procedure T_In is
 251    begin
 252       Check_Token (Tok_In, AP);
 253    end T_In;
 254
 255    ----------
 256    -- T_Is --
 257    ----------
 258
 259    procedure T_Is is
 260    begin
 261       if Token = Tok_Is then
 262          Scan;
 263
 264          Ignore (Tok_Semicolon);
 265
 266       --  Allow OF, => or = to substitute for IS with complaint
 267
 268       elsif Token = Tok_Arrow
 269         or else Token = Tok_Of
 270         or else Token = Tok_Equal
 271       then
 272          Error_Msg_SC ("missing IS");
 273          Scan; -- token used in place of IS
 274       else
 275          Wrong_Token (Tok_Is, AP);
 276       end if;
 277
 278       while Token = Tok_Is loop
 279          Error_Msg_SC ("extra IS ignored");
 280          Scan;
 281       end loop;
 282    end T_Is;
 283
 284    ------------------
 285    -- T_Left_Paren --
 286    ------------------
 287
 288    procedure T_Left_Paren is
 289    begin
 290       if Token = Tok_Left_Paren then
 291          Scan;
 292       else
 293          Error_Msg_AP ("missing ""(""");
 294       end if;
 295    end T_Left_Paren;
 296
 297    ------------
 298    -- T_Loop --
 299    ------------
 300
 301    procedure T_Loop is
 302    begin
 303       if Token = Tok_Do then
 304          Error_Msg_SC ("LOOP expected");
 305          Scan;
 306       else
 307          Check_Token (Tok_Loop, AP);
 308       end if;
 309    end T_Loop;
 310
 311    -----------
 312    -- T_Mod --
 313    -----------
 314
 315    procedure T_Mod is
 316    begin
 317       Check_Token (Tok_Mod, AP);
 318    end T_Mod;
 319
 320    -----------
 321    -- T_New --
 322    -----------
 323
 324    procedure T_New is
 325    begin
 326       Check_Token (Tok_New, AP);
 327    end T_New;
 328
 329    ----------
 330    -- T_Of --
 331    ----------
 332
 333    procedure T_Of is
 334    begin
 335       Check_Token (Tok_Of, AP);
 336    end T_Of;
 337
 338    ----------
 339    -- T_Or --
 340    ----------
 341
 342    procedure T_Or is
 343    begin
 344       Check_Token (Tok_Or, AP);
 345    end T_Or;
 346
 347    ---------------
 348    -- T_Private --
 349    ---------------
 350
 351    procedure T_Private is
 352    begin
 353       Check_Token (Tok_Private, SC);
 354    end T_Private;
 355
 356    -------------
 357    -- T_Range --
 358    -------------
 359
 360    procedure T_Range is
 361    begin
 362       Check_Token (Tok_Range, AP);
 363    end T_Range;
 364
 365    --------------
 366    -- T_Record --
 367    --------------
 368
 369    procedure T_Record is
 370    begin
 371       Check_Token (Tok_Record, AP);
 372    end T_Record;
 373
 374    -------------------
 375    -- T_Right_Paren --
 376    -------------------
 377
 378    procedure T_Right_Paren is
 379    begin
 380       if Token = Tok_Right_Paren then
 381          Scan;
 382       else
 383          Error_Msg_AP ("missing "")""");
 384       end if;
 385    end T_Right_Paren;
 386
 387    -----------------
 388    -- T_Semicolon --
 389    -----------------
 390
 391    procedure T_Semicolon is
 392    begin
 393
 394       if Token = Tok_Semicolon then
 395          Scan;
 396
 397          if Token = Tok_Semicolon then
 398             Error_Msg_SC ("extra "";"" ignored");
 399             Scan;
 400          end if;
 401
 402          return;
 403
 404       elsif Token = Tok_Colon then
 405          Error_Msg_SC (""":"" should be "";""");
 406          Scan;
 407          return;
 408
 409       elsif Token = Tok_Comma then
 410          Error_Msg_SC (""","" should be "";""");
 411          Scan;
 412          return;
 413
 414       elsif Token = Tok_Dot then
 415          Error_Msg_SC ("""."" should be "";""");
 416          Scan;
 417          return;
 418
 419       --  An interesting little kludge here. If the previous token is a
 420       --  semicolon, then there is no way that we can legitimately need
 421       --  another semicolon. This could only arise in an error situation
 422       --  where an error has already been signalled. By simply ignoring
 423       --  the request for a semicolon in this case, we avoid some spurious
 424       --  missing semicolon messages.
 425
 426       elsif Prev_Token = Tok_Semicolon then
 427          return;
 428
 429       --  If the current token is | then this is a reasonable
 430       --  place to suggest the possibility of a "C" confusion :-)
 431
 432       elsif Token = Tok_Vertical_Bar then
 433          Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?");
 434          Resync_Past_Semicolon;
 435          return;
 436
 437       --  Deal with pragma. If pragma is not at start of line, it is
 438       --  considered misplaced otherwise we treat it as a normal
 439       --  missing semicolong case.
 440
 441       elsif Token = Tok_Pragma
 442         and then not Token_Is_At_Start_Of_Line
 443       then
 444          P_Pragmas_Misplaced;
 445
 446          if Token = Tok_Semicolon then
 447             Scan;
 448             return;
 449          end if;
 450       end if;
 451
 452       --  If none of those tests return, we really have a missing semicolon
 453
 454       Error_Msg_AP ("|missing "";""");
 455       return;
 456    end T_Semicolon;
 457
 458    ------------
 459    -- T_Then --
 460    ------------
 461
 462    procedure T_Then is
 463    begin
 464       Check_Token (Tok_Then, AP);
 465    end T_Then;
 466
 467    ------------
 468    -- T_Type --
 469    ------------
 470
 471    procedure T_Type is
 472    begin
 473       Check_Token (Tok_Type, BC);
 474    end T_Type;
 475
 476    -----------
 477    -- T_Use --
 478    -----------
 479
 480    procedure T_Use is
 481    begin
 482       Check_Token (Tok_Use, SC);
 483    end T_Use;
 484
 485    ------------
 486    -- T_When --
 487    ------------
 488
 489    procedure T_When is
 490    begin
 491       Check_Token (Tok_When, SC);
 492    end T_When;
 493
 494    ------------
 495    -- T_With --
 496    ------------
 497
 498    procedure T_With is
 499    begin
 500       Check_Token (Tok_With, BC);
 501    end T_With;
 502
 503    --------------
 504    -- TF_Arrow --
 505    --------------
 506
 507    procedure TF_Arrow is
 508       Scan_State : Saved_Scan_State;
 509
 510    begin
 511       if Token = Tok_Arrow then
 512          Scan; -- skip arrow and we are done
 513
 514       elsif Token = Tok_Colon_Equal then
 515          T_Arrow; -- Let T_Arrow give the message
 516
 517       else
 518          T_Arrow; -- give missing arrow message
 519          Save_Scan_State (Scan_State); -- at start of junk tokens
 520
 521          loop
 522             if Prev_Token_Ptr < Current_Line_Start
 523               or else Token = Tok_Semicolon
 524               or else Token = Tok_EOF
 525             then
 526                Restore_Scan_State (Scan_State); -- to where we were!
 527                return;
 528             end if;
 529
 530             Scan; -- continue search!
 531
 532             if Token = Tok_Arrow then
 533                Scan; -- past arrow
 534                return;
 535             end if;
 536          end loop;
 537       end if;
 538    end TF_Arrow;
 539
 540    -----------
 541    -- TF_Is --
 542    -----------
 543
 544    procedure TF_Is is
 545       Scan_State : Saved_Scan_State;
 546
 547    begin
 548       if Token = Tok_Is then
 549          T_Is; -- past IS and we are done
 550
 551       --  Allow OF or => or = in place of IS (with error message)
 552
 553       elsif Token = Tok_Of
 554         or else Token = Tok_Arrow
 555         or else Token = Tok_Equal
 556       then
 557          T_Is; -- give missing IS message and skip bad token
 558
 559       else
 560          T_Is; -- give missing IS message
 561          Save_Scan_State (Scan_State); -- at start of junk tokens
 562
 563          loop
 564             if Prev_Token_Ptr < Current_Line_Start
 565               or else Token = Tok_Semicolon
 566               or else Token = Tok_EOF
 567             then
 568                Restore_Scan_State (Scan_State); -- to where we were!
 569                return;
 570             end if;
 571
 572             Scan; -- continue search!
 573
 574             if Token = Tok_Is
 575               or else Token = Tok_Of
 576               or else Token = Tok_Arrow
 577             then
 578                Scan; -- past IS or OF or =>
 579                return;
 580             end if;
 581          end loop;
 582       end if;
 583    end TF_Is;
 584
 585    -------------
 586    -- TF_Loop --
 587    -------------
 588
 589    procedure TF_Loop is
 590       Scan_State : Saved_Scan_State;
 591
 592    begin
 593       if Token = Tok_Loop then
 594          Scan; -- past LOOP and we are done
 595
 596       --  Allow DO or THEN in place of LOOP
 597
 598       elsif Token = Tok_Then or else Token = Tok_Do then
 599          T_Loop; -- give missing LOOP message
 600
 601       else
 602          T_Loop; -- give missing LOOP message
 603          Save_Scan_State (Scan_State); -- at start of junk tokens
 604
 605          loop
 606             if Prev_Token_Ptr < Current_Line_Start
 607               or else Token = Tok_Semicolon
 608               or else Token = Tok_EOF
 609             then
 610                Restore_Scan_State (Scan_State); -- to where we were!
 611                return;
 612             end if;
 613
 614             Scan; -- continue search!
 615
 616             if Token = Tok_Loop or else Token = Tok_Then then
 617                Scan; -- past loop or then (message already generated)
 618                return;
 619             end if;
 620          end loop;
 621       end if;
 622    end TF_Loop;
 623
 624    --------------
 625    -- TF_Return--
 626    --------------
 627
 628    procedure TF_Return is
 629       Scan_State : Saved_Scan_State;
 630
 631    begin
 632       if Token = Tok_Return then
 633          Scan; -- skip RETURN and we are done
 634
 635       else
 636          Error_Msg_SC ("missing RETURN");
 637          Save_Scan_State (Scan_State); -- at start of junk tokens
 638
 639          loop
 640             if Prev_Token_Ptr < Current_Line_Start
 641               or else Token = Tok_Semicolon
 642               or else Token = Tok_EOF
 643             then
 644                Restore_Scan_State (Scan_State); -- to where we were!
 645                return;
 646             end if;
 647
 648             Scan; -- continue search!
 649
 650             if Token = Tok_Return then
 651                Scan; -- past RETURN
 652                return;
 653             end if;
 654          end loop;
 655       end if;
 656    end TF_Return;
 657
 658    ------------------
 659    -- TF_Semicolon --
 660    ------------------
 661
 662    procedure TF_Semicolon is
 663       Scan_State : Saved_Scan_State;
 664
 665    begin
 666       if Token = Tok_Semicolon then
 667          T_Semicolon;
 668          return;
 669
 670       --  An interesting little kludge here. If the previous token is a
 671       --  semicolon, then there is no way that we can legitimately need
 672       --  another semicolon. This could only arise in an error situation
 673       --  where an error has already been signalled. By simply ignoring
 674       --  the request for a semicolon in this case, we avoid some spurious
 675       --  missing semicolon messages.
 676
 677       elsif Prev_Token = Tok_Semicolon then
 678          return;
 679
 680       else
 681          --  Deal with pragma. If pragma is not at start of line, it is
 682          --  considered misplaced otherwise we treat it as a normal
 683          --  missing semicolong case.
 684
 685          if Token = Tok_Pragma
 686            and then not Token_Is_At_Start_Of_Line
 687          then
 688             P_Pragmas_Misplaced;
 689
 690             if Token = Tok_Semicolon then
 691                T_Semicolon;
 692                return;
 693             end if;
 694          end if;
 695
 696          --  Here we definitely have a missing semicolon, so give message
 697
 698          T_Semicolon;
 699
 700          --  Scan out junk on rest of line
 701
 702          Save_Scan_State (Scan_State); -- at start of junk tokens
 703
 704          loop
 705             if Prev_Token_Ptr < Current_Line_Start
 706               or else Token = Tok_EOF
 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    -- Wrong_Token --
 795    -----------------
 796
 797    procedure Wrong_Token (T : Token_Type; P : Position) is
 798       Missing  : constant String := "missing ";
 799       Image    : constant String := Token_Type'Image (T);
 800       Tok_Name : constant String := Image (5 .. Image'Length);
 801       M        : constant String := Missing & Tok_Name;
 802
 803    begin
 804       if Token = Tok_Semicolon then
 805          Scan;
 806
 807          if Token = T then
 808             Error_Msg_SP ("extra "";"" ignored");
 809             Scan;
 810          else
 811             Error_Msg_SP (M);
 812          end if;
 813
 814       elsif Token = Tok_Comma then
 815          Scan;
 816
 817          if Token = T then
 818             Error_Msg_SP ("extra "","" ignored");
 819             Scan;
 820
 821          else
 822             Error_Msg_SP (M);
 823          end if;
 824
 825       else
 826          case P is
 827             when SC => Error_Msg_SC (M);
 828             when BC => Error_Msg_BC (M);
 829             when AP => Error_Msg_AP (M);
 830          end case;
 831       end if;
 832    end Wrong_Token;
 833
 834 end Tchk;