obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.

1 files changed, 904 insertions, 0 deletions

diff --git a/gcc/ada/par-tchk.adb b/gcc/ada/par-tchk.adb
new file mode 100644
index 000000000..c92b20fbf
--- /dev/null
+++ b/gcc/ada/par-tchk.adb
@@ -0,0 +1,904 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         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;