|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- P A R . C H 1 1 --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
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;
|
