-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- 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 2, or (at your option) any later ver- --
+-- 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 COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- 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.
+-- Token scan routines
-- Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync
-- 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.
+ -- 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 --
-- A little recovery helper, accept then in place of =>
elsif Token = Tok_Then then
- Error_Msg_BC ("missing ""='>""");
+ Error_Msg_BC -- CODEFIX
+ ("|THEN should be ""='>""");
Scan; -- past THEN used in place of =>
elsif Token = Tok_Colon_Equal then
- Error_Msg_SC (""":="" should be ""='>""");
+ Error_Msg_SC -- CODEFIX
+ ("|"":="" should be ""='>""");
Scan; -- past := used in place of =>
else
- Error_Msg_AP ("missing ""='>""");
+ Error_Msg_AP -- CODEFIX
+ ("missing ""='>""");
end if;
end T_Arrow;
if Token = Tok_Box then
Scan;
else
- Error_Msg_AP ("missing ""'<'>""");
+ Error_Msg_AP -- CODEFIX
+ ("missing ""'<'>""");
end if;
end T_Box;
if Token = Tok_Colon then
Scan;
else
- Error_Msg_AP ("missing "":""");
+ Error_Msg_AP -- CODEFIX
+ ("missing "":""");
end if;
end T_Colon;
Scan;
elsif Token = Tok_Equal then
- Error_Msg_SC ("""="" should be "":=""");
+ Error_Msg_SC -- CODEFIX
+ ("|""="" should be "":=""");
Scan;
elsif Token = Tok_Colon then
- Error_Msg_SC (""":"" should be "":=""");
+ Error_Msg_SC -- CODEFIX
+ ("|"":"" should be "":=""");
Scan;
elsif Token = Tok_Is then
- Error_Msg_SC ("IS should be "":=""");
+ Error_Msg_SC -- CODEFIX
+ ("|IS should be "":=""");
Scan;
else
- Error_Msg_AP ("missing "":=""");
+ Error_Msg_AP -- CODEFIX
+ ("missing "":=""");
end if;
end T_Colon_Equal;
if Token = Tok_Comma then
Scan;
else
- Error_Msg_AP ("missing "",""");
+ Error_Msg_AP -- CODEFIX
+ ("missing "",""");
end if;
end if;
if Token = Tok_Dot_Dot then
Scan;
else
- Error_Msg_AP ("missing ""..""");
+ Error_Msg_AP -- CODEFIX
+ ("missing ""..""");
end if;
end T_Dot_Dot;
if Token = Tok_Greater_Greater then
Scan;
else
- Error_Msg_AP ("missing ""'>'>""");
+ Error_Msg_AP -- CODEFIX
+ ("missing ""'>'>""");
end if;
end T_Greater_Greater;
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
- or else Token = Tok_Of
- or else Token = Tok_Equal
- then
- Error_Msg_SC ("missing IS");
- Scan; -- token used in place of IS
+ 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 ("extra IS ignored");
+ Error_Msg_SC -- CODEFIX
+ ("|extra IS ignored");
Scan;
end loop;
end T_Is;
if Token = Tok_Left_Paren then
Scan;
else
- Error_Msg_AP ("missing ""(""");
+ Error_Msg_AP -- CODEFIX
+ ("missing ""(""");
end if;
end T_Left_Paren;
procedure T_Loop is
begin
if Token = Tok_Do then
- Error_Msg_SC ("LOOP expected");
+ Error_Msg_SC -- CODEFIX
+ ("LOOP expected");
Scan;
else
Check_Token (Tok_Loop, AP);
if Token = Tok_Right_Paren then
Scan;
else
- Error_Msg_AP ("missing "")""");
+ Error_Msg_AP -- CODEFIX
+ ("|missing "")""");
end if;
end T_Right_Paren;
Scan;
if Token = Tok_Semicolon then
- Error_Msg_SC ("extra "";"" ignored");
+ Error_Msg_SC -- CODEFIX
+ ("|extra "";"" ignored");
Scan;
end if;
return;
elsif Token = Tok_Colon then
- Error_Msg_SC (""":"" should be "";""");
+ Error_Msg_SC -- CODEFIX
+ ("|"":"" should be "";""");
Scan;
return;
elsif Token = Tok_Comma then
- Error_Msg_SC (""","" should be "";""");
+ Error_Msg_SC -- CODEFIX
+ ("|"","" should be "";""");
Scan;
return;
elsif Token = Tok_Dot then
- Error_Msg_SC ("""."" should be "";""");
+ 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.
+ -- 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 :-)
+ -- 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 ("unexpected occurrence of ""'|"", did you mean OR'?");
+ 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 semicolong case.
+ -- 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
-- If none of those tests return, we really have a missing semicolon
- Error_Msg_AP ("|missing "";""");
+ Error_Msg_AP -- CODEFIX
+ ("|missing "";""");
return;
end T_Semicolon;
Scan; -- skip RETURN and we are done
else
- Error_Msg_SC ("missing RETURN");
+ Error_Msg_SC -- CODEFIX
+ ("missing RETURN");
Save_Scan_State (Scan_State); -- at start of junk tokens
loop
else
-- Deal with pragma. If pragma is not at start of line, it is
-- considered misplaced otherwise we treat it as a normal
- -- missing semicolong case.
+ -- missing semicolon case.
if Token = Tok_Pragma
and then not Token_Is_At_Start_Of_Line
T_Semicolon;
- -- Scan out junk on rest of line
+ -- 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;
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);
+ Missing : constant String := "missing ";
+ Image : constant String := Token_Type'Image (T);
Tok_Name : constant String := Image (5 .. Image'Length);
- M : String (1 .. Missing'Length + Tok_Name'Length);
+ M : constant String := Missing & Tok_Name;
begin
- -- Set M to Missing & Tok_Name.
-
- M (1 .. Missing'Length) := Missing;
- M (Missing'Length + 1 .. M'Last) := Tok_Name;
-
if Token = Tok_Semicolon then
Scan;
if Token = T then
- Error_Msg_SP ("extra "";"" ignored");
+ Error_Msg_SP -- CODEFIX
+ ("|extra "";"" ignored");
Scan;
else
Error_Msg_SP (M);
Scan;
if Token = T then
- Error_Msg_SP ("extra "","" ignored");
+ Error_Msg_SP -- CODEFIX
+ ("|extra "","" ignored");
Scan;
else
OSDN Git Service
