1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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 ("missing ""='>""");
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 if Token = Tok_Is then
263 Ignore (Tok_Semicolon);
265 -- Allow OF, => or = to substitute for IS with complaint
267 elsif Token = Tok_Arrow
268 or else Token = Tok_Of
269 or else Token = Tok_Equal
271 Error_Msg_SC ("missing IS");
272 Scan; -- token used in place of IS
274 Wrong_Token (Tok_Is, AP);
277 while Token = Tok_Is loop
278 Error_Msg_SC ("extra IS ignored");
287 procedure T_Left_Paren is
289 if Token = Tok_Left_Paren then
292 Error_Msg_AP ("missing ""(""");
302 if Token = Tok_Do then
303 Error_Msg_SC ("LOOP expected");
306 Check_Token (Tok_Loop, AP);
316 Check_Token (Tok_Mod, AP);
325 Check_Token (Tok_New, AP);
334 Check_Token (Tok_Of, AP);
343 Check_Token (Tok_Or, AP);
350 procedure T_Private is
352 Check_Token (Tok_Private, SC);
361 Check_Token (Tok_Range, AP);
368 procedure T_Record is
370 Check_Token (Tok_Record, AP);
377 procedure T_Right_Paren is
379 if Token = Tok_Right_Paren then
382 Error_Msg_AP ("missing "")""");
390 procedure T_Semicolon is
393 if Token = Tok_Semicolon then
396 if Token = Tok_Semicolon then
397 Error_Msg_SC ("extra "";"" ignored");
403 elsif Token = Tok_Colon then
404 Error_Msg_SC (""":"" should be "";""");
408 elsif Token = Tok_Comma then
409 Error_Msg_SC (""","" should be "";""");
413 elsif Token = Tok_Dot then
414 Error_Msg_SC ("""."" should be "";""");
418 -- An interesting little kludge here. If the previous token is a
419 -- semicolon, then there is no way that we can legitimately need another
420 -- semicolon. This could only arise in an error situation where an error
421 -- has already been signalled. By simply ignoring the request for a
422 -- semicolon in this case, we avoid some spurious missing semicolon
425 elsif Prev_Token = Tok_Semicolon then
428 -- If the current token is | then this is a reasonable place to suggest
429 -- the possibility of a "C" confusion.
431 elsif Token = Tok_Vertical_Bar then
432 Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?");
433 Resync_Past_Semicolon;
436 -- Deal with pragma. If pragma is not at start of line, it is considered
437 -- misplaced otherwise we treat it as a normal missing semicolong case.
439 elsif Token = Tok_Pragma
440 and then not Token_Is_At_Start_Of_Line
444 if Token = Tok_Semicolon then
450 -- If none of those tests return, we really have a missing semicolon
452 Error_Msg_AP ("|missing "";""");
462 Check_Token (Tok_Then, AP);
471 Check_Token (Tok_Type, BC);
480 Check_Token (Tok_Use, SC);
489 Check_Token (Tok_When, SC);
498 Check_Token (Tok_With, BC);
505 procedure TF_Arrow is
506 Scan_State : Saved_Scan_State;
509 if Token = Tok_Arrow then
510 Scan; -- skip arrow and we are done
512 elsif Token = Tok_Colon_Equal then
513 T_Arrow; -- Let T_Arrow give the message
516 T_Arrow; -- give missing arrow message
517 Save_Scan_State (Scan_State); -- at start of junk tokens
520 if Prev_Token_Ptr < Current_Line_Start
521 or else Token = Tok_Semicolon
522 or else Token = Tok_EOF
524 Restore_Scan_State (Scan_State); -- to where we were!
528 Scan; -- continue search!
530 if Token = Tok_Arrow then
543 Scan_State : Saved_Scan_State;
546 if Token = Tok_Is then
547 T_Is; -- past IS and we are done
549 -- Allow OF or => or = in place of IS (with error message)
552 or else Token = Tok_Arrow
553 or else Token = Tok_Equal
555 T_Is; -- give missing IS message and skip bad token
558 T_Is; -- give missing IS message
559 Save_Scan_State (Scan_State); -- at start of junk tokens
562 if Prev_Token_Ptr < Current_Line_Start
563 or else Token = Tok_Semicolon
564 or else Token = Tok_EOF
566 Restore_Scan_State (Scan_State); -- to where we were!
570 Scan; -- continue search!
573 or else Token = Tok_Of
574 or else Token = Tok_Arrow
576 Scan; -- past IS or OF or =>
588 Scan_State : Saved_Scan_State;
591 if Token = Tok_Loop then
592 Scan; -- past LOOP and we are done
594 -- Allow DO or THEN in place of LOOP
596 elsif Token = Tok_Then or else Token = Tok_Do then
597 T_Loop; -- give missing LOOP message
600 T_Loop; -- give missing LOOP message
601 Save_Scan_State (Scan_State); -- at start of junk tokens
604 if Prev_Token_Ptr < Current_Line_Start
605 or else Token = Tok_Semicolon
606 or else Token = Tok_EOF
608 Restore_Scan_State (Scan_State); -- to where we were!
612 Scan; -- continue search!
614 if Token = Tok_Loop or else Token = Tok_Then then
615 Scan; -- past loop or then (message already generated)
626 procedure TF_Return is
627 Scan_State : Saved_Scan_State;
630 if Token = Tok_Return then
631 Scan; -- skip RETURN and we are done
634 Error_Msg_SC ("missing RETURN");
635 Save_Scan_State (Scan_State); -- at start of junk tokens
638 if Prev_Token_Ptr < Current_Line_Start
639 or else Token = Tok_Semicolon
640 or else Token = Tok_EOF
642 Restore_Scan_State (Scan_State); -- to where we were!
646 Scan; -- continue search!
648 if Token = Tok_Return then
660 procedure TF_Semicolon is
661 Scan_State : Saved_Scan_State;
664 if Token = Tok_Semicolon then
668 -- An interesting little kludge here. If the previous token is a
669 -- semicolon, then there is no way that we can legitimately need
670 -- another semicolon. This could only arise in an error situation
671 -- where an error has already been signalled. By simply ignoring
672 -- the request for a semicolon in this case, we avoid some spurious
673 -- missing semicolon messages.
675 elsif Prev_Token = Tok_Semicolon then
679 -- Deal with pragma. If pragma is not at start of line, it is
680 -- considered misplaced otherwise we treat it as a normal
681 -- missing semicolong case.
683 if Token = Tok_Pragma
684 and then not Token_Is_At_Start_Of_Line
688 if Token = Tok_Semicolon then
694 -- Here we definitely have a missing semicolon, so give message
698 -- Scan out junk on rest of line. Scan stops on END keyword, since
699 -- that seems to help avoid cascaded errors.
701 Save_Scan_State (Scan_State); -- at start of junk tokens
704 if Prev_Token_Ptr < Current_Line_Start
705 or else Token = Tok_EOF
706 or else Token = Tok_End
708 Restore_Scan_State (Scan_State); -- to where we were
712 Scan; -- continue search
714 if Token = Tok_Semicolon then
718 elsif Token in Token_Class_After_SM then
730 Scan_State : Saved_Scan_State;
733 if Token = Tok_Then then
734 Scan; -- past THEN and we are done
737 T_Then; -- give missing THEN message
738 Save_Scan_State (Scan_State); -- at start of junk tokens
741 if Prev_Token_Ptr < Current_Line_Start
742 or else Token = Tok_Semicolon
743 or else Token = Tok_EOF
745 Restore_Scan_State (Scan_State); -- to where we were
749 Scan; -- continue search!
751 if Token = Tok_Then then
764 Scan_State : Saved_Scan_State;
767 if Token = Tok_Use then
768 Scan; -- past USE and we are done
771 T_Use; -- give USE expected message
772 Save_Scan_State (Scan_State); -- at start of junk tokens
775 if Prev_Token_Ptr < Current_Line_Start
776 or else Token = Tok_Semicolon
777 or else Token = Tok_EOF
779 Restore_Scan_State (Scan_State); -- to where we were
783 Scan; -- continue search!
785 if Token = Tok_Use then
797 procedure Wrong_Token (T : Token_Type; P : Position) is
798 Missing : constant String := "missing ";
799 Image : constant String := Token_Type'Image (T);
800 Tok_Name : constant String := Image (5 .. Image'Length);
801 M : constant String := Missing & Tok_Name;
804 if Token = Tok_Semicolon then
808 Error_Msg_SP ("extra "";"" ignored");
814 elsif Token = Tok_Comma then
818 Error_Msg_SP ("extra "","" ignored");
827 when SC => Error_Msg_SC (M);
828 when BC => Error_Msg_BC (M);
829 when AP => Error_Msg_AP (M);