File : par-ch11.adb
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-2013, 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 pragma Style_Checks (All_Checks);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
29
30 with Sinfo.CN; use Sinfo.CN;
31
32 separate (Par)
33 package body Ch11 is
34
35 -- Local functions, used only in this chapter
36
37 function P_Exception_Handler return Node_Id;
38 function P_Exception_Choice return Node_Id;
39
40 ---------------------------------
41 -- 11.1 Exception Declaration --
42 ---------------------------------
43
44 -- Parsed by P_Identifier_Declaration (3.3.1)
45
46 ------------------------------------------
47 -- 11.2 Handled Sequence Of Statements --
48 ------------------------------------------
49
50 -- HANDLED_SEQUENCE_OF_STATEMENTS ::=
51 -- SEQUENCE_OF_STATEMENTS
52 -- [exception
53 -- EXCEPTION_HANDLER
54 -- {EXCEPTION_HANDLER}]
55
56 -- Error_Recovery : Cannot raise Error_Resync
57
58 function P_Handled_Sequence_Of_Statements return Node_Id is
59 Handled_Stmt_Seq_Node : Node_Id;
60 Seq_Is_Hidden_In_SPARK : Boolean;
61 Hidden_Region_Start : Source_Ptr;
62
63 begin
64 Handled_Stmt_Seq_Node :=
65 New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);
66
67 -- In SPARK, a HIDE directive can be placed at the beginning of a
68 -- package initialization, thus hiding the sequence of statements (and
69 -- possible exception handlers) from SPARK tool-set. No violation of the
70 -- SPARK restriction should be issued on nodes in a hidden part, which
71 -- is obtained by marking such hidden parts.
72
73 if Token = Tok_SPARK_Hide then
74 Seq_Is_Hidden_In_SPARK := True;
75 Hidden_Region_Start := Token_Ptr;
76 Scan; -- past HIDE directive
77 else
78 Seq_Is_Hidden_In_SPARK := False;
79 end if;
80
81 Set_Statements
82 (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));
83
84 if Token = Tok_Exception then
85 Scan; -- past EXCEPTION
86 Set_Exception_Handlers
87 (Handled_Stmt_Seq_Node, Parse_Exception_Handlers);
88 end if;
89
90 if Seq_Is_Hidden_In_SPARK then
91 Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr);
92 end if;
93
94 return Handled_Stmt_Seq_Node;
95 end P_Handled_Sequence_Of_Statements;
96
97 -----------------------------
98 -- 11.2 Exception Handler --
99 -----------------------------
100
101 -- EXCEPTION_HANDLER ::=
102 -- when [CHOICE_PARAMETER_SPECIFICATION :]
103 -- EXCEPTION_CHOICE {| EXCEPTION_CHOICE} =>
104 -- SEQUENCE_OF_STATEMENTS
105
106 -- CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER
107
108 -- Error recovery: cannot raise Error_Resync
109
110 function P_Exception_Handler return Node_Id is
111 Scan_State : Saved_Scan_State;
112 Handler_Node : Node_Id;
113 Choice_Param_Node : Node_Id;
114
115 begin
116 Exception_Handler_Encountered := True;
117 Handler_Node := New_Node (N_Exception_Handler, Token_Ptr);
118 Set_Local_Raise_Statements (Handler_Node, No_Elist);
119
120 if Style_Check then
121 Style.Check_Indentation;
122 end if;
123
124 T_When;
125
126 -- Test for possible choice parameter present
127
128 if Token = Tok_Identifier then
129 Choice_Param_Node := Token_Node;
130 Save_Scan_State (Scan_State); -- at identifier
131 Scan; -- past identifier
132
133 if Token = Tok_Colon then
134 if Ada_Version = Ada_83 then
135 Error_Msg_SP ("(Ada 83) choice parameter not allowed!");
136 end if;
137
138 Scan; -- past :
139 Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
140 Warn_If_Standard_Redefinition (Choice_Param_Node);
141 Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
142
143 elsif Token = Tok_Others then
144 Error_Msg_AP -- CODEFIX
145 ("missing "":""");
146 Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
147 Warn_If_Standard_Redefinition (Choice_Param_Node);
148 Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
149
150 else
151 Restore_Scan_State (Scan_State); -- to identifier
152 end if;
153 end if;
154
155 -- Loop through exception choices
156
157 Set_Exception_Choices (Handler_Node, New_List);
158
159 loop
160 Append (P_Exception_Choice, Exception_Choices (Handler_Node));
161 exit when Token /= Tok_Vertical_Bar;
162 Scan; -- past vertical bar
163 end loop;
164
165 TF_Arrow;
166 Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
167 return Handler_Node;
168 end P_Exception_Handler;
169
170 ------------------------------------------
171 -- 11.2 Choice Parameter Specification --
172 ------------------------------------------
173
174 -- Parsed by P_Exception_Handler (11.2)
175
176 ----------------------------
177 -- 11.2 Exception Choice --
178 ----------------------------
179
180 -- EXCEPTION_CHOICE ::= exception_NAME | others
181
182 -- Error recovery: cannot raise Error_Resync. If an error occurs, then the
183 -- scan pointer is advanced to the next arrow or vertical bar or semicolon.
184
185 function P_Exception_Choice return Node_Id is
186 begin
187
188 if Token = Tok_Others then
189 Scan; -- past OTHERS
190 return New_Node (N_Others_Choice, Prev_Token_Ptr);
191
192 else
193 return P_Name; -- exception name
194 end if;
195
196 exception
197 when Error_Resync =>
198 Resync_Choice;
199 return Error;
200 end P_Exception_Choice;
201
202 ----------------------------
203 -- 11.3 Raise Expression --
204 ----------------------------
205
206 -- RAISE_EXPRESSION ::= raise [exception_NAME [with string_EXPRESSION]]
207
208 -- The caller has verified that the initial token is RAISE
209
210 -- Error recovery: can raise Error_Resync
211
212 function P_Raise_Expression return Node_Id is
213 Raise_Node : Node_Id;
214
215 begin
216 Error_Msg_Ada_2012_Feature ("raise expression", Token_Ptr);
217 Raise_Node := New_Node (N_Raise_Expression, Token_Ptr);
218 Scan; -- past RAISE
219
220 Set_Name (Raise_Node, P_Name);
221
222 if Token = Tok_With then
223 Scan; -- past WITH
224 Set_Expression (Raise_Node, P_Expression);
225 end if;
226
227 return Raise_Node;
228 end P_Raise_Expression;
229
230 ---------------------------
231 -- 11.3 Raise Statement --
232 ---------------------------
233
234 -- RAISE_STATEMENT ::= raise [exception_NAME with string_EXPRESSION];
235
236 -- The caller has verified that the initial token is RAISE
237
238 -- Error recovery: can raise Error_Resync
239
240 function P_Raise_Statement return Node_Id is
241 Raise_Node : Node_Id;
242
243 begin
244 Raise_Node := New_Node (N_Raise_Statement, Token_Ptr);
245 Scan; -- past RAISE
246
247 if Token /= Tok_Semicolon then
248 Set_Name (Raise_Node, P_Name);
249 end if;
250
251 if Token = Tok_With then
252 if Ada_Version < Ada_2005 then
253 Error_Msg_SC ("string expression in raise is Ada 2005 extension");
254 Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
255 end if;
256
257 Scan; -- past WITH
258 Set_Expression (Raise_Node, P_Expression);
259 end if;
260
261 TF_Semicolon;
262 return Raise_Node;
263 end P_Raise_Statement;
264
265 ------------------------------
266 -- Parse_Exception_Handlers --
267 ------------------------------
268
269 -- This routine scans out a list of exception handlers appearing in a
270 -- construct as:
271
272 -- exception
273 -- EXCEPTION_HANDLER {EXCEPTION_HANDLER}
274
275 -- The caller has scanned out the EXCEPTION keyword
276
277 -- Control returns after scanning the last exception handler, presumably
278 -- at the keyword END, but this is not checked in this routine.
279
280 -- Error recovery: cannot raise Error_Resync
281
282 function Parse_Exception_Handlers return List_Id is
283 Handler : Node_Id;
284 Handlers_List : List_Id;
285 Handler_Is_Hidden_In_SPARK : Boolean;
286 Hidden_Region_Start : Source_Ptr;
287
288 begin
289 -- In SPARK, a HIDE directive can be placed at the beginning of a
290 -- sequence of exception handlers for a subprogram implementation, thus
291 -- hiding the exception handlers from SPARK tool-set. No violation of
292 -- the SPARK restriction should be issued on nodes in a hidden part,
293 -- which is obtained by marking such hidden parts.
294
295 if Token = Tok_SPARK_Hide then
296 Handler_Is_Hidden_In_SPARK := True;
297 Hidden_Region_Start := Token_Ptr;
298 Scan; -- past HIDE directive
299 else
300 Handler_Is_Hidden_In_SPARK := False;
301 end if;
302
303 Handlers_List := New_List;
304 P_Pragmas_Opt (Handlers_List);
305
306 if Token = Tok_End then
307 Error_Msg_SC ("must have at least one exception handler!");
308
309 else
310 loop
311 Handler := P_Exception_Handler;
312 Append (Handler, Handlers_List);
313
314 -- Note: no need to check for pragmas here. Although the
315 -- syntax officially allows them in this position, they
316 -- will have been swallowed up as part of the statement
317 -- sequence of the handler we just scanned out.
318
319 exit when Token /= Tok_When;
320 end loop;
321 end if;
322
323 if Handler_Is_Hidden_In_SPARK then
324 Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr);
325 end if;
326
327 return Handlers_List;
328 end Parse_Exception_Handlers;
329
330 end Ch11;