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
);