1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2008, 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 ("unexpected occurrence of ""'|"", did you mean OR'?");
447 Resync_Past_Semicolon;
450 -- Deal with pragma. If pragma is not at start of line, it is considered
451 -- misplaced otherwise we treat it as a normal missing semicolon case.
453 elsif Token = Tok_Pragma
454 and then not Token_Is_At_Start_Of_Line
458 if Token = Tok_Semicolon then
464 -- If none of those tests return, we really have a missing semicolon
466 Error_Msg_AP ("|missing "";""");
476 Check_Token (Tok_Then, AP);
485 Check_Token (Tok_Type, BC);
494 Check_Token (Tok_Use, SC);
503 Check_Token (Tok_When, SC);
512 Check_Token (Tok_With, BC);
519 procedure TF_Arrow is
520 Scan_State : Saved_Scan_State;
523 if Token = Tok_Arrow then
524 Scan; -- skip arrow and we are done
526 elsif Token = Tok_Colon_Equal then
527 T_Arrow; -- Let T_Arrow give the message
530 T_Arrow; -- give missing arrow message
531 Save_Scan_State (Scan_State); -- at start of junk tokens
534 if Prev_Token_Ptr < Current_Line_Start
535 or else Token = Tok_Semicolon
536 or else Token = Tok_EOF
538 Restore_Scan_State (Scan_State); -- to where we were!
542 Scan; -- continue search!
544 if Token = Tok_Arrow then
557 Scan_State : Saved_Scan_State;
560 if Token = Tok_Is then
561 T_Is; -- past IS and we are done
563 -- Allow OF or => or = in place of IS (with error message)
566 or else Token = Tok_Arrow
567 or else Token = Tok_Equal
569 T_Is; -- give missing IS message and skip bad token
572 T_Is; -- give missing IS message
573 Save_Scan_State (Scan_State); -- at start of junk tokens
576 if Prev_Token_Ptr < Current_Line_Start
577 or else Token = Tok_Semicolon
578 or else Token = Tok_EOF
580 Restore_Scan_State (Scan_State); -- to where we were!
584 Scan; -- continue search!
587 or else Token = Tok_Of
588 or else Token = Tok_Arrow
590 Scan; -- past IS or OF or =>
602 Scan_State : Saved_Scan_State;
605 if Token = Tok_Loop then
606 Scan; -- past LOOP and we are done
608 -- Allow DO or THEN in place of LOOP
610 elsif Token = Tok_Then or else Token = Tok_Do then
611 T_Loop; -- give missing LOOP message
614 T_Loop; -- give missing LOOP message
615 Save_Scan_State (Scan_State); -- at start of junk tokens
618 if Prev_Token_Ptr < Current_Line_Start
619 or else Token = Tok_Semicolon
620 or else Token = Tok_EOF
622 Restore_Scan_State (Scan_State); -- to where we were!
626 Scan; -- continue search!
628 if Token = Tok_Loop or else Token = Tok_Then then
629 Scan; -- past loop or then (message already generated)
640 procedure TF_Return is
641 Scan_State : Saved_Scan_State;
644 if Token = Tok_Return then
645 Scan; -- skip RETURN and we are done
648 Error_Msg_SC ("missing RETURN");
649 Save_Scan_State (Scan_State); -- at start of junk tokens
652 if Prev_Token_Ptr < Current_Line_Start
653 or else Token = Tok_Semicolon
654 or else Token = Tok_EOF
656 Restore_Scan_State (Scan_State); -- to where we were!
660 Scan; -- continue search!
662 if Token = Tok_Return then
674 procedure TF_Semicolon is
675 Scan_State : Saved_Scan_State;
678 if Token = Tok_Semicolon then
682 -- An interesting little kludge here. If the previous token is a
683 -- semicolon, then there is no way that we can legitimately need
684 -- another semicolon. This could only arise in an error situation
685 -- where an error has already been signalled. By simply ignoring
686 -- the request for a semicolon in this case, we avoid some spurious
687 -- missing semicolon messages.
689 elsif Prev_Token = Tok_Semicolon then
693 -- Deal with pragma. If pragma is not at start of line, it is
694 -- considered misplaced otherwise we treat it as a normal
695 -- missing semicolon case.
697 if Token = Tok_Pragma
698 and then not Token_Is_At_Start_Of_Line
702 if Token = Tok_Semicolon then
708 -- Here we definitely have a missing semicolon, so give message
712 -- Scan out junk on rest of line. Scan stops on END keyword, since
713 -- that seems to help avoid cascaded errors.
715 Save_Scan_State (Scan_State); -- at start of junk tokens
718 if Prev_Token_Ptr < Current_Line_Start
719 or else Token = Tok_EOF
720 or else Token = Tok_End
722 Restore_Scan_State (Scan_State); -- to where we were
726 Scan; -- continue search
728 if Token = Tok_Semicolon then
732 elsif Token in Token_Class_After_SM then
744 Scan_State : Saved_Scan_State;
747 if Token = Tok_Then then
748 Scan; -- past THEN and we are done
751 T_Then; -- give missing THEN message
752 Save_Scan_State (Scan_State); -- at start of junk tokens
755 if Prev_Token_Ptr < Current_Line_Start
756 or else Token = Tok_Semicolon
757 or else Token = Tok_EOF
759 Restore_Scan_State (Scan_State); -- to where we were
763 Scan; -- continue search!
765 if Token = Tok_Then then
778 Scan_State : Saved_Scan_State;
781 if Token = Tok_Use then
782 Scan; -- past USE and we are done
785 T_Use; -- give USE expected message
786 Save_Scan_State (Scan_State); -- at start of junk tokens
789 if Prev_Token_Ptr < Current_Line_Start
790 or else Token = Tok_Semicolon
791 or else Token = Tok_EOF
793 Restore_Scan_State (Scan_State); -- to where we were
797 Scan; -- continue search!
799 if Token = Tok_Use then
811 procedure U_Left_Paren is
813 if Token = Tok_Left_Paren then
816 Error_Msg_AP ("missing ""(""!");
824 procedure U_Right_Paren is
826 if Token = Tok_Right_Paren then
829 Error_Msg_AP ("|missing "")""!");
837 procedure Wrong_Token (T : Token_Type; P : Position) is
838 Missing : constant String := "missing ";
839 Image : constant String := Token_Type'Image (T);
840 Tok_Name : constant String := Image (5 .. Image'Length);
841 M : constant String := Missing & Tok_Name;
844 if Token = Tok_Semicolon then
848 Error_Msg_SP ("|extra "";"" ignored");
854 elsif Token = Tok_Comma then
858 Error_Msg_SP ("|extra "","" ignored");
867 when SC => Error_Msg_SC (M);
868 when BC => Error_Msg_BC (M);
869 when AP => Error_Msg_AP (M);