aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/ada/par-tchk.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/ada/par-tchk.adb')
-rw-r--r--gcc-4.9/gcc/ada/par-tchk.adb902
1 files changed, 902 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/ada/par-tchk.adb b/gcc-4.9/gcc/ada/par-tchk.adb
new file mode 100644
index 000000000..c2d37bda2
--- /dev/null
+++ b/gcc-4.9/gcc/ada/par-tchk.adb
@@ -0,0 +1,902 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- P A R . T C H K --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2013, 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. 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;