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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [par-tchk.adb] - Blame information for rev 826

Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             P A R . T C H K                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2009, 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 ("|THEN should be ""='>""");
         Scan; -- past THEN used in place of =>
 
      elsif Token = Tok_Colon_Equal then
         Error_Msg_SC ("|"":="" should be ""='>""");
         Scan; -- past := used in place of =>
 
      else
         Error_Msg_AP ("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 ("missing ""'<'>""");
      end if;
   end T_Box;
 
   -------------
   -- T_Colon --
   -------------
 
   procedure T_Colon is
   begin
      if Token = Tok_Colon then
         Scan;
      else
         Error_Msg_AP ("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 ("|""="" should be "":=""");
         Scan;
 
      elsif Token = Tok_Colon then
         Error_Msg_SC ("|"":"" should be "":=""");
         Scan;
 
      elsif Token = Tok_Is then
         Error_Msg_SC ("|IS should be "":=""");
         Scan;
 
      else
         Error_Msg_AP ("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 ("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 ("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 ("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 ("|""=>"" should be IS");
         Scan; -- past =>
 
      elsif Token = Tok_Of then
         Error_Msg_SC ("|OF should be IS");
         Scan; -- past OF
 
      elsif Token = Tok_Equal then
         Error_Msg_SC ("|""="" 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");
         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 ("missing ""(""");
      end if;
   end T_Left_Paren;
 
   ------------
   -- T_Loop --
   ------------
 
   procedure T_Loop is
   begin
      if Token = Tok_Do then
         Error_Msg_SC ("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 ("|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 ("|extra "";"" ignored");
            Scan;
         end if;
 
         return;
 
      elsif Token = Tok_Colon then
         Error_Msg_SC ("|"":"" should be "";""");
         Scan;
         return;
 
      elsif Token = Tok_Comma then
         Error_Msg_SC ("|"","" should be "";""");
         Scan;
         return;
 
      elsif Token = Tok_Dot then
         Error_Msg_SC ("|""."" 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 ("|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 ("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 ("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 ("|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 ("|extra "";"" ignored");
            Scan;
         else
            Error_Msg_SP (M);
         end if;
 
      elsif Token = Tok_Comma then
         Scan;
 
         if Token = T then
            Error_Msg_SP ("|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-stable/] [gcc-4.5.1/] [gcc/] [ada/] [par-tchk.adb] - Blame information for rev 826

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