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