blob: 6a62d70c1e9f033fe28f0882265805bfe94ca474 [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P A R . T C H K --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2022, 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_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 = Tok_Semicolon
or else Token = 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 = Tok_Of
or else Token = Tok_Arrow
or else Token = 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 = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); -- to where we were
return;
end if;
Scan; -- continue search
if Token = Tok_Is
or else Token = Tok_Of
or else Token = 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 = Tok_Then or else Token = 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 = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); -- to where we were
return;
end if;
Scan; -- continue search
if Token = Tok_Loop or else Token = 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 = Tok_Semicolon
or else Token = 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 = Tok_EOF
or else Token = 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 = Tok_Semicolon
or else Token = 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 = Tok_Semicolon
or else Token = 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;