1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2013, 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. 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 error situation where an error has
458 -- 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 and then not Token_Is_At_Start_Of_Line then
480 if Token = Tok_Semicolon then
486 -- If none of those tests return, we really have a missing semicolon
488 Error_Msg_AP -- CODEFIX
499 Check_Token (Tok_Then, AP);
508 Check_Token (Tok_Type, BC);
517 Check_Token (Tok_Use, SC);
526 Check_Token (Tok_When, SC);
535 Check_Token (Tok_With, BC);
542 procedure TF_Arrow is
543 Scan_State : Saved_Scan_State;
546 if Token = Tok_Arrow then
547 Scan; -- skip arrow and we are done
549 elsif Token = Tok_Colon_Equal then
550 T_Arrow; -- Let T_Arrow give the message
553 T_Arrow; -- give missing arrow message
554 Save_Scan_State (Scan_State); -- at start of junk tokens
557 if Prev_Token_Ptr < Current_Line_Start
558 or else Token = Tok_Semicolon
559 or else Token = Tok_EOF
561 Restore_Scan_State (Scan_State); -- to where we were
565 Scan; -- continue search
567 if Token = Tok_Arrow then
580 Scan_State : Saved_Scan_State;
583 if Token = Tok_Is then
584 T_Is; -- past IS and we are done
586 -- Allow OF or => or = in place of IS (with error message)
589 or else Token = Tok_Arrow
590 or else Token = Tok_Equal
592 T_Is; -- give missing IS message and skip bad token
595 T_Is; -- give missing IS message
596 Save_Scan_State (Scan_State); -- at start of junk tokens
599 if Prev_Token_Ptr < Current_Line_Start
600 or else Token = Tok_Semicolon
601 or else Token = Tok_EOF
603 Restore_Scan_State (Scan_State); -- to where we were
607 Scan; -- continue search
610 or else Token = Tok_Of
611 or else Token = Tok_Arrow
613 Scan; -- past IS or OF or =>
625 Scan_State : Saved_Scan_State;
628 if Token = Tok_Loop then
629 Scan; -- past LOOP and we are done
631 -- Allow DO or THEN in place of LOOP
633 elsif Token = Tok_Then or else Token = Tok_Do then
634 T_Loop; -- give missing LOOP message
637 T_Loop; -- give missing LOOP message
638 Save_Scan_State (Scan_State); -- at start of junk tokens
641 if Prev_Token_Ptr < Current_Line_Start
642 or else Token = Tok_Semicolon
643 or else Token = Tok_EOF
645 Restore_Scan_State (Scan_State); -- to where we were
649 Scan; -- continue search
651 if Token = Tok_Loop or else Token = Tok_Then then
652 Scan; -- past loop or then (message already generated)
663 procedure TF_Return is
664 Scan_State : Saved_Scan_State;
667 if Token = Tok_Return then
668 Scan; -- skip RETURN and we are done
671 Error_Msg_SC -- CODEFIX
673 Save_Scan_State (Scan_State); -- at start of junk tokens
676 if Prev_Token_Ptr < Current_Line_Start
677 or else Token = Tok_Semicolon
678 or else Token = Tok_EOF
680 Restore_Scan_State (Scan_State); -- to where we were
684 Scan; -- continue search
686 if Token = Tok_Return then
698 procedure TF_Semicolon is
699 Scan_State : Saved_Scan_State;
702 if Token = Tok_Semicolon then
706 -- An interesting little kludge here. If the previous token is a
707 -- semicolon, then there is no way that we can legitimately need
708 -- another semicolon. This could only arise in an error situation
709 -- where an error has already been signalled. By simply ignoring
710 -- the request for a semicolon in this case, we avoid some spurious
711 -- missing semicolon messages.
713 elsif Prev_Token = Tok_Semicolon then
717 -- Deal with pragma. If pragma is not at start of line, it is
718 -- considered misplaced otherwise we treat it as a normal
719 -- missing semicolon case.
721 if Token = Tok_Pragma
722 and then not Token_Is_At_Start_Of_Line
726 if Token = Tok_Semicolon then
732 -- Here we definitely have a missing semicolon, so give message
736 -- Scan out junk on rest of line. Scan stops on END keyword, since
737 -- that seems to help avoid cascaded errors.
739 Save_Scan_State (Scan_State); -- at start of junk tokens
742 if Prev_Token_Ptr < Current_Line_Start
743 or else Token = Tok_EOF
744 or else Token = Tok_End
746 Restore_Scan_State (Scan_State); -- to where we were
750 Scan; -- continue search
752 if Token = Tok_Semicolon then
756 elsif Token in Token_Class_After_SM then
768 Scan_State : Saved_Scan_State;
771 if Token = Tok_Then then
772 Scan; -- past THEN and we are done
775 T_Then; -- give missing THEN message
776 Save_Scan_State (Scan_State); -- at start of junk tokens
779 if Prev_Token_Ptr < Current_Line_Start
780 or else Token = Tok_Semicolon
781 or else Token = Tok_EOF
783 Restore_Scan_State (Scan_State); -- to where we were
787 Scan; -- continue search
789 if Token = Tok_Then then
802 Scan_State : Saved_Scan_State;
805 if Token = Tok_Use then
806 Scan; -- past USE and we are done
809 T_Use; -- give USE expected message
810 Save_Scan_State (Scan_State); -- at start of junk tokens
813 if Prev_Token_Ptr < Current_Line_Start
814 or else Token = Tok_Semicolon
815 or else Token = Tok_EOF
817 Restore_Scan_State (Scan_State); -- to where we were
821 Scan; -- continue search
823 if Token = Tok_Use then
835 procedure U_Left_Paren is
837 if Token = Tok_Left_Paren then
840 Error_Msg_AP -- CODEFIX
849 procedure U_Right_Paren is
851 if Token = Tok_Right_Paren then
854 Error_Msg_AP -- CODEFIX
863 procedure Wrong_Token (T : Token_Type; P : Position) is
864 Missing : constant String := "missing ";
865 Image : constant String := Token_Type'Image (T);
866 Tok_Name : constant String := Image (5 .. Image'Length);
867 M : constant String := Missing & Tok_Name;
870 if Token = Tok_Semicolon then
874 Error_Msg_SP -- CODEFIX
875 ("|extra "";"" ignored");
881 elsif Token = Tok_Comma then
885 Error_Msg_SP -- CODEFIX
886 ("|extra "","" ignored");
895 when SC => Error_Msg_SC (M);
896 when BC => Error_Msg_BC (M);
897 when AP => Error_Msg_AP (M);