1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                             P A R . C H 1 1                              --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2002 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 2,  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 COPYING.  If not, write --
19-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
20-- MA 02111-1307, USA.                                                      --
21--                                                                          --
22-- GNAT was originally developed  by the GNAT team at  New York University. --
23-- Extensive contributions were provided by Ada Core Technologies Inc.      --
24--                                                                          --
25------------------------------------------------------------------------------
26
27pragma Style_Checks (All_Checks);
28--  Turn off subprogram body ordering check. Subprograms are in order
29--  by RM section rather than alphabetical
30
31with Sinfo.CN; use Sinfo.CN;
32
33separate (Par)
34package body Ch11 is
35
36   --  Local functions, used only in this chapter
37
38   function P_Exception_Handler  return Node_Id;
39   function P_Exception_Choice   return Node_Id;
40
41   ---------------------------------
42   -- 11.1  Exception Declaration --
43   ---------------------------------
44
45   --  Parsed by P_Identifier_Declaration (3.3.1)
46
47   ------------------------------------------
48   -- 11.2  Handled Sequence Of Statements --
49   ------------------------------------------
50
51   --  HANDLED_SEQUENCE_OF_STATEMENTS ::=
52   --      SEQUENCE_OF_STATEMENTS
53   --    [exception
54   --      EXCEPTION_HANDLER
55   --      {EXCEPTION_HANDLER}]
56
57   --  Error_Recovery : Cannot raise Error_Resync
58
59   function P_Handled_Sequence_Of_Statements return Node_Id is
60      Handled_Stmt_Seq_Node : Node_Id;
61
62   begin
63      Handled_Stmt_Seq_Node :=
64        New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);
65      Set_Statements
66        (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));
67
68      if Token = Tok_Exception then
69         Scan; -- past EXCEPTION
70         Set_Exception_Handlers
71           (Handled_Stmt_Seq_Node, Parse_Exception_Handlers);
72      end if;
73
74      return Handled_Stmt_Seq_Node;
75   end P_Handled_Sequence_Of_Statements;
76
77   -----------------------------
78   -- 11.2  Exception Handler --
79   -----------------------------
80
81   --  EXCEPTION_HANDLER ::=
82   --    when [CHOICE_PARAMETER_SPECIFICATION :]
83   --      EXCEPTION_CHOICE {| EXCEPTION_CHOICE} =>
84   --        SEQUENCE_OF_STATEMENTS
85
86   --  CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER
87
88   --  Error recovery: cannot raise Error_Resync
89
90   function P_Exception_Handler return Node_Id is
91      Scan_State        : Saved_Scan_State;
92      Handler_Node      : Node_Id;
93      Choice_Param_Node : Node_Id;
94
95   begin
96      Handler_Node := New_Node (N_Exception_Handler, Token_Ptr);
97      T_When;
98
99      --  Test for possible choice parameter present
100
101      if Token = Tok_Identifier then
102         Choice_Param_Node := Token_Node;
103         Save_Scan_State (Scan_State); -- at identifier
104         Scan; -- past identifier
105
106         if Token = Tok_Colon then
107            if Ada_83 then
108               Error_Msg_SP ("(Ada 83) choice parameter not allowed!");
109            end if;
110
111            Scan; -- past :
112            Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
113            Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
114
115         elsif Token = Tok_Others then
116            Error_Msg_AP ("missing "":""");
117            Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
118            Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
119
120         else
121            Restore_Scan_State (Scan_State); -- to identifier
122         end if;
123      end if;
124
125      --  Loop through exception choices
126
127      Set_Exception_Choices (Handler_Node, New_List);
128
129      loop
130         Append (P_Exception_Choice, Exception_Choices (Handler_Node));
131         exit when Token /= Tok_Vertical_Bar;
132         Scan; -- past vertical bar
133      end loop;
134
135      TF_Arrow;
136      Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
137      return Handler_Node;
138   end P_Exception_Handler;
139
140   ------------------------------------------
141   -- 11.2  Choice Parameter Specification --
142   ------------------------------------------
143
144   --  Parsed by P_Exception_Handler (11.2)
145
146   ----------------------------
147   -- 11.2  Exception Choice --
148   ----------------------------
149
150   --  EXCEPTION_CHOICE ::= exception_NAME | others
151
152   --  Error recovery: cannot raise Error_Resync. If an error occurs, then the
153   --  scan pointer is advanced to the next arrow or vertical bar or semicolon.
154
155   function P_Exception_Choice return Node_Id is
156   begin
157
158      if Token = Tok_Others then
159         Scan; -- past OTHERS
160         return New_Node (N_Others_Choice, Prev_Token_Ptr);
161
162      else
163         return P_Name; -- exception name
164      end if;
165
166   exception
167      when Error_Resync =>
168         Resync_Choice;
169         return Error;
170   end P_Exception_Choice;
171
172   ---------------------------
173   -- 11.3  Raise Statement --
174   ---------------------------
175
176   --  RAISE_STATEMENT ::= raise [exception_NAME];
177
178   --  The caller has verified that the initial token is RAISE
179
180   --  Error recovery: can raise Error_Resync
181
182   function P_Raise_Statement return Node_Id is
183      Raise_Node : Node_Id;
184
185   begin
186      Raise_Node := New_Node (N_Raise_Statement, Token_Ptr);
187      Scan; -- past RAISE
188
189      if Token /= Tok_Semicolon then
190         Set_Name (Raise_Node, P_Name);
191      end if;
192
193      TF_Semicolon;
194      return Raise_Node;
195   end P_Raise_Statement;
196
197   ------------------------------
198   -- Parse_Exception_Handlers --
199   ------------------------------
200
201   --  This routine scans out a list of exception handlers appearing in a
202   --  construct as:
203
204   --    exception
205   --      EXCEPTION_HANDLER {EXCEPTION_HANDLER}
206
207   --  The caller has scanned out the EXCEPTION keyword
208
209   --  Control returns after scanning the last exception handler, presumably
210   --  at the keyword END, but this is not checked in this routine.
211
212   --  Error recovery: cannot raise Error_Resync
213
214   function Parse_Exception_Handlers return List_Id is
215      Handler       : Node_Id;
216      Handlers_List : List_Id;
217
218   begin
219      Handlers_List := New_List;
220      P_Pragmas_Opt (Handlers_List);
221
222      if Token = Tok_End then
223         Error_Msg_SC ("must have at least one exception handler!");
224
225      else
226         loop
227            Handler := P_Exception_Handler;
228            Append (Handler, Handlers_List);
229
230            --  Note: no need to check for pragmas here. Although the
231            --  syntax officially allows them in this position, they
232            --  will have been swallowed up as part of the statement
233            --  sequence of the handler we just scanned out.
234
235            exit when Token /= Tok_When;
236         end loop;
237      end if;
238
239      return Handlers_List;
240   end Parse_Exception_Handlers;
241
242end Ch11;
243