1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- Token scan routines
28 -- Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync
33 type Position is (SC, BC, AP);
34 -- Specify position of error message (see Error_Msg_SC/BC/AP)
36 -----------------------
37 -- Local Subprograms --
38 -----------------------
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)
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.
55 procedure Check_Token (T : Token_Type; P : Position) is
71 Check_Token (Tok_Abort, SC);
80 if Token = Tok_Arrow then
83 -- A little recovery helper, accept then in place of =>
85 elsif Token = Tok_Then then
86 Error_Msg_BC -- CODEFIX
87 ("|THEN should be ""='>""");
88 Scan; -- past THEN used in place of =>
90 elsif Token = Tok_Colon_Equal then
91 Error_Msg_SC -- CODEFIX
92 ("|"":="" should be ""='>""");
93 Scan; -- past := used in place of =>
96 Error_Msg_AP -- CODEFIX
107 Check_Token (Tok_At, SC);
116 Check_Token (Tok_Body, BC);
125 if Token = Tok_Box then
128 Error_Msg_AP -- CODEFIX
129 ("missing ""'<'>""");
139 if Token = Tok_Colon then
142 Error_Msg_AP -- CODEFIX
151 procedure T_Colon_Equal is
153 if Token = Tok_Colon_Equal then
156 elsif Token = Tok_Equal then
157 Error_Msg_SC -- CODEFIX
158 ("|""="" should be "":=""");
161 elsif Token = Tok_Colon then
162 Error_Msg_SC -- CODEFIX
163 ("|"":"" should be "":=""");
166 elsif Token = Tok_Is then
167 Error_Msg_SC -- CODEFIX
168 ("|IS should be "":=""");
172 Error_Msg_AP -- CODEFIX
183 if Token = Tok_Comma then
187 if Token = Tok_Pragma then
191 if Token = Tok_Comma then
194 Error_Msg_AP -- CODEFIX
199 if Token = Tok_Pragma then
208 procedure T_Dot_Dot is
210 if Token = Tok_Dot_Dot then
213 Error_Msg_AP -- CODEFIX
224 Check_Token (Tok_For, AP);
227 -----------------------
228 -- T_Greater_Greater --
229 -----------------------
231 procedure T_Greater_Greater is
233 if Token = Tok_Greater_Greater then
236 Error_Msg_AP -- CODEFIX
237 ("missing ""'>'>""");
239 end T_Greater_Greater;
245 procedure T_Identifier is
247 if Token = Tok_Identifier then
249 elsif Token in Token_Class_Literal then
250 Error_Msg_SC ("identifier expected");
253 Error_Msg_AP ("identifier expected");
263 Check_Token (Tok_In, AP);
272 Ignore (Tok_Semicolon);
274 -- If we have IS scan past it
276 if Token = Tok_Is then
279 -- And ignore any following semicolons
281 Ignore (Tok_Semicolon);
283 -- Allow OF, => or = to substitute for IS with complaint
285 elsif Token = Tok_Arrow then
286 Error_Msg_SC -- CODEFIX
287 ("|""=>"" should be IS");
290 elsif Token = Tok_Of then
291 Error_Msg_SC -- CODEFIX
292 ("|OF should be IS");
295 elsif Token = Tok_Equal then
296 Error_Msg_SC -- CODEFIX
297 ("|""="" should be IS");
301 Wrong_Token (Tok_Is, AP);
304 -- Ignore extra IS keywords
306 while Token = Tok_Is loop
307 Error_Msg_SC -- CODEFIX
308 ("|extra IS ignored");
317 procedure T_Left_Paren is
319 if Token = Tok_Left_Paren then
322 Error_Msg_AP -- CODEFIX
333 if Token = Tok_Do then
334 Error_Msg_SC -- CODEFIX
338 Check_Token (Tok_Loop, AP);
348 Check_Token (Tok_Mod, AP);
357 Check_Token (Tok_New, AP);
366 Check_Token (Tok_Of, AP);
375 Check_Token (Tok_Or, AP);
382 procedure T_Private is
384 Check_Token (Tok_Private, SC);
393 Check_Token (Tok_Range, AP);
400 procedure T_Record is
402 Check_Token (Tok_Record, AP);
409 procedure T_Right_Paren is
411 if Token = Tok_Right_Paren then
414 Error_Msg_AP -- CODEFIX
423 procedure T_Semicolon is
426 if Token = Tok_Semicolon then
429 if Token = Tok_Semicolon then
430 Error_Msg_SC -- CODEFIX
431 ("|extra "";"" ignored");
437 elsif Token = Tok_Colon then
438 Error_Msg_SC -- CODEFIX
439 ("|"":"" should be "";""");
443 elsif Token = Tok_Comma then
444 Error_Msg_SC -- CODEFIX
445 ("|"","" should be "";""");
449 elsif Token = Tok_Dot then
450 Error_Msg_SC -- CODEFIX
451 ("|""."" should be "";""");
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.
461 elsif Prev_Token = Tok_Semicolon then
464 -- If the current token is | then this is a reasonable place to suggest
465 -- the possibility of a "C" confusion.
467 elsif Token = Tok_Vertical_Bar then
468 Error_Msg_SC -- CODEFIX
469 ("unexpected occurrence of ""'|"", did you mean OR'?");
470 Resync_Past_Semicolon;
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.
476 elsif Token = Tok_Pragma and then not Token_Is_At_Start_Of_Line then
479 if Token = Tok_Semicolon then
485 -- If none of those tests return, we really have a missing semicolon
487 Error_Msg_AP -- CODEFIX
498 Check_Token (Tok_Then, AP);
507 Check_Token (Tok_Type, BC);
516 Check_Token (Tok_Use, SC);
525 Check_Token (Tok_When, SC);
534 Check_Token (Tok_With, BC);
541 procedure TF_Arrow is
542 Scan_State : Saved_Scan_State;
545 if Token = Tok_Arrow then
546 Scan; -- skip arrow and we are done
548 elsif Token = Tok_Colon_Equal then
549 T_Arrow; -- Let T_Arrow give the message
552 T_Arrow; -- give missing arrow message
553 Save_Scan_State (Scan_State); -- at start of junk tokens
556 if Prev_Token_Ptr < Current_Line_Start
557 or else Token = Tok_Semicolon
558 or else Token = Tok_EOF
560 Restore_Scan_State (Scan_State); -- to where we were
564 Scan; -- continue search
566 if Token = Tok_Arrow then
579 Scan_State : Saved_Scan_State;
582 if Token = Tok_Is then
583 T_Is; -- past IS and we are done
585 -- Allow OF or => or = in place of IS (with error message)
588 or else Token = Tok_Arrow
589 or else Token = Tok_Equal
591 T_Is; -- give missing IS message and skip bad token
594 T_Is; -- give missing IS message
595 Save_Scan_State (Scan_State); -- at start of junk tokens
598 if Prev_Token_Ptr < Current_Line_Start
599 or else Token = Tok_Semicolon
600 or else Token = Tok_EOF
602 Restore_Scan_State (Scan_State); -- to where we were
606 Scan; -- continue search
609 or else Token = Tok_Of
610 or else Token = Tok_Arrow
612 Scan; -- past IS or OF or =>
624 Scan_State : Saved_Scan_State;
627 if Token = Tok_Loop then
628 Scan; -- past LOOP and we are done
630 -- Allow DO or THEN in place of LOOP
632 elsif Token = Tok_Then or else Token = Tok_Do then
633 T_Loop; -- give missing LOOP message
636 T_Loop; -- give missing LOOP message
637 Save_Scan_State (Scan_State); -- at start of junk tokens
640 if Prev_Token_Ptr < Current_Line_Start
641 or else Token = Tok_Semicolon
642 or else Token = Tok_EOF
644 Restore_Scan_State (Scan_State); -- to where we were
648 Scan; -- continue search
650 if Token = Tok_Loop or else Token = Tok_Then then
651 Scan; -- past loop or then (message already generated)
662 procedure TF_Return is
663 Scan_State : Saved_Scan_State;
666 if Token = Tok_Return then
667 Scan; -- skip RETURN and we are done
670 Error_Msg_SC -- CODEFIX
672 Save_Scan_State (Scan_State); -- at start of junk tokens
675 if Prev_Token_Ptr < Current_Line_Start
676 or else Token = Tok_Semicolon
677 or else Token = Tok_EOF
679 Restore_Scan_State (Scan_State); -- to where we were
683 Scan; -- continue search
685 if Token = Tok_Return then
697 procedure TF_Semicolon is
698 Scan_State : Saved_Scan_State;
701 if Token = Tok_Semicolon then
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.
712 elsif Prev_Token = Tok_Semicolon then
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.
720 if Token = Tok_Pragma
721 and then not Token_Is_At_Start_Of_Line
725 if Token = Tok_Semicolon then
731 -- Here we definitely have a missing semicolon, so give message
735 -- Scan out junk on rest of line. Scan stops on END keyword, since
736 -- that seems to help avoid cascaded errors.
738 Save_Scan_State (Scan_State); -- at start of junk tokens
741 if Prev_Token_Ptr < Current_Line_Start
742 or else Token = Tok_EOF
743 or else Token = Tok_End
745 Restore_Scan_State (Scan_State); -- to where we were
749 Scan; -- continue search
751 if Token = Tok_Semicolon then
755 elsif Token in Token_Class_After_SM then
767 Scan_State : Saved_Scan_State;
770 if Token = Tok_Then then
771 Scan; -- past THEN and we are done
774 T_Then; -- give missing THEN message
775 Save_Scan_State (Scan_State); -- at start of junk tokens
778 if Prev_Token_Ptr < Current_Line_Start
779 or else Token = Tok_Semicolon
780 or else Token = Tok_EOF
782 Restore_Scan_State (Scan_State); -- to where we were
786 Scan; -- continue search
788 if Token = Tok_Then then
801 Scan_State : Saved_Scan_State;
804 if Token = Tok_Use then
805 Scan; -- past USE and we are done
808 T_Use; -- give USE expected message
809 Save_Scan_State (Scan_State); -- at start of junk tokens
812 if Prev_Token_Ptr < Current_Line_Start
813 or else Token = Tok_Semicolon
814 or else Token = Tok_EOF
816 Restore_Scan_State (Scan_State); -- to where we were
820 Scan; -- continue search
822 if Token = Tok_Use then
834 procedure U_Left_Paren is
836 if Token = Tok_Left_Paren then
839 Error_Msg_AP -- CODEFIX
848 procedure U_Right_Paren is
850 if Token = Tok_Right_Paren then
853 Error_Msg_AP -- CODEFIX
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;
869 if Token = Tok_Semicolon then
873 Error_Msg_SP -- CODEFIX
874 ("|extra "";"" ignored");
880 elsif Token = Tok_Comma then
884 Error_Msg_SP -- CODEFIX
885 ("|extra "","" ignored");
894 when SC => Error_Msg_SC (M);
895 when BC => Error_Msg_BC (M);
896 when AP => Error_Msg_AP (M);