1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2010, 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 kludge here. If the previous token is a
456 -- semicolon, then there is no way that we can legitimately need another
457 -- semicolon. This could only arise in an error situation where an error
458 -- has already been signalled. By simply ignoring the request for a
459 -- semicolon in this case, we avoid some spurious missing semicolon
462 elsif Prev_Token = Tok_Semicolon then
465 -- If the current token is | then this is a reasonable place to suggest
466 -- the possibility of a "C" confusion.
468 elsif Token = Tok_Vertical_Bar then
469 Error_Msg_SC -- CODEFIX
470 ("unexpected occurrence of ""'|"", did you mean OR'?");
471 Resync_Past_Semicolon;
474 -- Deal with pragma. If pragma is not at start of line, it is considered
475 -- misplaced otherwise we treat it as a normal missing semicolon case.
477 elsif Token = Tok_Pragma
478 and then not Token_Is_At_Start_Of_Line
482 if Token = Tok_Semicolon then
488 -- If none of those tests return, we really have a missing semicolon
490 Error_Msg_AP -- CODEFIX
501 Check_Token (Tok_Then, AP);
510 Check_Token (Tok_Type, BC);
519 Check_Token (Tok_Use, SC);
528 Check_Token (Tok_When, SC);
537 Check_Token (Tok_With, BC);
544 procedure TF_Arrow is
545 Scan_State : Saved_Scan_State;
548 if Token = Tok_Arrow then
549 Scan; -- skip arrow and we are done
551 elsif Token = Tok_Colon_Equal then
552 T_Arrow; -- Let T_Arrow give the message
555 T_Arrow; -- give missing arrow message
556 Save_Scan_State (Scan_State); -- at start of junk tokens
559 if Prev_Token_Ptr < Current_Line_Start
560 or else Token = Tok_Semicolon
561 or else Token = Tok_EOF
563 Restore_Scan_State (Scan_State); -- to where we were!
567 Scan; -- continue search!
569 if Token = Tok_Arrow then
582 Scan_State : Saved_Scan_State;
585 if Token = Tok_Is then
586 T_Is; -- past IS and we are done
588 -- Allow OF or => or = in place of IS (with error message)
591 or else Token = Tok_Arrow
592 or else Token = Tok_Equal
594 T_Is; -- give missing IS message and skip bad token
597 T_Is; -- give missing IS message
598 Save_Scan_State (Scan_State); -- at start of junk tokens
601 if Prev_Token_Ptr < Current_Line_Start
602 or else Token = Tok_Semicolon
603 or else Token = Tok_EOF
605 Restore_Scan_State (Scan_State); -- to where we were!
609 Scan; -- continue search!
612 or else Token = Tok_Of
613 or else Token = Tok_Arrow
615 Scan; -- past IS or OF or =>
627 Scan_State : Saved_Scan_State;
630 if Token = Tok_Loop then
631 Scan; -- past LOOP and we are done
633 -- Allow DO or THEN in place of LOOP
635 elsif Token = Tok_Then or else Token = Tok_Do then
636 T_Loop; -- give missing LOOP message
639 T_Loop; -- give missing LOOP message
640 Save_Scan_State (Scan_State); -- at start of junk tokens
643 if Prev_Token_Ptr < Current_Line_Start
644 or else Token = Tok_Semicolon
645 or else Token = Tok_EOF
647 Restore_Scan_State (Scan_State); -- to where we were!
651 Scan; -- continue search!
653 if Token = Tok_Loop or else Token = Tok_Then then
654 Scan; -- past loop or then (message already generated)
665 procedure TF_Return is
666 Scan_State : Saved_Scan_State;
669 if Token = Tok_Return then
670 Scan; -- skip RETURN and we are done
673 Error_Msg_SC -- CODEFIX
675 Save_Scan_State (Scan_State); -- at start of junk tokens
678 if Prev_Token_Ptr < Current_Line_Start
679 or else Token = Tok_Semicolon
680 or else Token = Tok_EOF
682 Restore_Scan_State (Scan_State); -- to where we were!
686 Scan; -- continue search!
688 if Token = Tok_Return then
700 procedure TF_Semicolon is
701 Scan_State : Saved_Scan_State;
704 if Token = Tok_Semicolon then
708 -- An interesting little kludge here. If the previous token is a
709 -- semicolon, then there is no way that we can legitimately need
710 -- another semicolon. This could only arise in an error situation
711 -- where an error has already been signalled. By simply ignoring
712 -- the request for a semicolon in this case, we avoid some spurious
713 -- missing semicolon messages.
715 elsif Prev_Token = Tok_Semicolon then
719 -- Deal with pragma. If pragma is not at start of line, it is
720 -- considered misplaced otherwise we treat it as a normal
721 -- missing semicolon case.
723 if Token = Tok_Pragma
724 and then not Token_Is_At_Start_Of_Line
728 if Token = Tok_Semicolon then
734 -- Here we definitely have a missing semicolon, so give message
738 -- Scan out junk on rest of line. Scan stops on END keyword, since
739 -- that seems to help avoid cascaded errors.
741 Save_Scan_State (Scan_State); -- at start of junk tokens
744 if Prev_Token_Ptr < Current_Line_Start
745 or else Token = Tok_EOF
746 or else Token = Tok_End
748 Restore_Scan_State (Scan_State); -- to where we were
752 Scan; -- continue search
754 if Token = Tok_Semicolon then
758 elsif Token in Token_Class_After_SM then
770 Scan_State : Saved_Scan_State;
773 if Token = Tok_Then then
774 Scan; -- past THEN and we are done
777 T_Then; -- give missing THEN message
778 Save_Scan_State (Scan_State); -- at start of junk tokens
781 if Prev_Token_Ptr < Current_Line_Start
782 or else Token = Tok_Semicolon
783 or else Token = Tok_EOF
785 Restore_Scan_State (Scan_State); -- to where we were
789 Scan; -- continue search!
791 if Token = Tok_Then then
804 Scan_State : Saved_Scan_State;
807 if Token = Tok_Use then
808 Scan; -- past USE and we are done
811 T_Use; -- give USE expected message
812 Save_Scan_State (Scan_State); -- at start of junk tokens
815 if Prev_Token_Ptr < Current_Line_Start
816 or else Token = Tok_Semicolon
817 or else Token = Tok_EOF
819 Restore_Scan_State (Scan_State); -- to where we were
823 Scan; -- continue search!
825 if Token = Tok_Use then
837 procedure U_Left_Paren is
839 if Token = Tok_Left_Paren then
842 Error_Msg_AP -- CODEFIX
851 procedure U_Right_Paren is
853 if Token = Tok_Right_Paren then
856 Error_Msg_AP -- CODEFIX
865 procedure Wrong_Token (T : Token_Type; P : Position) is
866 Missing : constant String := "missing ";
867 Image : constant String := Token_Type'Image (T);
868 Tok_Name : constant String := Image (5 .. Image'Length);
869 M : constant String := Missing & Tok_Name;
872 if Token = Tok_Semicolon then
876 Error_Msg_SP -- CODEFIX
877 ("|extra "";"" ignored");
883 elsif Token = Tok_Comma then
887 Error_Msg_SP -- CODEFIX
888 ("|extra "","" ignored");
897 when SC => Error_Msg_SC (M);
898 when BC => Error_Msg_BC (M);
899 when AP => Error_Msg_AP (M);