------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- P A R . T C H K -- -- -- -- B o d y -- -- -- -- Copyright (C) 1992-2023, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ -- Token scan routines -- Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync separate (Par) package body Tchk is type Position is (SC, BC, AP); -- Specify position of error message (see Error_Msg_SC/BC/AP) ----------------------- -- Local Subprograms -- ----------------------- procedure Check_Token (T : Token_Type; P : Position); pragma Inline (Check_Token); -- Called by T_xx routines to check for reserved keyword token. P is the -- position of the error message if the token is missing (see Wrong_Token) procedure Wrong_Token (T : Token_Type; P : Position); -- Called when scanning a reserved keyword when the keyword is not present. -- T is the token type for the keyword, and P indicates the position to be -- used to place a message relative to the current token if the keyword is -- not located nearby. ----------------- -- Check_Token -- ----------------- procedure Check_Token (T : Token_Type; P : Position) is begin if Token = T then Scan; return; else Wrong_Token (T, P); end if; end Check_Token; ------------- -- T_Abort -- ------------- procedure T_Abort is begin Check_Token (Tok_Abort, SC); end T_Abort; ------------- -- T_Arrow -- ------------- procedure T_Arrow is begin if Token = Tok_Arrow then Scan; -- A little recovery helper, accept then in place of => elsif Token = Tok_Then then Error_Msg_BC -- CODEFIX ("|THEN should be ""='>"""); Scan; -- past THEN used in place of => elsif Token = Tok_Colon_Equal then Error_Msg_SC -- CODEFIX ("|"":="" should be ""='>"""); Scan; -- past := used in place of => else Error_Msg_AP -- CODEFIX ("missing ""='>"""); end if; end T_Arrow; ---------- -- T_At -- ---------- procedure T_At is begin Check_Token (Tok_At, SC); end T_At; ------------ -- T_Body -- ------------ procedure T_Body is begin Check_Token (Tok_Body, BC); end T_Body; ----------- -- T_Box -- ----------- procedure T_Box is begin if Token = Tok_Box then Scan; else Error_Msg_AP -- CODEFIX ("missing ""'<'>"""); end if; end T_Box; ------------- -- T_Colon -- ------------- procedure T_Colon is begin if Token = Tok_Colon then Scan; else Error_Msg_AP -- CODEFIX ("missing "":"""); end if; end T_Colon; ------------------- -- T_Colon_Equal -- ------------------- procedure T_Colon_Equal is begin if Token = Tok_Colon_Equal then Scan; elsif Token = Tok_Equal then Error_Msg_SC -- CODEFIX ("|""="" should be "":="""); Scan; elsif Token = Tok_Colon then Error_Msg_SC -- CODEFIX ("|"":"" should be "":="""); Scan; elsif Token = Tok_Is then Error_Msg_SC -- CODEFIX ("|IS should be "":="""); Scan; else Error_Msg_AP -- CODEFIX ("missing "":="""); end if; end T_Colon_Equal; ------------- -- T_Comma -- ------------- procedure T_Comma is begin if Token = Tok_Comma then Scan; else if Token = Tok_Pragma then P_Pragmas_Misplaced; end if; if Token = Tok_Comma then Scan; else Error_Msg_AP -- CODEFIX ("missing "","""); end if; end if; if Token = Tok_Pragma then P_Pragmas_Misplaced; end if; end T_Comma; --------------- -- T_Dot_Dot -- --------------- procedure T_Dot_Dot is begin if Token = Tok_Dot_Dot then Scan; else Error_Msg_AP -- CODEFIX ("missing "".."""); end if; end T_Dot_Dot; ----------- -- T_For -- ----------- procedure T_For is begin Check_Token (Tok_For, AP); end T_For; ----------------------- -- T_Greater_Greater -- ----------------------- procedure T_Greater_Greater is begin if Token = Tok_Greater_Greater then Scan; else Error_Msg_AP -- CODEFIX ("missing ""'>'>"""); end if; end T_Greater_Greater; ------------------ -- T_Identifier -- ------------------ procedure T_Identifier is begin if Token = Tok_Identifier then Scan; elsif Token in Token_Class_Literal then Error_Msg_SC ("identifier expected"); Scan; else Error_Msg_AP ("identifier expected"); end if; end T_Identifier; ---------- -- T_In -- ---------- procedure T_In is begin Check_Token (Tok_In, AP); end T_In; ---------- -- T_Is -- ---------- procedure T_Is is begin Ignore (Tok_Semicolon); -- If we have IS scan past it if Token = Tok_Is then Scan; -- And ignore any following semicolons Ignore (Tok_Semicolon); -- Allow OF, => or = to substitute for IS with complaint elsif Token = Tok_Arrow then Error_Msg_SC -- CODEFIX ("|""=>"" should be IS"); Scan; -- past => elsif Token = Tok_Of then Error_Msg_SC -- CODEFIX ("|OF should be IS"); Scan; -- past OF elsif Token = Tok_Equal then Error_Msg_SC -- CODEFIX ("|""="" should be IS"); Scan; -- past = else Wrong_Token (Tok_Is, AP); end if; -- Ignore extra IS keywords while Token = Tok_Is loop Error_Msg_SC -- CODEFIX ("|extra IS ignored"); Scan; end loop; end T_Is; ------------------ -- T_Left_Paren -- ------------------ procedure T_Left_Paren is begin if Token = Tok_Left_Paren then Scan; else Error_Msg_AP -- CODEFIX ("missing ""("""); end if; end T_Left_Paren; ------------ -- T_Loop -- ------------ procedure T_Loop is begin if Token = Tok_Do then Error_Msg_SC -- CODEFIX ("LOOP expected"); Scan; else Check_Token (Tok_Loop, AP); end if; end T_Loop; ----------- -- T_Mod -- ----------- procedure T_Mod is begin Check_Token (Tok_Mod, AP); end T_Mod; ----------- -- T_New -- ----------- procedure T_New is begin Check_Token (Tok_New, AP); end T_New; ---------- -- T_Of -- ---------- procedure T_Of is begin Check_Token (Tok_Of, AP); end T_Of; ---------- -- T_Or -- ---------- procedure T_Or is begin Check_Token (Tok_Or, AP); end T_Or; --------------- -- T_Private -- --------------- procedure T_Private is begin Check_Token (Tok_Private, SC); end T_Private; ------------- -- T_Range -- ------------- procedure T_Range is begin Check_Token (Tok_Range, AP); end T_Range; -------------- -- T_Record -- -------------- procedure T_Record is begin Check_Token (Tok_Record, AP); end T_Record; --------------------------- -- T_Right_Curly_Bracket -- --------------------------- procedure T_Right_Curly_Bracket is begin if Token = Tok_Right_Curly_Bracket then Scan; else Error_Msg_AP ("|missing ""'}'"""); end if; end T_Right_Curly_Bracket; --------------------- -- T_Right_Bracket -- --------------------- procedure T_Right_Bracket is begin if Token = Tok_Right_Bracket then Scan; else Error_Msg_AP -- CODEFIX ("|missing ""']'"""); end if; end T_Right_Bracket; ------------------- -- T_Right_Paren -- ------------------- procedure T_Right_Paren is begin if Token = Tok_Right_Paren then Scan; else Error_Msg_AP -- CODEFIX ("|missing "")"""); end if; end T_Right_Paren; ----------------- -- T_Semicolon -- ----------------- procedure T_Semicolon is begin if Token = Tok_Semicolon then Scan; if Token = Tok_Semicolon then Error_Msg_SC -- CODEFIX ("|extra "";"" ignored"); Scan; end if; return; elsif Token = Tok_Colon then Error_Msg_SC -- CODEFIX ("|"":"" should be "";"""); Scan; return; elsif Token = Tok_Comma then Error_Msg_SC -- CODEFIX ("|"","" should be "";"""); Scan; return; elsif Token = Tok_Dot then Error_Msg_SC -- CODEFIX ("|""."" should be "";"""); Scan; return; -- An interesting little case. If the previous token is a semicolon, -- then there is no way that we can legitimately need another semicolon. -- This could only arise in an situation where an error has already been -- signalled. By simply ignoring the request for a semicolon in this -- case, we avoid some spurious missing semicolon messages. elsif Prev_Token = Tok_Semicolon then return; -- If the current token is | then this is a reasonable place to suggest -- the possibility of a "C" confusion. elsif Token = Tok_Vertical_Bar then Error_Msg_SC -- CODEFIX ("unexpected occurrence of ""'|"", did you mean OR'?"); Resync_Past_Semicolon; return; -- Deal with pragma. If pragma is not at start of line, it is considered -- misplaced otherwise we treat it as a normal missing semicolon case. elsif Token = Tok_Pragma and then not Token_Is_At_Start_Of_Line then P_Pragmas_Misplaced; if Token = Tok_Semicolon then Scan; return; end if; end if; -- If none of those tests return, we really have a missing semicolon Error_Msg_AP -- CODEFIX ("|missing "";"""); return; end T_Semicolon; ------------ -- T_Then -- ------------ procedure T_Then is begin Check_Token (Tok_Then, AP); end T_Then; ------------ -- T_Type -- ------------ procedure T_Type is begin Check_Token (Tok_Type, BC); end T_Type; ----------- -- T_Use -- ----------- procedure T_Use is begin Check_Token (Tok_Use, SC); end T_Use; ------------ -- T_When -- ------------ procedure T_When is begin Check_Token (Tok_When, SC); end T_When; ------------ -- T_With -- ------------ procedure T_With is begin Check_Token (Tok_With, BC); end T_With; -------------- -- TF_Arrow -- -------------- procedure TF_Arrow is Scan_State : Saved_Scan_State; begin if Token = Tok_Arrow then Scan; -- skip arrow and we are done elsif Token = Tok_Colon_Equal then T_Arrow; -- Let T_Arrow give the message else T_Arrow; -- give missing arrow message Save_Scan_State (Scan_State); -- at start of junk tokens loop if Prev_Token_Ptr < Current_Line_Start or else Token in Tok_Semicolon | Tok_EOF then Restore_Scan_State (Scan_State); -- to where we were return; end if; Scan; -- continue search if Token = Tok_Arrow then Scan; -- past arrow return; end if; end loop; end if; end TF_Arrow; ----------- -- TF_Is -- ----------- procedure TF_Is is Scan_State : Saved_Scan_State; begin if Token = Tok_Is then T_Is; -- past IS and we are done -- Allow OF or => or = in place of IS (with error message) elsif Token in Tok_Of | Tok_Arrow | Tok_Equal then T_Is; -- give missing IS message and skip bad token else T_Is; -- give missing IS message Save_Scan_State (Scan_State); -- at start of junk tokens loop if Prev_Token_Ptr < Current_Line_Start or else Token in Tok_Semicolon | Tok_EOF then Restore_Scan_State (Scan_State); -- to where we were return; end if; Scan; -- continue search if Token in Tok_Is | Tok_Of | Tok_Arrow then Scan; -- past IS or OF or => return; end if; end loop; end if; end TF_Is; ------------- -- TF_Loop -- ------------- procedure TF_Loop is Scan_State : Saved_Scan_State; begin if Token = Tok_Loop then Scan; -- past LOOP and we are done -- Allow DO or THEN in place of LOOP elsif Token in Tok_Then | Tok_Do then T_Loop; -- give missing LOOP message else T_Loop; -- give missing LOOP message Save_Scan_State (Scan_State); -- at start of junk tokens loop if Prev_Token_Ptr < Current_Line_Start or else Token in Tok_Semicolon | Tok_EOF then Restore_Scan_State (Scan_State); -- to where we were return; end if; Scan; -- continue search if Token in Tok_Loop | Tok_Then then Scan; -- past loop or then (message already generated) return; end if; end loop; end if; end TF_Loop; -------------- -- TF_Return-- -------------- procedure TF_Return is Scan_State : Saved_Scan_State; begin if Token = Tok_Return then Scan; -- skip RETURN and we are done else Error_Msg_SC -- CODEFIX ("missing RETURN"); Save_Scan_State (Scan_State); -- at start of junk tokens loop if Prev_Token_Ptr < Current_Line_Start or else Token in Tok_Semicolon | Tok_EOF then Restore_Scan_State (Scan_State); -- to where we were return; end if; Scan; -- continue search if Token = Tok_Return then Scan; -- past RETURN return; end if; end loop; end if; end TF_Return; ------------------ -- TF_Semicolon -- ------------------ procedure TF_Semicolon is Scan_State : Saved_Scan_State; begin if Token = Tok_Semicolon then T_Semicolon; return; -- An interesting little test here. If the previous token is a -- semicolon, then there is no way that we can legitimately need -- another semicolon. This could only arise in an error situation -- where an error has already been signalled. By simply ignoring -- the request for a semicolon in this case, we avoid some spurious -- missing semicolon messages. elsif Prev_Token = Tok_Semicolon then return; else -- Deal with pragma. If pragma is not at start of line, it is -- considered misplaced otherwise we treat it as a normal -- missing semicolon case. if Token = Tok_Pragma and then not Token_Is_At_Start_Of_Line then P_Pragmas_Misplaced; if Token = Tok_Semicolon then T_Semicolon; return; end if; end if; -- Here we definitely have a missing semicolon, so give message T_Semicolon; -- Scan out junk on rest of line. Scan stops on END keyword, since -- that seems to help avoid cascaded errors. Save_Scan_State (Scan_State); -- at start of junk tokens loop if Prev_Token_Ptr < Current_Line_Start or else Token in Tok_EOF | Tok_End then Restore_Scan_State (Scan_State); -- to where we were return; end if; Scan; -- continue search if Token = Tok_Semicolon then T_Semicolon; return; elsif Token in Token_Class_After_SM then return; end if; end loop; end if; end TF_Semicolon; ------------- -- TF_Then -- ------------- procedure TF_Then is Scan_State : Saved_Scan_State; begin if Token = Tok_Then then Scan; -- past THEN and we are done else T_Then; -- give missing THEN message Save_Scan_State (Scan_State); -- at start of junk tokens loop if Prev_Token_Ptr < Current_Line_Start or else Token in Tok_Semicolon | Tok_EOF then Restore_Scan_State (Scan_State); -- to where we were return; end if; Scan; -- continue search if Token = Tok_Then then Scan; -- past THEN return; end if; end loop; end if; end TF_Then; ------------ -- TF_Use -- ------------ procedure TF_Use is Scan_State : Saved_Scan_State; begin if Token = Tok_Use then Scan; -- past USE and we are done else T_Use; -- give USE expected message Save_Scan_State (Scan_State); -- at start of junk tokens loop if Prev_Token_Ptr < Current_Line_Start or else Token in Tok_Semicolon | Tok_EOF then Restore_Scan_State (Scan_State); -- to where we were return; end if; Scan; -- continue search if Token = Tok_Use then Scan; -- past use return; end if; end loop; end if; end TF_Use; ------------------ -- U_Left_Paren -- ------------------ procedure U_Left_Paren is begin if Token = Tok_Left_Paren then Scan; else Error_Msg_AP -- CODEFIX ("missing ""(""!"); end if; end U_Left_Paren; ------------------- -- U_Right_Paren -- ------------------- procedure U_Right_Paren is begin if Token = Tok_Right_Paren then Scan; else Error_Msg_AP -- CODEFIX ("|missing "")""!"); end if; end U_Right_Paren; ----------------- -- Wrong_Token -- ----------------- procedure Wrong_Token (T : Token_Type; P : Position) is Missing : constant String := "missing "; Image : constant String := Token_Type'Image (T); Tok_Name : constant String := Image (5 .. Image'Length); M : constant String := Missing & Tok_Name; begin if Token = Tok_Semicolon then Scan; if Token = T then Error_Msg_SP -- CODEFIX ("|extra "";"" ignored"); Scan; else Error_Msg_SP (M); end if; elsif Token = Tok_Comma then Scan; if Token = T then Error_Msg_SP -- CODEFIX ("|extra "","" ignored"); Scan; else Error_Msg_SP (M); end if; else case P is when SC => Error_Msg_SC (M); when BC => Error_Msg_BC (M); when AP => Error_Msg_AP (M); end case; end if; end Wrong_Token; end Tchk;