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