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