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-2001 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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, 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       elsif Token = Tok_Colon then
 403          Error_Msg_SC (""":"" should be "";""");
 404          Scan;
 405
 406       elsif Token = Tok_Comma then
 407          Error_Msg_SC (""","" should be "";""");
 408          Scan;
 409
 410       elsif Token = Tok_Dot then
 411          Error_Msg_SC ("""."" should be "";""");
 412          Scan;
 413
 414       --  An interesting little kludge here. If the previous token is a
 415       --  semicolon, then there is no way that we can legitimately need
 416       --  another semicolon. This could only arise in an error situation
 417       --  where an error has already been signalled. By simply ignoring
 418       --  the request for a semicolon in this case, we avoid some spurious
 419       --  missing semicolon messages.
 420
 421       elsif Prev_Token = Tok_Semicolon then
 422          return;
 423
 424       --  If the current token is | then this is a reasonable
 425       --  place to suggest the possibility of a "C" confusion :-)
 426
 427       elsif Token = Tok_Vertical_Bar then
 428          Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?");
 429          Resync_Past_Semicolon;
 430
 431       --  Otherwise we really do have a missing semicolon
 432
 433       else
 434          Error_Msg_AP ("|missing "";""");
 435          return;
 436       end if;
 437
 438    end T_Semicolon;
 439
 440    ------------
 441    -- T_Then --
 442    ------------
 443
 444    procedure T_Then is
 445    begin
 446       Check_Token (Tok_Then, AP);
 447    end T_Then;
 448
 449    ------------
 450    -- T_Type --
 451    ------------
 452
 453    procedure T_Type is
 454    begin
 455       Check_Token (Tok_Type, BC);
 456    end T_Type;
 457
 458    -----------
 459    -- T_Use --
 460    -----------
 461
 462    procedure T_Use is
 463    begin
 464       Check_Token (Tok_Use, SC);
 465    end T_Use;
 466
 467    ------------
 468    -- T_When --
 469    ------------
 470
 471    procedure T_When is
 472    begin
 473       Check_Token (Tok_When, SC);
 474    end T_When;
 475
 476    ------------
 477    -- T_With --
 478    ------------
 479
 480    procedure T_With is
 481    begin
 482       Check_Token (Tok_With, BC);
 483    end T_With;
 484
 485    --------------
 486    -- TF_Arrow --
 487    --------------
 488
 489    procedure TF_Arrow is
 490       Scan_State : Saved_Scan_State;
 491
 492    begin
 493       if Token = Tok_Arrow then
 494          Scan; -- skip arrow and we are done
 495
 496       elsif Token = Tok_Colon_Equal then
 497          T_Arrow; -- Let T_Arrow give the message
 498
 499       else
 500          T_Arrow; -- give missing arrow message
 501          Save_Scan_State (Scan_State); -- at start of junk tokens
 502
 503          loop
 504             if Prev_Token_Ptr < Current_Line_Start
 505               or else Token = Tok_Semicolon
 506               or else Token = Tok_EOF
 507             then
 508                Restore_Scan_State (Scan_State); -- to where we were!
 509                return;
 510             end if;
 511
 512             Scan; -- continue search!
 513
 514             if Token = Tok_Arrow then
 515                Scan; -- past arrow
 516                return;
 517             end if;
 518          end loop;
 519       end if;
 520    end TF_Arrow;
 521
 522    -----------
 523    -- TF_Is --
 524    -----------
 525
 526    procedure TF_Is is
 527       Scan_State : Saved_Scan_State;
 528
 529    begin
 530       if Token = Tok_Is then
 531          T_Is; -- past IS and we are done
 532
 533       --  Allow OF or => or = in place of IS (with error message)
 534
 535       elsif Token = Tok_Of
 536         or else Token = Tok_Arrow
 537         or else Token = Tok_Equal
 538       then
 539          T_Is; -- give missing IS message and skip bad token
 540
 541       else
 542          T_Is; -- give missing IS message
 543          Save_Scan_State (Scan_State); -- at start of junk tokens
 544
 545          loop
 546             if Prev_Token_Ptr < Current_Line_Start
 547               or else Token = Tok_Semicolon
 548               or else Token = Tok_EOF
 549             then
 550                Restore_Scan_State (Scan_State); -- to where we were!
 551                return;
 552             end if;
 553
 554             Scan; -- continue search!
 555
 556             if Token = Tok_Is
 557               or else Token = Tok_Of
 558               or else Token = Tok_Arrow
 559             then
 560                Scan; -- past IS or OF or =>
 561                return;
 562             end if;
 563          end loop;
 564       end if;
 565    end TF_Is;
 566
 567    -------------
 568    -- TF_Loop --
 569    -------------
 570
 571    procedure TF_Loop is
 572       Scan_State : Saved_Scan_State;
 573
 574    begin
 575       if Token = Tok_Loop then
 576          Scan; -- past LOOP and we are done
 577
 578       --  Allow DO or THEN in place of LOOP
 579
 580       elsif Token = Tok_Then or else Token = Tok_Do then
 581          T_Loop; -- give missing LOOP message
 582
 583       else
 584          T_Loop; -- give missing LOOP message
 585          Save_Scan_State (Scan_State); -- at start of junk tokens
 586
 587          loop
 588             if Prev_Token_Ptr < Current_Line_Start
 589               or else Token = Tok_Semicolon
 590               or else Token = Tok_EOF
 591             then
 592                Restore_Scan_State (Scan_State); -- to where we were!
 593                return;
 594             end if;
 595
 596             Scan; -- continue search!
 597
 598             if Token = Tok_Loop or else Token = Tok_Then then
 599                Scan; -- past loop or then (message already generated)
 600                return;
 601             end if;
 602          end loop;
 603       end if;
 604    end TF_Loop;
 605
 606    --------------
 607    -- TF_Return--
 608    --------------
 609
 610    procedure TF_Return is
 611       Scan_State : Saved_Scan_State;
 612
 613    begin
 614       if Token = Tok_Return then
 615          Scan; -- skip RETURN and we are done
 616
 617       else
 618          Error_Msg_SC ("missing RETURN");
 619          Save_Scan_State (Scan_State); -- at start of junk tokens
 620
 621          loop
 622             if Prev_Token_Ptr < Current_Line_Start
 623               or else Token = Tok_Semicolon
 624               or else Token = Tok_EOF
 625             then
 626                Restore_Scan_State (Scan_State); -- to where we were!
 627                return;
 628             end if;
 629
 630             Scan; -- continue search!
 631
 632             if Token = Tok_Return then
 633                Scan; -- past RETURN
 634                return;
 635             end if;
 636          end loop;
 637       end if;
 638    end TF_Return;
 639
 640    ------------------
 641    -- TF_Semicolon --
 642    ------------------
 643
 644    procedure TF_Semicolon is
 645       Scan_State : Saved_Scan_State;
 646
 647    begin
 648       if Token = Tok_Semicolon then
 649          T_Semicolon;
 650          return;
 651
 652       --  An interesting little kludge here. If the previous token is a
 653       --  semicolon, then there is no way that we can legitimately need
 654       --  another semicolon. This could only arise in an error situation
 655       --  where an error has already been signalled. By simply ignoring
 656       --  the request for a semicolon in this case, we avoid some spurious
 657       --  missing semicolon messages.
 658
 659       elsif Prev_Token = Tok_Semicolon then
 660          return;
 661
 662       else
 663          if Token = Tok_Pragma then
 664             P_Pragmas_Misplaced;
 665
 666             if Token = Tok_Semicolon then
 667                T_Semicolon;
 668                return;
 669             end if;
 670          end if;
 671
 672          T_Semicolon; -- give missing semicolon message
 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_EOF
 678             then
 679                Restore_Scan_State (Scan_State); -- to where we were
 680                return;
 681             end if;
 682
 683             Scan; -- continue search
 684
 685             if Token = Tok_Semicolon then
 686                T_Semicolon;
 687                return;
 688
 689             elsif Token in Token_Class_After_SM then
 690                return;
 691             end if;
 692          end loop;
 693       end if;
 694    end TF_Semicolon;
 695
 696    -------------
 697    -- TF_Then --
 698    -------------
 699
 700    procedure TF_Then is
 701       Scan_State : Saved_Scan_State;
 702
 703    begin
 704       if Token = Tok_Then then
 705          Scan; -- past THEN and we are done
 706
 707       else
 708          T_Then; -- give missing THEN message
 709          Save_Scan_State (Scan_State); -- at start of junk tokens
 710
 711          loop
 712             if Prev_Token_Ptr < Current_Line_Start
 713               or else Token = Tok_Semicolon
 714               or else Token = Tok_EOF
 715             then
 716                Restore_Scan_State (Scan_State); -- to where we were
 717                return;
 718             end if;
 719
 720             Scan; -- continue search!
 721
 722             if Token = Tok_Then then
 723                Scan; -- past THEN
 724                return;
 725             end if;
 726          end loop;
 727       end if;
 728    end TF_Then;
 729
 730    ------------
 731    -- TF_Use --
 732    ------------
 733
 734    procedure TF_Use is
 735       Scan_State : Saved_Scan_State;
 736
 737    begin
 738       if Token = Tok_Use then
 739          Scan; -- past USE and we are done
 740
 741       else
 742          T_Use; -- give USE expected message
 743          Save_Scan_State (Scan_State); -- at start of junk tokens
 744
 745          loop
 746             if Prev_Token_Ptr < Current_Line_Start
 747               or else Token = Tok_Semicolon
 748               or else Token = Tok_EOF
 749             then
 750                Restore_Scan_State (Scan_State); -- to where we were
 751                return;
 752             end if;
 753
 754             Scan; -- continue search!
 755
 756             if Token = Tok_Use then
 757                Scan; -- past use
 758                return;
 759             end if;
 760          end loop;
 761       end if;
 762    end TF_Use;
 763
 764    -----------------
 765    -- Wrong_Token --
 766    -----------------
 767
 768    procedure Wrong_Token (T : Token_Type; P : Position) is
 769       Missing : constant String := "missing ";
 770       Image : constant String := Token_Type'Image (T);
 771       Tok_Name : constant String := Image (5 .. Image'Length);
 772       M : String (1 .. Missing'Length + Tok_Name'Length);
 773
 774    begin
 775       --  Set M to Missing & Tok_Name.
 776
 777       M (1 .. Missing'Length) := Missing;
 778       M (Missing'Length + 1 .. M'Last) := Tok_Name;
 779
 780       if Token = Tok_Semicolon then
 781          Scan;
 782
 783          if Token = T then
 784             Error_Msg_SP ("extra "";"" ignored");
 785             Scan;
 786          else
 787             Error_Msg_SP (M);
 788          end if;
 789
 790       elsif Token = Tok_Comma then
 791          Scan;
 792
 793          if Token = T then
 794             Error_Msg_SP ("extra "","" ignored");
 795             Scan;
 796
 797          else
 798             Error_Msg_SP (M);
 799          end if;
 800
 801       else
 802          case P is
 803             when SC => Error_Msg_SC (M);
 804             when BC => Error_Msg_BC (M);
 805             when AP => Error_Msg_AP (M);
 806          end case;
 807       end if;
 808    end Wrong_Token;
 809
 810 end Tchk;