URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [par-tchk.adb] - Blame information for rev 760

Go to most recent revision | Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         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;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [par-tchk.adb] - Blame information for rev 760

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT COMPILER COMPONENTS --`
4			`-- --`
5			`-- P A R . T C H K --`
6			`-- --`
7			`-- B o d y --`
8			`-- --`
9			`-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --`
10			`-- --`
11			`-- GNAT is free software; you can redistribute it and/or modify it under --`
12			`-- terms of the GNU General Public License as published by the Free Soft- --`
13			`-- ware Foundation; either version 3, or (at your option) any later ver- --`
14			`-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --`
15			`-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --`
16			`-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --`
17			`-- for more details. You should have received a copy of the GNU General --`
18			`-- Public License distributed with GNAT; see file COPYING3. If not, go to --`
19			`-- http://www.gnu.org/licenses for a complete copy of the license. --`
20			`-- --`
21			`-- GNAT was originally developed by the GNAT team at New York University. --`
22			`-- Extensive contributions were provided by Ada Core Technologies Inc. --`
23			`-- --`
24			`------------------------------------------------------------------------------`
25
26			`-- Token scan routines`
27
28			`-- Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync`
29
30			`separate (Par)`
31			`package body Tchk is`
32
33			`type Position is (SC, BC, AP);`
34			`-- Specify position of error message (see Error_Msg_SC/BC/AP)`
35
36			`-----------------------`
37			`-- Local Subprograms --`
38			`-----------------------`
39
40			`procedure Check_Token (T : Token_Type; P : Position);`
41			`pragma Inline (Check_Token);`
42			`-- Called by T_xx routines to check for reserved keyword token. P is the`
43			`-- position of the error message if the token is missing (see Wrong_Token)`
44
45			`procedure Wrong_Token (T : Token_Type; P : Position);`
46			`-- Called when scanning a reserved keyword when the keyword is not present.`
47			`-- T is the token type for the keyword, and P indicates the position to be`
48			`-- used to place a message relative to the current token if the keyword is`
49			`-- not located nearby.`
50
51			`-----------------`
52			`-- Check_Token --`
53			`-----------------`
54
55			`procedure Check_Token (T : Token_Type; P : Position) is`
56			`begin`
57			`if Token = T then`
58			`Scan;`
59			`return;`
60			`else`
61			`Wrong_Token (T, P);`
62			`end if;`
63			`end Check_Token;`
64
65			`-------------`
66			`-- T_Abort --`
67			`-------------`
68
69			`procedure T_Abort is`
70			`begin`
71			`Check_Token (Tok_Abort, SC);`
72			`end T_Abort;`
73
74			`-------------`
75			`-- T_Arrow --`
76			`-------------`
77
78			`procedure T_Arrow is`
79			`begin`
80			`if Token = Tok_Arrow then`
81			`Scan;`
82
83			`-- A little recovery helper, accept then in place of =>`
84
85			`elsif Token = Tok_Then then`
86			`Error_Msg_BC -- CODEFIX`
87			`("\|THEN should be ""='>""");`
88			`Scan; -- past THEN used in place of =>`
89
90			`elsif Token = Tok_Colon_Equal then`
91			`Error_Msg_SC -- CODEFIX`
92			`("\|"":="" should be ""='>""");`
93			`Scan; -- past := used in place of =>`
94
95			`else`
96			`Error_Msg_AP -- CODEFIX`
97			`("missing ""='>""");`
98			`end if;`
99			`end T_Arrow;`
100
101			`----------`
102			`-- T_At --`
103			`----------`
104
105			`procedure T_At is`
106			`begin`
107			`Check_Token (Tok_At, SC);`
108			`end T_At;`
109
110			`------------`
111			`-- T_Body --`
112			`------------`
113
114			`procedure T_Body is`
115			`begin`
116			`Check_Token (Tok_Body, BC);`
117			`end T_Body;`
118
119			`-----------`
120			`-- T_Box --`
121			`-----------`
122
123			`procedure T_Box is`
124			`begin`
125			`if Token = Tok_Box then`
126			`Scan;`
127			`else`
128			`Error_Msg_AP -- CODEFIX`
129			`("missing ""'<'>""");`
130			`end if;`
131			`end T_Box;`
132
133			`-------------`
134			`-- T_Colon --`
135			`-------------`
136
137			`procedure T_Colon is`
138			`begin`
139			`if Token = Tok_Colon then`
140			`Scan;`
141			`else`
142			`Error_Msg_AP -- CODEFIX`
143			`("missing "":""");`
144			`end if;`
145			`end T_Colon;`
146
147			`-------------------`
148			`-- T_Colon_Equal --`
149			`-------------------`
150
151			`procedure T_Colon_Equal is`
152			`begin`
153			`if Token = Tok_Colon_Equal then`
154			`Scan;`
155
156			`elsif Token = Tok_Equal then`
157			`Error_Msg_SC -- CODEFIX`
158			`("\|""="" should be "":=""");`
159			`Scan;`
160
161			`elsif Token = Tok_Colon then`
162			`Error_Msg_SC -- CODEFIX`
163			`("\|"":"" should be "":=""");`
164			`Scan;`
165
166			`elsif Token = Tok_Is then`
167			`Error_Msg_SC -- CODEFIX`
168			`("\|IS should be "":=""");`
169			`Scan;`
170
171			`else`
172			`Error_Msg_AP -- CODEFIX`
173			`("missing "":=""");`
174			`end if;`
175			`end T_Colon_Equal;`
176
177			`-------------`
178			`-- T_Comma --`
179			`-------------`
180
181			`procedure T_Comma is`
182			`begin`
183			`if Token = Tok_Comma then`
184			`Scan;`
185
186			`else`
187			`if Token = Tok_Pragma then`
188			`P_Pragmas_Misplaced;`
189			`end if;`
190
191			`if Token = Tok_Comma then`
192			`Scan;`
193			`else`
194			`Error_Msg_AP -- CODEFIX`
195			`("missing "",""");`
196			`end if;`
197			`end if;`
198
199			`if Token = Tok_Pragma then`
200			`P_Pragmas_Misplaced;`
201			`end if;`
202			`end T_Comma;`
203
204			`---------------`
205			`-- T_Dot_Dot --`
206			`---------------`
207
208			`procedure T_Dot_Dot is`
209			`begin`
210			`if Token = Tok_Dot_Dot then`
211			`Scan;`
212			`else`
213			`Error_Msg_AP -- CODEFIX`
214			`("missing ""..""");`
215			`end if;`
216			`end T_Dot_Dot;`
217
218			`-----------`
219			`-- T_For --`
220			`-----------`
221
222			`procedure T_For is`
223			`begin`
224			`Check_Token (Tok_For, AP);`
225			`end T_For;`
226
227			`-----------------------`
228			`-- T_Greater_Greater --`
229			`-----------------------`
230
231			`procedure T_Greater_Greater is`
232			`begin`
233			`if Token = Tok_Greater_Greater then`
234			`Scan;`
235			`else`
236			`Error_Msg_AP -- CODEFIX`
237			`("missing ""'>'>""");`
238			`end if;`
239			`end T_Greater_Greater;`
240
241			`------------------`
242			`-- T_Identifier --`
243			`------------------`
244
245			`procedure T_Identifier is`
246			`begin`
247			`if Token = Tok_Identifier then`
248			`Scan;`
249			`elsif Token in Token_Class_Literal then`
250			`Error_Msg_SC ("identifier expected");`
251			`Scan;`
252			`else`
253			`Error_Msg_AP ("identifier expected");`
254			`end if;`
255			`end T_Identifier;`
256
257			`----------`
258			`-- T_In --`
259			`----------`
260
261			`procedure T_In is`
262			`begin`
263			`Check_Token (Tok_In, AP);`
264			`end T_In;`
265
266			`----------`
267			`-- T_Is --`
268			`----------`
269
270			`procedure T_Is is`
271			`begin`
272			`Ignore (Tok_Semicolon);`
273
274			`-- If we have IS scan past it`
275
276			`if Token = Tok_Is then`
277			`Scan;`
278
279			`-- And ignore any following semicolons`
280
281			`Ignore (Tok_Semicolon);`
282
283			`-- Allow OF, => or = to substitute for IS with complaint`
284
285			`elsif Token = Tok_Arrow then`
286			`Error_Msg_SC -- CODEFIX`
287			`("\|""=>"" should be IS");`
288			`Scan; -- past =>`
289
290			`elsif Token = Tok_Of then`
291			`Error_Msg_SC -- CODEFIX`
292			`("\|OF should be IS");`
293			`Scan; -- past OF`
294
295			`elsif Token = Tok_Equal then`
296			`Error_Msg_SC -- CODEFIX`
297			`("\|""="" should be IS");`
298			`Scan; -- past =`
299
300			`else`
301			`Wrong_Token (Tok_Is, AP);`
302			`end if;`
303
304			`-- Ignore extra IS keywords`
305
306			`while Token = Tok_Is loop`
307			`Error_Msg_SC -- CODEFIX`
308			`("\|extra IS ignored");`
309			`Scan;`
310			`end loop;`
311			`end T_Is;`
312
313			`------------------`
314			`-- T_Left_Paren --`
315			`------------------`
316
317			`procedure T_Left_Paren is`
318			`begin`
319			`if Token = Tok_Left_Paren then`
320			`Scan;`
321			`else`
322			`Error_Msg_AP -- CODEFIX`
323			`("missing ""(""");`
324			`end if;`
325			`end T_Left_Paren;`
326
327			`------------`
328			`-- T_Loop --`
329			`------------`
330
331			`procedure T_Loop is`
332			`begin`
333			`if Token = Tok_Do then`
334			`Error_Msg_SC -- CODEFIX`
335			`("LOOP expected");`
336			`Scan;`
337			`else`
338			`Check_Token (Tok_Loop, AP);`
339			`end if;`
340			`end T_Loop;`
341
342			`-----------`
343			`-- T_Mod --`
344			`-----------`
345
346			`procedure T_Mod is`
347			`begin`
348			`Check_Token (Tok_Mod, AP);`
349			`end T_Mod;`
350
351			`-----------`
352			`-- T_New --`
353			`-----------`
354
355			`procedure T_New is`
356			`begin`
357			`Check_Token (Tok_New, AP);`
358			`end T_New;`
359
360			`----------`
361			`-- T_Of --`
362			`----------`
363
364			`procedure T_Of is`
365			`begin`
366			`Check_Token (Tok_Of, AP);`
367			`end T_Of;`
368
369			`----------`
370			`-- T_Or --`
371			`----------`
372
373			`procedure T_Or is`
374			`begin`
375			`Check_Token (Tok_Or, AP);`
376			`end T_Or;`
377
378			`---------------`
379			`-- T_Private --`
380			`---------------`
381
382			`procedure T_Private is`
383			`begin`
384			`Check_Token (Tok_Private, SC);`
385			`end T_Private;`
386
387			`-------------`
388			`-- T_Range --`
389			`-------------`
390
391			`procedure T_Range is`
392			`begin`
393			`Check_Token (Tok_Range, AP);`
394			`end T_Range;`
395
396			`--------------`
397			`-- T_Record --`
398			`--------------`
399
400			`procedure T_Record is`
401			`begin`
402			`Check_Token (Tok_Record, AP);`
403			`end T_Record;`
404
405			`-------------------`
406			`-- T_Right_Paren --`
407			`-------------------`
408
409			`procedure T_Right_Paren is`
410			`begin`
411			`if Token = Tok_Right_Paren then`
412			`Scan;`
413			`else`
414			`Error_Msg_AP -- CODEFIX`
415			`("\|missing "")""");`
416			`end if;`
417			`end T_Right_Paren;`
418
419			`-----------------`
420			`-- T_Semicolon --`
421			`-----------------`
422
423			`procedure T_Semicolon is`
424			`begin`
425
426			`if Token = Tok_Semicolon then`
427			`Scan;`
428
429			`if Token = Tok_Semicolon then`
430			`Error_Msg_SC -- CODEFIX`
431			`("\|extra "";"" ignored");`
432			`Scan;`
433			`end if;`
434
435			`return;`
436
437			`elsif Token = Tok_Colon then`
438			`Error_Msg_SC -- CODEFIX`
439			`("\|"":"" should be "";""");`
440			`Scan;`
441			`return;`
442
443			`elsif Token = Tok_Comma then`
444			`Error_Msg_SC -- CODEFIX`
445			`("\|"","" should be "";""");`
446			`Scan;`
447			`return;`
448
449			`elsif Token = Tok_Dot then`
450			`Error_Msg_SC -- CODEFIX`
451			`("\|""."" should be "";""");`
452			`Scan;`
453			`return;`
454
455			`-- An interesting little kludge here. If the previous token is a`
456			`-- semicolon, then there is no way that we can legitimately need another`
457			`-- semicolon. This could only arise in an error situation where an error`
458			`-- has already been signalled. By simply ignoring the request for a`
459			`-- semicolon in this case, we avoid some spurious missing semicolon`
460			`-- messages.`
461
462			`elsif Prev_Token = Tok_Semicolon then`
463			`return;`
464
465			`-- If the current token is \| then this is a reasonable place to suggest`
466			`-- the possibility of a "C" confusion.`
467
468			`elsif Token = Tok_Vertical_Bar then`
469			`Error_Msg_SC -- CODEFIX`
470			`("unexpected occurrence of ""'\|"", did you mean OR'?");`
471			`Resync_Past_Semicolon;`
472			`return;`
473
474			`-- Deal with pragma. If pragma is not at start of line, it is considered`
475			`-- misplaced otherwise we treat it as a normal missing semicolon case.`
476
477			`elsif Token = Tok_Pragma`
478			`and then not Token_Is_At_Start_Of_Line`
479			`then`
480			`P_Pragmas_Misplaced;`
481
482			`if Token = Tok_Semicolon then`
483			`Scan;`
484			`return;`
485			`end if;`
486			`end if;`
487
488			`-- If none of those tests return, we really have a missing semicolon`
489
490			`Error_Msg_AP -- CODEFIX`
491			`("\|missing "";""");`
492			`return;`
493			`end T_Semicolon;`
494
495			`------------`
496			`-- T_Then --`
497			`------------`
498
499			`procedure T_Then is`
500			`begin`
501			`Check_Token (Tok_Then, AP);`
502			`end T_Then;`
503
504			`------------`
505			`-- T_Type --`
506			`------------`
507
508			`procedure T_Type is`
509			`begin`
510			`Check_Token (Tok_Type, BC);`
511			`end T_Type;`
512
513			`-----------`
514			`-- T_Use --`
515			`-----------`
516
517			`procedure T_Use is`
518			`begin`
519			`Check_Token (Tok_Use, SC);`
520			`end T_Use;`
521
522			`------------`
523			`-- T_When --`
524			`------------`
525
526			`procedure T_When is`
527			`begin`
528			`Check_Token (Tok_When, SC);`
529			`end T_When;`
530
531			`------------`
532			`-- T_With --`
533			`------------`
534
535			`procedure T_With is`
536			`begin`
537			`Check_Token (Tok_With, BC);`
538			`end T_With;`
539
540			`--------------`
541			`-- TF_Arrow --`
542			`--------------`
543
544			`procedure TF_Arrow is`
545			`Scan_State : Saved_Scan_State;`
546
547			`begin`
548			`if Token = Tok_Arrow then`
549			`Scan; -- skip arrow and we are done`
550
551			`elsif Token = Tok_Colon_Equal then`
552			`T_Arrow; -- Let T_Arrow give the message`
553
554			`else`
555			`T_Arrow; -- give missing arrow message`
556			`Save_Scan_State (Scan_State); -- at start of junk tokens`
557
558			`loop`
559			`if Prev_Token_Ptr < Current_Line_Start`
560			`or else Token = Tok_Semicolon`
561			`or else Token = Tok_EOF`
562			`then`
563			`Restore_Scan_State (Scan_State); -- to where we were!`
564			`return;`
565			`end if;`
566
567			`Scan; -- continue search!`
568
569			`if Token = Tok_Arrow then`
570			`Scan; -- past arrow`
571			`return;`
572			`end if;`
573			`end loop;`
574			`end if;`
575			`end TF_Arrow;`
576
577			`-----------`
578			`-- TF_Is --`
579			`-----------`
580
581			`procedure TF_Is is`
582			`Scan_State : Saved_Scan_State;`
583
584			`begin`
585			`if Token = Tok_Is then`
586			`T_Is; -- past IS and we are done`
587
588			`-- Allow OF or => or = in place of IS (with error message)`
589
590			`elsif Token = Tok_Of`
591			`or else Token = Tok_Arrow`
592			`or else Token = Tok_Equal`
593			`then`
594			`T_Is; -- give missing IS message and skip bad token`
595
596			`else`
597			`T_Is; -- give missing IS message`
598			`Save_Scan_State (Scan_State); -- at start of junk tokens`
599
600			`loop`
601			`if Prev_Token_Ptr < Current_Line_Start`
602			`or else Token = Tok_Semicolon`
603			`or else Token = Tok_EOF`
604			`then`
605			`Restore_Scan_State (Scan_State); -- to where we were!`
606			`return;`
607			`end if;`
608
609			`Scan; -- continue search!`
610
611			`if Token = Tok_Is`
612			`or else Token = Tok_Of`
613			`or else Token = Tok_Arrow`
614			`then`
615			`Scan; -- past IS or OF or =>`
616			`return;`
617			`end if;`
618			`end loop;`
619			`end if;`
620			`end TF_Is;`
621
622			`-------------`
623			`-- TF_Loop --`
624			`-------------`
625
626			`procedure TF_Loop is`
627			`Scan_State : Saved_Scan_State;`
628
629			`begin`
630			`if Token = Tok_Loop then`
631			`Scan; -- past LOOP and we are done`
632
633			`-- Allow DO or THEN in place of LOOP`
634
635			`elsif Token = Tok_Then or else Token = Tok_Do then`
636			`T_Loop; -- give missing LOOP message`
637
638			`else`
639			`T_Loop; -- give missing LOOP message`
640			`Save_Scan_State (Scan_State); -- at start of junk tokens`
641
642			`loop`
643			`if Prev_Token_Ptr < Current_Line_Start`
644			`or else Token = Tok_Semicolon`
645			`or else Token = Tok_EOF`
646			`then`
647			`Restore_Scan_State (Scan_State); -- to where we were!`
648			`return;`
649			`end if;`
650
651			`Scan; -- continue search!`
652
653			`if Token = Tok_Loop or else Token = Tok_Then then`
654			`Scan; -- past loop or then (message already generated)`
655			`return;`
656			`end if;`
657			`end loop;`
658			`end if;`
659			`end TF_Loop;`
660
661			`--------------`
662			`-- TF_Return--`
663			`--------------`
664
665			`procedure TF_Return is`
666			`Scan_State : Saved_Scan_State;`
667
668			`begin`
669			`if Token = Tok_Return then`
670			`Scan; -- skip RETURN and we are done`
671
672			`else`
673			`Error_Msg_SC -- CODEFIX`
674			`("missing RETURN");`
675			`Save_Scan_State (Scan_State); -- at start of junk tokens`
676
677			`loop`
678			`if Prev_Token_Ptr < Current_Line_Start`
679			`or else Token = Tok_Semicolon`
680			`or else Token = Tok_EOF`
681			`then`
682			`Restore_Scan_State (Scan_State); -- to where we were!`
683			`return;`
684			`end if;`
685
686			`Scan; -- continue search!`
687
688			`if Token = Tok_Return then`
689			`Scan; -- past RETURN`
690			`return;`
691			`end if;`
692			`end loop;`
693			`end if;`
694			`end TF_Return;`
695
696			`------------------`
697			`-- TF_Semicolon --`
698			`------------------`
699
700			`procedure TF_Semicolon is`
701			`Scan_State : Saved_Scan_State;`
702
703			`begin`
704			`if Token = Tok_Semicolon then`
705			`T_Semicolon;`
706			`return;`
707
708			`-- An interesting little kludge here. If the previous token is a`
709			`-- semicolon, then there is no way that we can legitimately need`
710			`-- another semicolon. This could only arise in an error situation`
711			`-- where an error has already been signalled. By simply ignoring`
712			`-- the request for a semicolon in this case, we avoid some spurious`
713			`-- missing semicolon messages.`
714
715			`elsif Prev_Token = Tok_Semicolon then`
716			`return;`
717
718			`else`
719			`-- Deal with pragma. If pragma is not at start of line, it is`
720			`-- considered misplaced otherwise we treat it as a normal`
721			`-- missing semicolon case.`
722
723			`if Token = Tok_Pragma`
724			`and then not Token_Is_At_Start_Of_Line`
725			`then`
726			`P_Pragmas_Misplaced;`
727
728			`if Token = Tok_Semicolon then`
729			`T_Semicolon;`
730			`return;`
731			`end if;`
732			`end if;`
733
734			`-- Here we definitely have a missing semicolon, so give message`
735
736			`T_Semicolon;`
737
738			`-- Scan out junk on rest of line. Scan stops on END keyword, since`
739			`-- that seems to help avoid cascaded errors.`
740
741			`Save_Scan_State (Scan_State); -- at start of junk tokens`
742
743			`loop`
744			`if Prev_Token_Ptr < Current_Line_Start`
745			`or else Token = Tok_EOF`
746			`or else Token = Tok_End`
747			`then`
748			`Restore_Scan_State (Scan_State); -- to where we were`
749			`return;`
750			`end if;`
751
752			`Scan; -- continue search`
753
754			`if Token = Tok_Semicolon then`
755			`T_Semicolon;`
756			`return;`
757
758			`elsif Token in Token_Class_After_SM then`
759			`return;`
760			`end if;`
761			`end loop;`
762			`end if;`
763			`end TF_Semicolon;`
764
765			`-------------`
766			`-- TF_Then --`
767			`-------------`
768
769			`procedure TF_Then is`
770			`Scan_State : Saved_Scan_State;`
771
772			`begin`
773			`if Token = Tok_Then then`
774			`Scan; -- past THEN and we are done`
775
776			`else`
777			`T_Then; -- give missing THEN message`
778			`Save_Scan_State (Scan_State); -- at start of junk tokens`
779
780			`loop`
781			`if Prev_Token_Ptr < Current_Line_Start`
782			`or else Token = Tok_Semicolon`
783			`or else Token = Tok_EOF`
784			`then`
785			`Restore_Scan_State (Scan_State); -- to where we were`
786			`return;`
787			`end if;`
788
789			`Scan; -- continue search!`
790
791			`if Token = Tok_Then then`
792			`Scan; -- past THEN`
793			`return;`
794			`end if;`
795			`end loop;`
796			`end if;`
797			`end TF_Then;`
798
799			`------------`
800			`-- TF_Use --`
801			`------------`
802
803			`procedure TF_Use is`
804			`Scan_State : Saved_Scan_State;`
805
806			`begin`
807			`if Token = Tok_Use then`
808			`Scan; -- past USE and we are done`
809
810			`else`
811			`T_Use; -- give USE expected message`
812			`Save_Scan_State (Scan_State); -- at start of junk tokens`
813
814			`loop`
815			`if Prev_Token_Ptr < Current_Line_Start`
816			`or else Token = Tok_Semicolon`
817			`or else Token = Tok_EOF`
818			`then`
819			`Restore_Scan_State (Scan_State); -- to where we were`
820			`return;`
821			`end if;`
822
823			`Scan; -- continue search!`
824
825			`if Token = Tok_Use then`
826			`Scan; -- past use`
827			`return;`
828			`end if;`
829			`end loop;`
830			`end if;`
831			`end TF_Use;`
832
833			`------------------`
834			`-- U_Left_Paren --`
835			`------------------`
836
837			`procedure U_Left_Paren is`
838			`begin`
839			`if Token = Tok_Left_Paren then`
840			`Scan;`
841			`else`
842			`Error_Msg_AP -- CODEFIX`
843			`("missing ""(""!");`
844			`end if;`
845			`end U_Left_Paren;`
846
847			`-------------------`
848			`-- U_Right_Paren --`
849			`-------------------`
850
851			`procedure U_Right_Paren is`
852			`begin`
853			`if Token = Tok_Right_Paren then`
854			`Scan;`
855			`else`
856			`Error_Msg_AP -- CODEFIX`
857			`("\|missing "")""!");`
858			`end if;`
859			`end U_Right_Paren;`
860
861			`-----------------`
862			`-- Wrong_Token --`
863			`-----------------`
864
865			`procedure Wrong_Token (T : Token_Type; P : Position) is`
866			`Missing : constant String := "missing ";`
867			`Image : constant String := Token_Type'Image (T);`
868			`Tok_Name : constant String := Image (5 .. Image'Length);`
869			`M : constant String := Missing & Tok_Name;`
870
871			`begin`
872			`if Token = Tok_Semicolon then`
873			`Scan;`
874
875			`if Token = T then`
876			`Error_Msg_SP -- CODEFIX`
877			`("\|extra "";"" ignored");`
878			`Scan;`
879			`else`
880			`Error_Msg_SP (M);`
881			`end if;`
882
883			`elsif Token = Tok_Comma then`
884			`Scan;`
885
886			`if Token = T then`
887			`Error_Msg_SP -- CODEFIX`
888			`("\|extra "","" ignored");`
889			`Scan;`
890
891			`else`
892			`Error_Msg_SP (M);`
893			`end if;`
894
895			`else`
896			`case P is`
897			`when SC => Error_Msg_SC (M);`
898			`when BC => Error_Msg_BC (M);`
899			`when AP => Error_Msg_AP (M);`
900			`end case;`
901			`end if;`
902			`end Wrong_Token;`
903
904			`end Tchk;`