1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2009, 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
47 -- present. T is the token type for the keyword, and P indicates the
48 -- position to be used to place a message relative to the current
49 -- token if the keyword is 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 ("|THEN should be ""='>""");
87 Scan; -- past THEN used in place of =>
89 elsif Token = Tok_Colon_Equal then
90 Error_Msg_SC ("|"":="" should be ""='>""");
91 Scan; -- past := used in place of =>
94 Error_Msg_AP ("missing ""='>""");
104 Check_Token (Tok_At, SC);
113 Check_Token (Tok_Body, BC);
122 if Token = Tok_Box then
125 Error_Msg_AP ("missing ""'<'>""");
135 if Token = Tok_Colon then
138 Error_Msg_AP ("missing "":""");
146 procedure T_Colon_Equal is
148 if Token = Tok_Colon_Equal then
151 elsif Token = Tok_Equal then
152 Error_Msg_SC ("|""="" should be "":=""");
155 elsif Token = Tok_Colon then
156 Error_Msg_SC ("|"":"" should be "":=""");
159 elsif Token = Tok_Is then
160 Error_Msg_SC ("|IS should be "":=""");
164 Error_Msg_AP ("missing "":=""");
174 if Token = Tok_Comma then
178 if Token = Tok_Pragma then
182 if Token = Tok_Comma then
185 Error_Msg_AP ("missing "",""");
189 if Token = Tok_Pragma then
198 procedure T_Dot_Dot is
200 if Token = Tok_Dot_Dot then
203 Error_Msg_AP ("missing ""..""");
213 Check_Token (Tok_For, AP);
216 -----------------------
217 -- T_Greater_Greater --
218 -----------------------
220 procedure T_Greater_Greater is
222 if Token = Tok_Greater_Greater then
225 Error_Msg_AP ("missing ""'>'>""");
227 end T_Greater_Greater;
233 procedure T_Identifier is
235 if Token = Tok_Identifier then
237 elsif Token in Token_Class_Literal then
238 Error_Msg_SC ("identifier expected");
241 Error_Msg_AP ("identifier expected");
251 Check_Token (Tok_In, AP);
260 Ignore (Tok_Semicolon);
262 -- If we have IS scan past it
264 if Token = Tok_Is then
267 -- And ignore any following semicolons
269 Ignore (Tok_Semicolon);
271 -- Allow OF, => or = to substitute for IS with complaint
273 elsif Token = Tok_Arrow then
274 Error_Msg_SC ("|""=>"" should be IS");
277 elsif Token = Tok_Of then
278 Error_Msg_SC ("|OF should be IS");
281 elsif Token = Tok_Equal then
282 Error_Msg_SC ("|""="" should be IS");
286 Wrong_Token (Tok_Is, AP);
289 -- Ignore extra IS keywords
291 while Token = Tok_Is loop
292 Error_Msg_SC ("|extra IS ignored");
301 procedure T_Left_Paren is
303 if Token = Tok_Left_Paren then
306 Error_Msg_AP ("missing ""(""");
316 if Token = Tok_Do then
317 Error_Msg_SC ("LOOP expected");
320 Check_Token (Tok_Loop, AP);
330 Check_Token (Tok_Mod, AP);
339 Check_Token (Tok_New, AP);
348 Check_Token (Tok_Of, AP);
357 Check_Token (Tok_Or, AP);
364 procedure T_Private is
366 Check_Token (Tok_Private, SC);
375 Check_Token (Tok_Range, AP);
382 procedure T_Record is
384 Check_Token (Tok_Record, AP);
391 procedure T_Right_Paren is
393 if Token = Tok_Right_Paren then
396 Error_Msg_AP ("|missing "")""");
404 procedure T_Semicolon is
407 if Token = Tok_Semicolon then
410 if Token = Tok_Semicolon then
411 Error_Msg_SC ("|extra "";"" ignored");
417 elsif Token = Tok_Colon then
418 Error_Msg_SC ("|"":"" should be "";""");
422 elsif Token = Tok_Comma then
423 Error_Msg_SC ("|"","" should be "";""");
427 elsif Token = Tok_Dot then
428 Error_Msg_SC ("|""."" should be "";""");
432 -- An interesting little kludge here. If the previous token is a
433 -- semicolon, then there is no way that we can legitimately need another
434 -- semicolon. This could only arise in an error situation where an error
435 -- has already been signalled. By simply ignoring the request for a
436 -- semicolon in this case, we avoid some spurious missing semicolon
439 elsif Prev_Token = Tok_Semicolon then
442 -- If the current token is | then this is a reasonable place to suggest
443 -- the possibility of a "C" confusion.
445 elsif Token = Tok_Vertical_Bar then
446 Error_Msg_SC -- CODEFIX
447 ("unexpected occurrence of ""'|"", did you mean OR'?");
448 Resync_Past_Semicolon;
451 -- Deal with pragma. If pragma is not at start of line, it is considered
452 -- misplaced otherwise we treat it as a normal missing semicolon case.
454 elsif Token = Tok_Pragma
455 and then not Token_Is_At_Start_Of_Line
459 if Token = Tok_Semicolon then
465 -- If none of those tests return, we really have a missing semicolon
467 Error_Msg_AP ("|missing "";""");
477 Check_Token (Tok_Then, AP);
486 Check_Token (Tok_Type, BC);
495 Check_Token (Tok_Use, SC);
504 Check_Token (Tok_When, SC);
513 Check_Token (Tok_With, BC);
520 procedure TF_Arrow is
521 Scan_State : Saved_Scan_State;
524 if Token = Tok_Arrow then
525 Scan; -- skip arrow and we are done
527 elsif Token = Tok_Colon_Equal then
528 T_Arrow; -- Let T_Arrow give the message
531 T_Arrow; -- give missing arrow message
532 Save_Scan_State (Scan_State); -- at start of junk tokens
535 if Prev_Token_Ptr < Current_Line_Start
536 or else Token = Tok_Semicolon
537 or else Token = Tok_EOF
539 Restore_Scan_State (Scan_State); -- to where we were!
543 Scan; -- continue search!
545 if Token = Tok_Arrow then
558 Scan_State : Saved_Scan_State;
561 if Token = Tok_Is then
562 T_Is; -- past IS and we are done
564 -- Allow OF or => or = in place of IS (with error message)
567 or else Token = Tok_Arrow
568 or else Token = Tok_Equal
570 T_Is; -- give missing IS message and skip bad token
573 T_Is; -- give missing IS message
574 Save_Scan_State (Scan_State); -- at start of junk tokens
577 if Prev_Token_Ptr < Current_Line_Start
578 or else Token = Tok_Semicolon
579 or else Token = Tok_EOF
581 Restore_Scan_State (Scan_State); -- to where we were!
585 Scan; -- continue search!
588 or else Token = Tok_Of
589 or else Token = Tok_Arrow
591 Scan; -- past IS or OF or =>
603 Scan_State : Saved_Scan_State;
606 if Token = Tok_Loop then
607 Scan; -- past LOOP and we are done
609 -- Allow DO or THEN in place of LOOP
611 elsif Token = Tok_Then or else Token = Tok_Do then
612 T_Loop; -- give missing LOOP message
615 T_Loop; -- give missing LOOP message
616 Save_Scan_State (Scan_State); -- at start of junk tokens
619 if Prev_Token_Ptr < Current_Line_Start
620 or else Token = Tok_Semicolon
621 or else Token = Tok_EOF
623 Restore_Scan_State (Scan_State); -- to where we were!
627 Scan; -- continue search!
629 if Token = Tok_Loop or else Token = Tok_Then then
630 Scan; -- past loop or then (message already generated)
641 procedure TF_Return is
642 Scan_State : Saved_Scan_State;
645 if Token = Tok_Return then
646 Scan; -- skip RETURN and we are done
649 Error_Msg_SC ("missing RETURN");
650 Save_Scan_State (Scan_State); -- at start of junk tokens
653 if Prev_Token_Ptr < Current_Line_Start
654 or else Token = Tok_Semicolon
655 or else Token = Tok_EOF
657 Restore_Scan_State (Scan_State); -- to where we were!
661 Scan; -- continue search!
663 if Token = Tok_Return then
675 procedure TF_Semicolon is
676 Scan_State : Saved_Scan_State;
679 if Token = Tok_Semicolon then
683 -- An interesting little kludge here. If the previous token is a
684 -- semicolon, then there is no way that we can legitimately need
685 -- another semicolon. This could only arise in an error situation
686 -- where an error has already been signalled. By simply ignoring
687 -- the request for a semicolon in this case, we avoid some spurious
688 -- missing semicolon messages.
690 elsif Prev_Token = Tok_Semicolon then
694 -- Deal with pragma. If pragma is not at start of line, it is
695 -- considered misplaced otherwise we treat it as a normal
696 -- missing semicolon case.
698 if Token = Tok_Pragma
699 and then not Token_Is_At_Start_Of_Line
703 if Token = Tok_Semicolon then
709 -- Here we definitely have a missing semicolon, so give message
713 -- Scan out junk on rest of line. Scan stops on END keyword, since
714 -- that seems to help avoid cascaded errors.
716 Save_Scan_State (Scan_State); -- at start of junk tokens
719 if Prev_Token_Ptr < Current_Line_Start
720 or else Token = Tok_EOF
721 or else Token = Tok_End
723 Restore_Scan_State (Scan_State); -- to where we were
727 Scan; -- continue search
729 if Token = Tok_Semicolon then
733 elsif Token in Token_Class_After_SM then
745 Scan_State : Saved_Scan_State;
748 if Token = Tok_Then then
749 Scan; -- past THEN and we are done
752 T_Then; -- give missing THEN message
753 Save_Scan_State (Scan_State); -- at start of junk tokens
756 if Prev_Token_Ptr < Current_Line_Start
757 or else Token = Tok_Semicolon
758 or else Token = Tok_EOF
760 Restore_Scan_State (Scan_State); -- to where we were
764 Scan; -- continue search!
766 if Token = Tok_Then then
779 Scan_State : Saved_Scan_State;
782 if Token = Tok_Use then
783 Scan; -- past USE and we are done
786 T_Use; -- give USE expected message
787 Save_Scan_State (Scan_State); -- at start of junk tokens
790 if Prev_Token_Ptr < Current_Line_Start
791 or else Token = Tok_Semicolon
792 or else Token = Tok_EOF
794 Restore_Scan_State (Scan_State); -- to where we were
798 Scan; -- continue search!
800 if Token = Tok_Use then
812 procedure U_Left_Paren is
814 if Token = Tok_Left_Paren then
817 Error_Msg_AP ("missing ""(""!");
825 procedure U_Right_Paren is
827 if Token = Tok_Right_Paren then
830 Error_Msg_AP ("|missing "")""!");
838 procedure Wrong_Token (T : Token_Type; P : Position) is
839 Missing : constant String := "missing ";
840 Image : constant String := Token_Type'Image (T);
841 Tok_Name : constant String := Image (5 .. Image'Length);
842 M : constant String := Missing & Tok_Name;
845 if Token = Tok_Semicolon then
849 Error_Msg_SP ("|extra "";"" ignored");
855 elsif Token = Tok_Comma then
859 Error_Msg_SP ("|extra "","" ignored");
868 when SC => Error_Msg_SC (M);
869 when BC => Error_Msg_BC (M);
870 when AP => Error_Msg_AP (M);