905 lines
21 KiB
Ada
905 lines
21 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- P A R . T C H K --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1992-2010, 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_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 kludge 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;
|
|
|
|
-- 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 kludge 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;
|