1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2024, 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
);
405 ---------------------------
406 -- T_Right_Curly_Bracket --
407 ---------------------------
409 procedure T_Right_Curly_Bracket
is
411 if Token
= Tok_Right_Curly_Bracket
then
415 ("|missing ""'}'""");
417 end T_Right_Curly_Bracket
;
419 ---------------------
420 -- T_Right_Bracket --
421 ---------------------
423 procedure T_Right_Bracket
is
425 if Token
= Tok_Right_Bracket
then
428 Error_Msg_AP
-- CODEFIX
429 ("|missing ""']'""");
437 procedure T_Right_Paren
is
439 if Token
= Tok_Right_Paren
then
442 Error_Msg_AP
-- CODEFIX
451 procedure T_Semicolon
is
453 if Token
= Tok_Semicolon
then
456 if Token
= Tok_Semicolon
then
457 Error_Msg_SC
-- CODEFIX
458 ("|extra "";"" ignored");
464 elsif Token
= Tok_Colon
then
465 Error_Msg_SC
-- CODEFIX
466 ("|"":"" should be "";""");
470 elsif Token
= Tok_Comma
then
471 Error_Msg_SC
-- CODEFIX
472 ("|"","" should be "";""");
476 elsif Token
= Tok_Dot
then
477 Error_Msg_SC
-- CODEFIX
478 ("|""."" should be "";""");
482 -- An interesting little case. If the previous token is a semicolon,
483 -- then there is no way that we can legitimately need another semicolon.
484 -- This could only arise in an situation where an error has already been
485 -- signalled. By simply ignoring the request for a semicolon in this
486 -- case, we avoid some spurious missing semicolon messages.
488 elsif Prev_Token
= Tok_Semicolon
then
491 -- If the current token is | then this is a reasonable place to suggest
492 -- the possibility of a "C" confusion.
494 elsif Token
= Tok_Vertical_Bar
then
495 Error_Msg_SC
-- CODEFIX
496 ("unexpected occurrence of ""'|"", did you mean OR'?");
497 Resync_Past_Semicolon
;
500 -- Deal with pragma. If pragma is not at start of line, it is considered
501 -- misplaced otherwise we treat it as a normal missing semicolon case.
503 elsif Token
= Tok_Pragma
and then not Token_Is_At_Start_Of_Line
then
506 if Token
= Tok_Semicolon
then
512 -- If none of those tests return, we really have a missing semicolon
514 Error_Msg_AP
-- CODEFIX
525 Check_Token
(Tok_Then
, AP
);
534 Check_Token
(Tok_Type
, BC
);
543 Check_Token
(Tok_Use
, SC
);
552 Check_Token
(Tok_When
, SC
);
561 Check_Token
(Tok_With
, BC
);
568 procedure TF_Arrow
is
569 Scan_State
: Saved_Scan_State
;
572 if Token
= Tok_Arrow
then
573 Scan
; -- skip arrow and we are done
575 elsif Token
= Tok_Colon_Equal
then
576 T_Arrow
; -- Let T_Arrow give the message
579 T_Arrow
; -- give missing arrow message
580 Save_Scan_State
(Scan_State
); -- at start of junk tokens
583 if Prev_Token_Ptr
< Current_Line_Start
584 or else Token
in Tok_Semicolon | Tok_EOF
586 Restore_Scan_State
(Scan_State
); -- to where we were
590 Scan
; -- continue search
592 if Token
= Tok_Arrow
then
605 Scan_State
: Saved_Scan_State
;
608 if Token
= Tok_Is
then
609 T_Is
; -- past IS and we are done
611 -- Allow OF or => or = in place of IS (with error message)
613 elsif Token
in Tok_Of | Tok_Arrow | Tok_Equal
then
614 T_Is
; -- give missing IS message and skip bad token
617 T_Is
; -- give missing IS message
618 Save_Scan_State
(Scan_State
); -- at start of junk tokens
621 if Prev_Token_Ptr
< Current_Line_Start
622 or else Token
in Tok_Semicolon | Tok_EOF
624 Restore_Scan_State
(Scan_State
); -- to where we were
628 Scan
; -- continue search
630 if Token
in Tok_Is | Tok_Of | Tok_Arrow
then
631 Scan
; -- past IS or OF or =>
643 Scan_State
: Saved_Scan_State
;
646 if Token
= Tok_Loop
then
647 Scan
; -- past LOOP and we are done
649 -- Allow DO or THEN in place of LOOP
651 elsif Token
in Tok_Then | Tok_Do
then
652 T_Loop
; -- give missing LOOP message
655 T_Loop
; -- give missing LOOP message
656 Save_Scan_State
(Scan_State
); -- at start of junk tokens
659 if Prev_Token_Ptr
< Current_Line_Start
660 or else Token
in Tok_Semicolon | Tok_EOF
662 Restore_Scan_State
(Scan_State
); -- to where we were
666 Scan
; -- continue search
668 if Token
in Tok_Loop | Tok_Then
then
669 Scan
; -- past loop or then (message already generated)
680 procedure TF_Return
is
681 Scan_State
: Saved_Scan_State
;
684 if Token
= Tok_Return
then
685 Scan
; -- skip RETURN and we are done
688 Error_Msg_SC
-- CODEFIX
690 Save_Scan_State
(Scan_State
); -- at start of junk tokens
693 if Prev_Token_Ptr
< Current_Line_Start
694 or else Token
in Tok_Semicolon | Tok_EOF
696 Restore_Scan_State
(Scan_State
); -- to where we were
700 Scan
; -- continue search
702 if Token
= Tok_Return
then
714 procedure TF_Semicolon
is
715 Scan_State
: Saved_Scan_State
;
718 if Token
= Tok_Semicolon
then
722 -- An interesting little test here. If the previous token is a
723 -- semicolon, then there is no way that we can legitimately need
724 -- another semicolon. This could only arise in an error situation
725 -- where an error has already been signalled. By simply ignoring
726 -- the request for a semicolon in this case, we avoid some spurious
727 -- missing semicolon messages.
729 elsif Prev_Token
= Tok_Semicolon
then
733 -- Deal with pragma. If pragma is not at start of line, it is
734 -- considered misplaced otherwise we treat it as a normal
735 -- missing semicolon case.
737 if Token
= Tok_Pragma
738 and then not Token_Is_At_Start_Of_Line
742 if Token
= Tok_Semicolon
then
748 -- Here we definitely have a missing semicolon, so give message
752 -- Scan out junk on rest of line. Scan stops on END keyword, since
753 -- that seems to help avoid cascaded errors.
755 Save_Scan_State
(Scan_State
); -- at start of junk tokens
758 if Prev_Token_Ptr
< Current_Line_Start
759 or else Token
in Tok_EOF | Tok_End
761 Restore_Scan_State
(Scan_State
); -- to where we were
765 Scan
; -- continue search
767 if Token
= Tok_Semicolon
then
771 elsif Token
in Token_Class_After_SM
then
783 Scan_State
: Saved_Scan_State
;
786 if Token
= Tok_Then
then
787 Scan
; -- past THEN and we are done
790 T_Then
; -- give missing THEN message
791 Save_Scan_State
(Scan_State
); -- at start of junk tokens
794 if Prev_Token_Ptr
< Current_Line_Start
795 or else Token
in Tok_Semicolon | Tok_EOF
797 Restore_Scan_State
(Scan_State
); -- to where we were
801 Scan
; -- continue search
803 if Token
= Tok_Then
then
816 Scan_State
: Saved_Scan_State
;
819 if Token
= Tok_Use
then
820 Scan
; -- past USE and we are done
823 T_Use
; -- give USE expected message
824 Save_Scan_State
(Scan_State
); -- at start of junk tokens
827 if Prev_Token_Ptr
< Current_Line_Start
828 or else Token
in Tok_Semicolon | Tok_EOF
830 Restore_Scan_State
(Scan_State
); -- to where we were
834 Scan
; -- continue search
836 if Token
= Tok_Use
then
848 procedure U_Left_Paren
is
850 if Token
= Tok_Left_Paren
then
853 Error_Msg_AP
-- CODEFIX
862 procedure U_Right_Paren
is
864 if Token
= Tok_Right_Paren
then
867 Error_Msg_AP
-- CODEFIX
876 procedure Wrong_Token
(T
: Token_Type
; P
: Position
) is
877 Missing
: constant String := "missing ";
878 Image
: constant String := Token_Type
'Image (T
);
879 Tok_Name
: constant String := Image
(5 .. Image
'Length);
880 M
: constant String := Missing
& Tok_Name
;
883 if Token
= Tok_Semicolon
then
887 Error_Msg_SP
-- CODEFIX
888 ("|extra "";"" ignored");
894 elsif Token
= Tok_Comma
then
898 Error_Msg_SP
-- CODEFIX
899 ("|extra "","" ignored");
908 when SC
=> Error_Msg_SC
(M
);
909 when BC
=> Error_Msg_BC
(M
);
910 when AP
=> Error_Msg_AP
(M
);