|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- P A R . C H 9 --
|
|
|
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 by RM
|
|
|
28 -- section rather than alphabetical.
|
|
|
29
|
|
|
30 separate (Par)
|
|
|
31 package body Ch9 is
|
|
|
32
|
|
|
33 -- Local subprograms, used only in this chapter
|
|
|
34
|
|
|
35 function P_Accept_Alternative return Node_Id;
|
|
|
36 function P_Delay_Alternative return Node_Id;
|
|
|
37 function P_Delay_Relative_Statement return Node_Id;
|
|
|
38 function P_Delay_Until_Statement return Node_Id;
|
|
|
39 function P_Entry_Barrier return Node_Id;
|
|
|
40 function P_Entry_Body_Formal_Part return Node_Id;
|
|
|
41 function P_Entry_Declaration return Node_Id;
|
|
|
42 function P_Entry_Index_Specification return Node_Id;
|
|
|
43 function P_Protected_Definition return Node_Id;
|
|
|
44 function P_Protected_Operation_Declaration_Opt return Node_Id;
|
|
|
45 function P_Protected_Operation_Items return List_Id;
|
|
|
46 function P_Task_Items return List_Id;
|
|
|
47 function P_Task_Definition return Node_Id;
|
|
|
48
|
|
|
49 -----------------------------
|
|
|
50 -- 9.1 Task (also 10.1.3) --
|
|
|
51 -----------------------------
|
|
|
52
|
|
|
53 -- TASK_TYPE_DECLARATION ::=
|
|
|
54 -- task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
|
|
|
55 -- [ASPECT_SPECIFICATIONS]
|
|
|
56 -- [is [new INTERFACE_LIST with] TASK_DEFINITION];
|
|
|
57
|
|
|
58 -- SINGLE_TASK_DECLARATION ::=
|
|
|
59 -- task DEFINING_IDENTIFIER
|
|
|
60 -- [ASPECT_SPECIFICATIONS]
|
|
|
61 -- [is [new INTERFACE_LIST with] TASK_DEFINITION];
|
|
|
62
|
|
|
63 -- TASK_BODY ::=
|
|
|
64 -- task body DEFINING_IDENTIFIER [ASPECT_SPECIFICATIONS] is
|
|
|
65 -- DECLARATIVE_PART
|
|
|
66 -- begin
|
|
|
67 -- HANDLED_SEQUENCE_OF_STATEMENTS
|
|
|
68 -- end [task_IDENTIFIER]
|
|
|
69
|
|
|
70 -- TASK_BODY_STUB ::=
|
|
|
71 -- task body DEFINING_IDENTIFIER is separate
|
|
|
72 -- [ASPECT_SPECIFICATIONS];
|
|
|
73
|
|
|
74 -- This routine scans out a task declaration, task body, or task stub
|
|
|
75
|
|
|
76 -- The caller has checked that the initial token is TASK and scanned
|
|
|
77 -- past it, so that Token is set to the token after TASK
|
|
|
78
|
|
|
79 -- Error recovery: cannot raise Error_Resync
|
|
|
80
|
|
|
81 function P_Task return Node_Id is
|
|
|
82 Aspect_Sloc : Source_Ptr := No_Location;
|
|
|
83 Name_Node : Node_Id;
|
|
|
84 Task_Node : Node_Id;
|
|
|
85 Task_Sloc : Source_Ptr;
|
|
|
86
|
|
|
87 Dummy_Node : constant Node_Id := New_Node (N_Task_Body, Token_Ptr);
|
|
|
88 -- Placeholder node used to hold legal or prematurely declared aspect
|
|
|
89 -- specifications. Depending on the context, the aspect specifications
|
|
|
90 -- may be moved to a new node.
|
|
|
91
|
|
|
92 begin
|
|
|
93 Push_Scope_Stack;
|
|
145
|
94 Scopes (Scope.Last).Etyp := E_Name;
|
|
|
95 Scopes (Scope.Last).Ecol := Start_Column;
|
|
|
96 Scopes (Scope.Last).Sloc := Token_Ptr;
|
|
|
97 Scopes (Scope.Last).Lreq := False;
|
|
111
|
98 Task_Sloc := Prev_Token_Ptr;
|
|
|
99
|
|
|
100 if Token = Tok_Body then
|
|
|
101 Scan; -- past BODY
|
|
|
102 Name_Node := P_Defining_Identifier (C_Is);
|
|
145
|
103 Scopes (Scope.Last).Labl := Name_Node;
|
|
131
|
104 Current_Node := Name_Node;
|
|
111
|
105
|
|
|
106 if Token = Tok_Left_Paren then
|
|
|
107 Error_Msg_SC ("discriminant part not allowed in task body");
|
|
|
108 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
|
|
|
109 end if;
|
|
|
110
|
|
|
111 if Aspect_Specifications_Present then
|
|
|
112 Aspect_Sloc := Token_Ptr;
|
|
|
113 P_Aspect_Specifications (Dummy_Node, Semicolon => False);
|
|
|
114 end if;
|
|
|
115
|
|
|
116 TF_Is;
|
|
|
117
|
|
|
118 -- Task stub
|
|
|
119
|
|
|
120 if Token = Tok_Separate then
|
|
|
121 Scan; -- past SEPARATE
|
|
|
122 Task_Node := New_Node (N_Task_Body_Stub, Task_Sloc);
|
|
|
123 Set_Defining_Identifier (Task_Node, Name_Node);
|
|
|
124
|
|
|
125 if Has_Aspects (Dummy_Node) then
|
|
|
126 Error_Msg
|
|
|
127 ("aspect specifications must come after SEPARATE",
|
|
|
128 Aspect_Sloc);
|
|
|
129 end if;
|
|
|
130
|
|
|
131 P_Aspect_Specifications (Task_Node, Semicolon => False);
|
|
|
132 TF_Semicolon;
|
|
|
133 Pop_Scope_Stack; -- remove unused entry
|
|
|
134
|
|
|
135 -- Task body
|
|
|
136
|
|
|
137 else
|
|
|
138 Task_Node := New_Node (N_Task_Body, Task_Sloc);
|
|
|
139 Set_Defining_Identifier (Task_Node, Name_Node);
|
|
|
140
|
|
|
141 -- Move the aspect specifications to the body node
|
|
|
142
|
|
|
143 if Has_Aspects (Dummy_Node) then
|
|
|
144 Move_Aspects (From => Dummy_Node, To => Task_Node);
|
|
|
145 end if;
|
|
|
146
|
|
|
147 Parse_Decls_Begin_End (Task_Node);
|
|
|
148
|
|
|
149 -- The statement list of a task body needs to include at least a
|
|
|
150 -- null statement, so if a parsing error produces an empty list,
|
|
|
151 -- patch it now.
|
|
|
152
|
|
|
153 if No (First (Statements
|
|
|
154 (Handled_Statement_Sequence (Task_Node))))
|
|
|
155 then
|
|
|
156 Set_Statements (Handled_Statement_Sequence (Task_Node),
|
|
|
157 New_List (Make_Null_Statement (Token_Ptr)));
|
|
|
158 end if;
|
|
|
159 end if;
|
|
|
160
|
|
|
161 return Task_Node;
|
|
|
162
|
|
|
163 -- Otherwise we must have a task declaration
|
|
|
164
|
|
|
165 else
|
|
|
166 if Token = Tok_Type then
|
|
|
167 Scan; -- past TYPE
|
|
|
168 Task_Node := New_Node (N_Task_Type_Declaration, Task_Sloc);
|
|
|
169 Name_Node := P_Defining_Identifier;
|
|
|
170 Set_Defining_Identifier (Task_Node, Name_Node);
|
|
145
|
171 Scopes (Scope.Last).Labl := Name_Node;
|
|
131
|
172 Current_Node := Name_Node;
|
|
111
|
173 Set_Discriminant_Specifications
|
|
|
174 (Task_Node, P_Known_Discriminant_Part_Opt);
|
|
|
175
|
|
|
176 else
|
|
|
177 Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc);
|
|
|
178 Name_Node := P_Defining_Identifier (C_Is);
|
|
|
179 Set_Defining_Identifier (Task_Node, Name_Node);
|
|
145
|
180 Scopes (Scope.Last).Labl := Name_Node;
|
|
131
|
181 Current_Node := Name_Node;
|
|
111
|
182
|
|
|
183 if Token = Tok_Left_Paren then
|
|
|
184 Error_Msg_SC ("discriminant part not allowed for single task");
|
|
|
185 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
|
|
|
186 end if;
|
|
|
187 end if;
|
|
|
188
|
|
|
189 -- Scan aspect specifications, don't eat the semicolon, since it
|
|
|
190 -- might not be there if we have an IS.
|
|
|
191
|
|
|
192 P_Aspect_Specifications (Task_Node, Semicolon => False);
|
|
|
193
|
|
|
194 -- Parse optional task definition. Note that P_Task_Definition scans
|
|
|
195 -- out the semicolon and possible aspect specifications as well as
|
|
|
196 -- the task definition itself.
|
|
|
197
|
|
|
198 if Token = Tok_Semicolon then
|
|
|
199
|
|
|
200 -- A little check, if the next token after semicolon is Entry,
|
|
|
201 -- then surely the semicolon should really be IS
|
|
|
202
|
|
|
203 Scan; -- past semicolon
|
|
|
204
|
|
|
205 if Token = Tok_Entry then
|
|
|
206 Error_Msg_SP -- CODEFIX
|
|
|
207 ("|"";"" should be IS");
|
|
|
208 Set_Task_Definition (Task_Node, P_Task_Definition);
|
|
|
209 else
|
|
|
210 Pop_Scope_Stack; -- Remove unused entry
|
|
|
211 end if;
|
|
|
212
|
|
|
213 -- Here we have a task definition
|
|
|
214
|
|
|
215 else
|
|
|
216 TF_Is; -- must have IS if no semicolon
|
|
|
217
|
|
|
218 -- Ada 2005 (AI-345)
|
|
|
219
|
|
|
220 if Token = Tok_New then
|
|
|
221 Scan; -- past NEW
|
|
|
222
|
|
|
223 if Ada_Version < Ada_2005 then
|
|
|
224 Error_Msg_SP ("task interface is an Ada 2005 extension");
|
|
|
225 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
|
|
|
226 end if;
|
|
|
227
|
|
|
228 Set_Interface_List (Task_Node, New_List);
|
|
|
229
|
|
|
230 loop
|
|
|
231 Append (P_Qualified_Simple_Name, Interface_List (Task_Node));
|
|
|
232 exit when Token /= Tok_And;
|
|
|
233 Scan; -- past AND
|
|
|
234 end loop;
|
|
|
235
|
|
|
236 if Token /= Tok_With then
|
|
|
237 Error_Msg_SC -- CODEFIX
|
|
|
238 ("WITH expected");
|
|
|
239 end if;
|
|
|
240
|
|
|
241 Scan; -- past WITH
|
|
|
242
|
|
|
243 if Token = Tok_Private then
|
|
|
244 Error_Msg_SP -- CODEFIX
|
|
|
245 ("PRIVATE not allowed in task type declaration");
|
|
|
246 end if;
|
|
|
247 end if;
|
|
|
248
|
|
|
249 Set_Task_Definition (Task_Node, P_Task_Definition);
|
|
|
250 end if;
|
|
|
251
|
|
|
252 return Task_Node;
|
|
|
253 end if;
|
|
|
254 end P_Task;
|
|
|
255
|
|
|
256 --------------------------------
|
|
|
257 -- 9.1 Task Type Declaration --
|
|
|
258 --------------------------------
|
|
|
259
|
|
|
260 -- Parsed by P_Task (9.1)
|
|
|
261
|
|
|
262 ----------------------------------
|
|
|
263 -- 9.1 Single Task Declaration --
|
|
|
264 ----------------------------------
|
|
|
265
|
|
|
266 -- Parsed by P_Task (9.1)
|
|
|
267
|
|
|
268 --------------------------
|
|
|
269 -- 9.1 Task Definition --
|
|
|
270 --------------------------
|
|
|
271
|
|
|
272 -- TASK_DEFINITION ::=
|
|
|
273 -- {TASK_ITEM}
|
|
|
274 -- [private
|
|
|
275 -- {TASK_ITEM}]
|
|
|
276 -- end [task_IDENTIFIER];
|
|
|
277
|
|
|
278 -- The caller has already made the scope stack entry
|
|
|
279
|
|
|
280 -- Note: there is a small deviation from official syntax here in that we
|
|
|
281 -- regard the semicolon after end as part of the Task_Definition, and in
|
|
|
282 -- the official syntax, it's part of the enclosing declaration. The reason
|
|
|
283 -- for this deviation is that otherwise the end processing would have to
|
|
|
284 -- be special cased, which would be a nuisance.
|
|
|
285
|
|
|
286 -- Error recovery: cannot raise Error_Resync
|
|
|
287
|
|
|
288 function P_Task_Definition return Node_Id is
|
|
|
289 Def_Node : Node_Id;
|
|
|
290
|
|
|
291 begin
|
|
|
292 Def_Node := New_Node (N_Task_Definition, Token_Ptr);
|
|
|
293 Set_Visible_Declarations (Def_Node, P_Task_Items);
|
|
|
294
|
|
|
295 if Token = Tok_Private then
|
|
|
296 Scan; -- past PRIVATE
|
|
|
297 Set_Private_Declarations (Def_Node, P_Task_Items);
|
|
|
298
|
|
|
299 -- Deal gracefully with multiple PRIVATE parts
|
|
|
300
|
|
|
301 while Token = Tok_Private loop
|
|
|
302 Error_Msg_SC ("only one private part allowed per task");
|
|
|
303 Scan; -- past PRIVATE
|
|
|
304 Append_List (P_Task_Items, Private_Declarations (Def_Node));
|
|
|
305 end loop;
|
|
|
306 end if;
|
|
|
307
|
|
|
308 End_Statements (Def_Node);
|
|
|
309 return Def_Node;
|
|
|
310 end P_Task_Definition;
|
|
|
311
|
|
|
312 --------------------
|
|
|
313 -- 9.1 Task Item --
|
|
|
314 --------------------
|
|
|
315
|
|
|
316 -- TASK_ITEM ::= ENTRY_DECLARATION | REPRESENTATION_CLAUSE
|
|
|
317
|
|
|
318 -- This subprogram scans a (possibly empty) list of task items and pragmas
|
|
|
319
|
|
|
320 -- Error recovery: cannot raise Error_Resync
|
|
|
321
|
|
|
322 -- Note: a pragma can also be returned in this position
|
|
|
323
|
|
|
324 function P_Task_Items return List_Id is
|
|
|
325 Items : List_Id;
|
|
|
326 Item_Node : Node_Id;
|
|
|
327 Decl_Sloc : Source_Ptr;
|
|
|
328
|
|
|
329 begin
|
|
|
330 -- Get rid of active SIS entry from outer scope. This means we will
|
|
|
331 -- miss some nested cases, but it doesn't seem worth the effort. See
|
|
|
332 -- discussion in Par for further details
|
|
|
333
|
|
|
334 SIS_Entry_Active := False;
|
|
|
335
|
|
|
336 -- Loop to scan out task items
|
|
|
337
|
|
|
338 Items := New_List;
|
|
|
339
|
|
|
340 Decl_Loop : loop
|
|
|
341 Decl_Sloc := Token_Ptr;
|
|
|
342
|
|
|
343 if Token = Tok_Pragma then
|
|
|
344 P_Pragmas_Opt (Items);
|
|
|
345
|
|
|
346 -- Ada 2005 (AI-397): Reserved words NOT and OVERRIDING may begin an
|
|
|
347 -- entry declaration.
|
|
|
348
|
|
|
349 elsif Token = Tok_Entry
|
|
|
350 or else Token = Tok_Not
|
|
|
351 or else Token = Tok_Overriding
|
|
|
352 then
|
|
|
353 Append (P_Entry_Declaration, Items);
|
|
|
354
|
|
|
355 elsif Token = Tok_For then
|
|
|
356
|
|
|
357 -- Representation clause in task declaration. The only rep clause
|
|
|
358 -- which is legal in a protected declaration is an address clause,
|
|
|
359 -- so that is what we try to scan out.
|
|
|
360
|
|
|
361 Item_Node := P_Representation_Clause;
|
|
|
362
|
|
|
363 if Nkind (Item_Node) = N_At_Clause then
|
|
|
364 Append (Item_Node, Items);
|
|
|
365
|
|
|
366 elsif Nkind (Item_Node) = N_Attribute_Definition_Clause
|
|
|
367 and then Chars (Item_Node) = Name_Address
|
|
|
368 then
|
|
|
369 Append (Item_Node, Items);
|
|
|
370
|
|
|
371 else
|
|
|
372 Error_Msg
|
|
|
373 ("the only representation clause " &
|
|
|
374 "allowed here is an address clause!", Decl_Sloc);
|
|
|
375 end if;
|
|
|
376
|
|
|
377 elsif Token = Tok_Identifier
|
|
|
378 or else Token in Token_Class_Declk
|
|
|
379 then
|
|
|
380 Error_Msg_SC ("illegal declaration in task definition");
|
|
|
381 Resync_Past_Semicolon;
|
|
|
382
|
|
|
383 else
|
|
|
384 exit Decl_Loop;
|
|
|
385 end if;
|
|
|
386 end loop Decl_Loop;
|
|
|
387
|
|
|
388 return Items;
|
|
|
389 end P_Task_Items;
|
|
|
390
|
|
|
391 --------------------
|
|
|
392 -- 9.1 Task Body --
|
|
|
393 --------------------
|
|
|
394
|
|
|
395 -- Parsed by P_Task (9.1)
|
|
|
396
|
|
|
397 ----------------------------------
|
|
|
398 -- 9.4 Protected (also 10.1.3) --
|
|
|
399 ----------------------------------
|
|
|
400
|
|
|
401 -- PROTECTED_TYPE_DECLARATION ::=
|
|
|
402 -- protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
|
|
|
403 -- [ASPECT_SPECIFICATIONS]
|
|
|
404 -- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
|
|
|
405
|
|
|
406 -- SINGLE_PROTECTED_DECLARATION ::=
|
|
|
407 -- protected DEFINING_IDENTIFIER
|
|
|
408 -- [ASPECT_SPECIFICATIONS]
|
|
|
409 -- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
|
|
|
410
|
|
|
411 -- PROTECTED_BODY ::=
|
|
|
412 -- protected body DEFINING_IDENTIFIER
|
|
|
413 -- [ASPECT_SPECIFICATIONS]
|
|
|
414 -- is
|
|
|
415 -- {PROTECTED_OPERATION_ITEM}
|
|
|
416 -- end [protected_IDENTIFIER];
|
|
|
417
|
|
|
418 -- PROTECTED_BODY_STUB ::=
|
|
|
419 -- protected body DEFINING_IDENTIFIER is separate
|
|
|
420 -- [ASPECT_SPECIFICATIONS];
|
|
|
421
|
|
|
422 -- This routine scans out a protected declaration, protected body
|
|
|
423 -- or a protected stub.
|
|
|
424
|
|
|
425 -- The caller has checked that the initial token is PROTECTED and
|
|
|
426 -- scanned past it, so Token is set to the following token.
|
|
|
427
|
|
|
428 -- Error recovery: cannot raise Error_Resync
|
|
|
429
|
|
|
430 function P_Protected return Node_Id is
|
|
|
431 Aspect_Sloc : Source_Ptr := No_Location;
|
|
|
432 Name_Node : Node_Id;
|
|
|
433 Protected_Node : Node_Id;
|
|
|
434 Protected_Sloc : Source_Ptr;
|
|
|
435 Scan_State : Saved_Scan_State;
|
|
|
436
|
|
|
437 Dummy_Node : constant Node_Id := New_Node (N_Protected_Body, Token_Ptr);
|
|
|
438 -- Placeholder node used to hold legal or prematurely declared aspect
|
|
|
439 -- specifications. Depending on the context, the aspect specifications
|
|
|
440 -- may be moved to a new node.
|
|
|
441
|
|
|
442 begin
|
|
|
443 Push_Scope_Stack;
|
|
145
|
444 Scopes (Scope.Last).Etyp := E_Name;
|
|
|
445 Scopes (Scope.Last).Ecol := Start_Column;
|
|
|
446 Scopes (Scope.Last).Lreq := False;
|
|
111
|
447 Protected_Sloc := Prev_Token_Ptr;
|
|
|
448
|
|
|
449 if Token = Tok_Body then
|
|
|
450 Scan; -- past BODY
|
|
|
451 Name_Node := P_Defining_Identifier (C_Is);
|
|
145
|
452 Scopes (Scope.Last).Labl := Name_Node;
|
|
131
|
453 Current_Node := Name_Node;
|
|
111
|
454
|
|
|
455 if Token = Tok_Left_Paren then
|
|
|
456 Error_Msg_SC ("discriminant part not allowed in protected body");
|
|
|
457 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
|
|
|
458 end if;
|
|
|
459
|
|
|
460 if Aspect_Specifications_Present then
|
|
|
461 Aspect_Sloc := Token_Ptr;
|
|
|
462 P_Aspect_Specifications (Dummy_Node, Semicolon => False);
|
|
|
463 end if;
|
|
|
464
|
|
|
465 TF_Is;
|
|
|
466
|
|
|
467 -- Protected stub
|
|
|
468
|
|
|
469 if Token = Tok_Separate then
|
|
|
470 Scan; -- past SEPARATE
|
|
|
471
|
|
|
472 Protected_Node := New_Node (N_Protected_Body_Stub, Protected_Sloc);
|
|
|
473 Set_Defining_Identifier (Protected_Node, Name_Node);
|
|
|
474
|
|
|
475 if Has_Aspects (Dummy_Node) then
|
|
|
476 Error_Msg
|
|
|
477 ("aspect specifications must come after SEPARATE",
|
|
|
478 Aspect_Sloc);
|
|
|
479 end if;
|
|
|
480
|
|
|
481 P_Aspect_Specifications (Protected_Node, Semicolon => False);
|
|
|
482 TF_Semicolon;
|
|
|
483 Pop_Scope_Stack; -- remove unused entry
|
|
|
484
|
|
|
485 -- Protected body
|
|
|
486
|
|
|
487 else
|
|
|
488 Protected_Node := New_Node (N_Protected_Body, Protected_Sloc);
|
|
|
489 Set_Defining_Identifier (Protected_Node, Name_Node);
|
|
|
490
|
|
|
491 Move_Aspects (From => Dummy_Node, To => Protected_Node);
|
|
|
492 Set_Declarations (Protected_Node, P_Protected_Operation_Items);
|
|
|
493 End_Statements (Protected_Node);
|
|
|
494 end if;
|
|
|
495
|
|
|
496 return Protected_Node;
|
|
|
497
|
|
|
498 -- Otherwise we must have a protected declaration
|
|
|
499
|
|
|
500 else
|
|
|
501 if Token = Tok_Type then
|
|
|
502 Scan; -- past TYPE
|
|
|
503 Protected_Node :=
|
|
|
504 New_Node (N_Protected_Type_Declaration, Protected_Sloc);
|
|
|
505 Name_Node := P_Defining_Identifier (C_Is);
|
|
|
506 Set_Defining_Identifier (Protected_Node, Name_Node);
|
|
145
|
507 Scopes (Scope.Last).Labl := Name_Node;
|
|
131
|
508 Current_Node := Name_Node;
|
|
111
|
509 Set_Discriminant_Specifications
|
|
|
510 (Protected_Node, P_Known_Discriminant_Part_Opt);
|
|
|
511
|
|
|
512 else
|
|
|
513 Protected_Node :=
|
|
|
514 New_Node (N_Single_Protected_Declaration, Protected_Sloc);
|
|
|
515 Name_Node := P_Defining_Identifier (C_Is);
|
|
|
516 Set_Defining_Identifier (Protected_Node, Name_Node);
|
|
|
517
|
|
|
518 if Token = Tok_Left_Paren then
|
|
|
519 Error_Msg_SC
|
|
|
520 ("discriminant part not allowed for single protected");
|
|
|
521 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
|
|
|
522 end if;
|
|
|
523
|
|
145
|
524 Scopes (Scope.Last).Labl := Name_Node;
|
|
131
|
525 Current_Node := Name_Node;
|
|
111
|
526 end if;
|
|
|
527
|
|
|
528 P_Aspect_Specifications (Protected_Node, Semicolon => False);
|
|
|
529
|
|
|
530 -- Check for semicolon not followed by IS, this is something like
|
|
|
531
|
|
|
532 -- protected type r;
|
|
|
533
|
|
|
534 -- where we want
|
|
|
535
|
|
|
536 -- protected type r IS END;
|
|
|
537
|
|
|
538 if Token = Tok_Semicolon then
|
|
|
539 Save_Scan_State (Scan_State); -- at semicolon
|
|
|
540 Scan; -- past semicolon
|
|
|
541
|
|
|
542 if Token /= Tok_Is then
|
|
|
543 Restore_Scan_State (Scan_State);
|
|
|
544 Error_Msg_SC -- CODEFIX
|
|
|
545 ("missing IS");
|
|
|
546 Set_Protected_Definition (Protected_Node,
|
|
|
547 Make_Protected_Definition (Token_Ptr,
|
|
|
548 Visible_Declarations => Empty_List,
|
|
|
549 End_Label => Empty));
|
|
|
550
|
|
|
551 SIS_Entry_Active := False;
|
|
|
552 End_Statements
|
|
|
553 (Protected_Definition (Protected_Node), Protected_Node);
|
|
|
554 return Protected_Node;
|
|
|
555 end if;
|
|
|
556
|
|
|
557 Error_Msg_SP -- CODEFIX
|
|
|
558 ("|extra ""("" ignored");
|
|
|
559 end if;
|
|
|
560
|
|
|
561 T_Is;
|
|
|
562
|
|
|
563 -- Ada 2005 (AI-345)
|
|
|
564
|
|
|
565 if Token = Tok_New then
|
|
|
566 Scan; -- past NEW
|
|
|
567
|
|
|
568 if Ada_Version < Ada_2005 then
|
|
|
569 Error_Msg_SP ("protected interface is an Ada 2005 extension");
|
|
|
570 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
|
|
|
571 end if;
|
|
|
572
|
|
|
573 Set_Interface_List (Protected_Node, New_List);
|
|
|
574
|
|
|
575 loop
|
|
|
576 Append (P_Qualified_Simple_Name,
|
|
|
577 Interface_List (Protected_Node));
|
|
|
578
|
|
|
579 exit when Token /= Tok_And;
|
|
|
580 Scan; -- past AND
|
|
|
581 end loop;
|
|
|
582
|
|
|
583 if Token /= Tok_With then
|
|
|
584 Error_Msg_SC -- CODEFIX
|
|
|
585 ("WITH expected");
|
|
|
586 end if;
|
|
|
587
|
|
|
588 Scan; -- past WITH
|
|
|
589 end if;
|
|
|
590
|
|
|
591 Set_Protected_Definition (Protected_Node, P_Protected_Definition);
|
|
|
592 return Protected_Node;
|
|
|
593 end if;
|
|
|
594 end P_Protected;
|
|
|
595
|
|
|
596 -------------------------------------
|
|
|
597 -- 9.4 Protected Type Declaration --
|
|
|
598 -------------------------------------
|
|
|
599
|
|
|
600 -- Parsed by P_Protected (9.4)
|
|
|
601
|
|
|
602 ---------------------------------------
|
|
|
603 -- 9.4 Single Protected Declaration --
|
|
|
604 ---------------------------------------
|
|
|
605
|
|
|
606 -- Parsed by P_Protected (9.4)
|
|
|
607
|
|
|
608 -------------------------------
|
|
|
609 -- 9.4 Protected Definition --
|
|
|
610 -------------------------------
|
|
|
611
|
|
|
612 -- PROTECTED_DEFINITION ::=
|
|
|
613 -- {PROTECTED_OPERATION_DECLARATION}
|
|
|
614 -- [private
|
|
|
615 -- {PROTECTED_ELEMENT_DECLARATION}]
|
|
|
616 -- end [protected_IDENTIFIER]
|
|
|
617
|
|
|
618 -- PROTECTED_ELEMENT_DECLARATION ::=
|
|
|
619 -- PROTECTED_OPERATION_DECLARATION
|
|
|
620 -- | COMPONENT_DECLARATION
|
|
|
621
|
|
|
622 -- The caller has already established the scope stack entry
|
|
|
623
|
|
|
624 -- Error recovery: cannot raise Error_Resync
|
|
|
625
|
|
|
626 function P_Protected_Definition return Node_Id is
|
|
|
627 Def_Node : Node_Id;
|
|
|
628 Item_Node : Node_Id;
|
|
|
629 Priv_Decls : List_Id;
|
|
|
630 Vis_Decls : List_Id;
|
|
|
631
|
|
|
632 begin
|
|
|
633 Def_Node := New_Node (N_Protected_Definition, Token_Ptr);
|
|
|
634
|
|
|
635 -- Get rid of active SIS entry from outer scope. This means we will
|
|
|
636 -- miss some nested cases, but it doesn't seem worth the effort. See
|
|
|
637 -- discussion in Par for further details
|
|
|
638
|
|
|
639 SIS_Entry_Active := False;
|
|
|
640
|
|
|
641 -- Loop to scan visible declarations (protected operation declarations)
|
|
|
642
|
|
|
643 Vis_Decls := New_List;
|
|
|
644 Set_Visible_Declarations (Def_Node, Vis_Decls);
|
|
|
645
|
|
|
646 -- Flag and discard all pragmas which cannot appear in the protected
|
|
|
647 -- definition. Note that certain pragmas are still allowed as long as
|
|
|
648 -- they apply to entries, entry families, or protected subprograms.
|
|
|
649
|
|
|
650 P_Pragmas_Opt (Vis_Decls);
|
|
|
651
|
|
|
652 loop
|
|
|
653 Item_Node := P_Protected_Operation_Declaration_Opt;
|
|
|
654
|
|
|
655 if Present (Item_Node) then
|
|
|
656 Append (Item_Node, Vis_Decls);
|
|
|
657 end if;
|
|
|
658
|
|
|
659 P_Pragmas_Opt (Vis_Decls);
|
|
|
660
|
|
|
661 exit when No (Item_Node);
|
|
|
662 end loop;
|
|
|
663
|
|
|
664 -- Deal with PRIVATE part (including graceful handling of multiple
|
|
|
665 -- PRIVATE parts).
|
|
|
666
|
|
|
667 Private_Loop : while Token = Tok_Private loop
|
|
|
668 Priv_Decls := Private_Declarations (Def_Node);
|
|
|
669
|
|
|
670 if Present (Priv_Decls) then
|
|
|
671 Error_Msg_SC ("duplicate private part");
|
|
|
672 else
|
|
|
673 Priv_Decls := New_List;
|
|
|
674 Set_Private_Declarations (Def_Node, Priv_Decls);
|
|
|
675 end if;
|
|
|
676
|
|
|
677 Scan; -- past PRIVATE
|
|
|
678
|
|
|
679 -- Flag and discard all pragmas which cannot appear in the protected
|
|
|
680 -- definition. Note that certain pragmas are still allowed as long as
|
|
|
681 -- they apply to entries, entry families, or protected subprograms.
|
|
|
682
|
|
|
683 P_Pragmas_Opt (Priv_Decls);
|
|
|
684
|
|
|
685 Declaration_Loop : loop
|
|
|
686 if Token = Tok_Identifier then
|
|
|
687 P_Component_Items (Priv_Decls);
|
|
|
688 P_Pragmas_Opt (Priv_Decls);
|
|
|
689
|
|
|
690 else
|
|
|
691 Item_Node := P_Protected_Operation_Declaration_Opt;
|
|
|
692
|
|
|
693 if Present (Item_Node) then
|
|
|
694 Append (Item_Node, Priv_Decls);
|
|
|
695 end if;
|
|
|
696
|
|
|
697 P_Pragmas_Opt (Priv_Decls);
|
|
|
698
|
|
|
699 exit Declaration_Loop when No (Item_Node);
|
|
|
700 end if;
|
|
|
701 end loop Declaration_Loop;
|
|
|
702 end loop Private_Loop;
|
|
|
703
|
|
|
704 End_Statements (Def_Node);
|
|
|
705 return Def_Node;
|
|
|
706 end P_Protected_Definition;
|
|
|
707
|
|
|
708 ------------------------------------------
|
|
|
709 -- 9.4 Protected Operation Declaration --
|
|
|
710 ------------------------------------------
|
|
|
711
|
|
|
712 -- PROTECTED_OPERATION_DECLARATION ::=
|
|
|
713 -- SUBPROGRAM_DECLARATION
|
|
|
714 -- | ENTRY_DECLARATION
|
|
|
715 -- | REPRESENTATION_CLAUSE
|
|
|
716
|
|
|
717 -- Error recovery: cannot raise Error_Resync
|
|
|
718
|
|
|
719 -- Note: a pragma can also be returned in this position
|
|
|
720
|
|
|
721 -- We are not currently permitting representation clauses to appear as
|
|
|
722 -- protected operation declarations, do we have to rethink this???
|
|
|
723
|
|
|
724 function P_Protected_Operation_Declaration_Opt return Node_Id is
|
|
|
725 L : List_Id;
|
|
|
726 P : Source_Ptr;
|
|
|
727
|
|
|
728 function P_Entry_Or_Subprogram_With_Indicator return Node_Id;
|
|
|
729 -- Ada 2005 (AI-397): Parse an entry or a subprogram with an overriding
|
|
|
730 -- indicator. The caller has checked that the initial token is NOT or
|
|
|
731 -- OVERRIDING.
|
|
|
732
|
|
|
733 ------------------------------------------
|
|
|
734 -- P_Entry_Or_Subprogram_With_Indicator --
|
|
|
735 ------------------------------------------
|
|
|
736
|
|
|
737 function P_Entry_Or_Subprogram_With_Indicator return Node_Id is
|
|
|
738 Decl : Node_Id := Error;
|
|
|
739 Is_Overriding : Boolean := False;
|
|
|
740 Not_Overriding : Boolean := False;
|
|
|
741
|
|
|
742 begin
|
|
|
743 if Token = Tok_Not then
|
|
|
744 Scan; -- past NOT
|
|
|
745
|
|
|
746 if Token = Tok_Overriding then
|
|
|
747 Scan; -- past OVERRIDING
|
|
|
748 Not_Overriding := True;
|
|
|
749 else
|
|
|
750 Error_Msg_SC -- CODEFIX
|
|
|
751 ("OVERRIDING expected!");
|
|
|
752 end if;
|
|
|
753
|
|
|
754 else
|
|
|
755 Scan; -- past OVERRIDING
|
|
|
756 Is_Overriding := True;
|
|
|
757 end if;
|
|
|
758
|
|
|
759 if Is_Overriding or else Not_Overriding then
|
|
|
760 if Ada_Version < Ada_2005 then
|
|
|
761 Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
|
|
|
762 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
|
|
|
763
|
|
|
764 elsif Token = Tok_Entry then
|
|
|
765 Decl := P_Entry_Declaration;
|
|
|
766
|
|
|
767 Set_Must_Override (Decl, Is_Overriding);
|
|
|
768 Set_Must_Not_Override (Decl, Not_Overriding);
|
|
|
769
|
|
|
770 elsif Token = Tok_Function or else Token = Tok_Procedure then
|
|
|
771 Decl := P_Subprogram (Pf_Decl_Pexp);
|
|
|
772
|
|
|
773 Set_Must_Override (Specification (Decl), Is_Overriding);
|
|
|
774 Set_Must_Not_Override (Specification (Decl), Not_Overriding);
|
|
|
775
|
|
|
776 else
|
|
|
777 Error_Msg_SC -- CODEFIX
|
|
|
778 ("ENTRY, FUNCTION or PROCEDURE expected!");
|
|
|
779 end if;
|
|
|
780 end if;
|
|
|
781
|
|
|
782 return Decl;
|
|
|
783 end P_Entry_Or_Subprogram_With_Indicator;
|
|
|
784
|
|
131
|
785 Result : Node_Id := Empty;
|
|
|
786
|
|
111
|
787 -- Start of processing for P_Protected_Operation_Declaration_Opt
|
|
|
788
|
|
|
789 begin
|
|
131
|
790 -- This loop runs more than once only when a junk declaration is skipped
|
|
111
|
791
|
|
|
792 loop
|
|
131
|
793 case Token is
|
|
|
794 when Tok_Pragma =>
|
|
|
795 Result := P_Pragma;
|
|
|
796 exit;
|
|
|
797
|
|
|
798 when Tok_Not
|
|
|
799 | Tok_Overriding
|
|
|
800 =>
|
|
|
801 Result := P_Entry_Or_Subprogram_With_Indicator;
|
|
|
802 exit;
|
|
|
803
|
|
|
804 when Tok_Entry =>
|
|
|
805 Result := P_Entry_Declaration;
|
|
|
806 exit;
|
|
|
807
|
|
|
808 when Tok_Function
|
|
|
809 | Tok_Procedure
|
|
|
810 =>
|
|
|
811 Result := P_Subprogram (Pf_Decl_Pexp);
|
|
|
812 exit;
|
|
|
813
|
|
|
814 when Tok_Identifier =>
|
|
|
815 L := New_List;
|
|
|
816 P := Token_Ptr;
|
|
|
817 Skip_Declaration (L);
|
|
|
818
|
|
|
819 if Nkind (First (L)) = N_Object_Declaration then
|
|
|
820 Error_Msg
|
|
|
821 ("component must be declared in private part of " &
|
|
|
822 "protected type", P);
|
|
|
823 else
|
|
|
824 Error_Msg
|
|
|
825 ("illegal declaration in protected definition", P);
|
|
|
826 end if;
|
|
|
827 -- Continue looping
|
|
|
828
|
|
|
829 when Tok_For =>
|
|
|
830 Error_Msg_SC
|
|
|
831 ("representation clause not allowed in protected definition");
|
|
|
832 Resync_Past_Semicolon;
|
|
|
833 -- Continue looping
|
|
|
834
|
|
|
835 when others =>
|
|
|
836 if Token in Token_Class_Declk then
|
|
|
837 Error_Msg_SC ("illegal declaration in protected definition");
|
|
|
838 Resync_Past_Semicolon;
|
|
|
839
|
|
|
840 -- Return now to avoid cascaded messages if next declaration
|
|
|
841 -- is a valid component declaration.
|
|
|
842
|
|
|
843 Result := Error;
|
|
|
844 end if;
|
|
|
845
|
|
|
846 exit;
|
|
|
847 end case;
|
|
111
|
848 end loop;
|
|
131
|
849
|
|
|
850 if Nkind (Result) = N_Subprogram_Declaration
|
|
|
851 and then Nkind (Specification (Result)) =
|
|
|
852 N_Procedure_Specification
|
|
|
853 and then Null_Present (Specification (Result))
|
|
|
854 then
|
|
|
855 Error_Msg_N
|
|
|
856 ("protected operation cannot be a null procedure",
|
|
|
857 Null_Statement (Specification (Result)));
|
|
|
858 end if;
|
|
|
859
|
|
|
860 return Result;
|
|
111
|
861 end P_Protected_Operation_Declaration_Opt;
|
|
|
862
|
|
|
863 -----------------------------------
|
|
|
864 -- 9.4 Protected Operation Item --
|
|
|
865 -----------------------------------
|
|
|
866
|
|
|
867 -- PROTECTED_OPERATION_ITEM ::=
|
|
|
868 -- SUBPROGRAM_DECLARATION
|
|
|
869 -- | SUBPROGRAM_BODY
|
|
|
870 -- | ENTRY_BODY
|
|
|
871 -- | REPRESENTATION_CLAUSE
|
|
|
872
|
|
|
873 -- This procedure parses and returns a list of protected operation items
|
|
|
874
|
|
|
875 -- We are not currently permitting representation clauses to appear
|
|
|
876 -- as protected operation items, do we have to rethink this???
|
|
|
877
|
|
|
878 function P_Protected_Operation_Items return List_Id is
|
|
|
879 Item_List : List_Id;
|
|
|
880
|
|
|
881 begin
|
|
|
882 Item_List := New_List;
|
|
|
883
|
|
|
884 loop
|
|
|
885 if Token = Tok_Entry or else Bad_Spelling_Of (Tok_Entry) then
|
|
|
886 Append (P_Entry_Body, Item_List);
|
|
|
887
|
|
|
888 -- If the operation starts with procedure, function, or an overriding
|
|
|
889 -- indicator ("overriding" or "not overriding"), parse a subprogram.
|
|
|
890
|
|
|
891 elsif Token = Tok_Function or else Bad_Spelling_Of (Tok_Function)
|
|
|
892 or else
|
|
|
893 Token = Tok_Procedure or else Bad_Spelling_Of (Tok_Procedure)
|
|
|
894 or else
|
|
|
895 Token = Tok_Overriding or else Bad_Spelling_Of (Tok_Overriding)
|
|
|
896 or else
|
|
|
897 Token = Tok_Not or else Bad_Spelling_Of (Tok_Not)
|
|
|
898 then
|
|
|
899 Append (P_Subprogram (Pf_Decl_Pbod_Pexp), Item_List);
|
|
|
900
|
|
|
901 elsif Token = Tok_Pragma or else Bad_Spelling_Of (Tok_Pragma) then
|
|
|
902 P_Pragmas_Opt (Item_List);
|
|
|
903
|
|
|
904 elsif Token = Tok_Private or else Bad_Spelling_Of (Tok_Private) then
|
|
|
905 Error_Msg_SC ("PRIVATE not allowed in protected body");
|
|
|
906 Scan; -- past PRIVATE
|
|
|
907
|
|
|
908 elsif Token = Tok_Identifier then
|
|
|
909 Error_Msg_SC ("all components must be declared in spec!");
|
|
|
910 Resync_Past_Semicolon;
|
|
|
911
|
|
|
912 elsif Token in Token_Class_Declk then
|
|
|
913 Error_Msg_SC ("this declaration not allowed in protected body");
|
|
|
914 Resync_Past_Semicolon;
|
|
|
915
|
|
|
916 else
|
|
|
917 exit;
|
|
|
918 end if;
|
|
|
919 end loop;
|
|
|
920
|
|
|
921 return Item_List;
|
|
|
922 end P_Protected_Operation_Items;
|
|
|
923
|
|
|
924 ------------------------------
|
|
|
925 -- 9.5.2 Entry Declaration --
|
|
|
926 ------------------------------
|
|
|
927
|
|
|
928 -- ENTRY_DECLARATION ::=
|
|
|
929 -- [OVERRIDING_INDICATOR]
|
|
|
930 -- entry DEFINING_IDENTIFIER
|
|
|
931 -- [(DISCRETE_SUBTYPE_DEFINITION)] PARAMETER_PROFILE
|
|
|
932 -- [ASPECT_SPECIFICATIONS];
|
|
|
933
|
|
|
934 -- The caller has checked that the initial token is ENTRY, NOT or
|
|
|
935 -- OVERRIDING.
|
|
|
936
|
|
|
937 -- Error recovery: cannot raise Error_Resync
|
|
|
938
|
|
|
939 function P_Entry_Declaration return Node_Id is
|
|
|
940 Decl_Node : Node_Id;
|
|
|
941 Scan_State : Saved_Scan_State;
|
|
|
942
|
|
|
943 -- Flags for optional overriding indication. Two flags are needed,
|
|
|
944 -- to distinguish positive and negative overriding indicators from
|
|
|
945 -- the absence of any indicator.
|
|
|
946
|
|
|
947 Is_Overriding : Boolean := False;
|
|
|
948 Not_Overriding : Boolean := False;
|
|
|
949
|
|
|
950 begin
|
|
|
951 -- Ada 2005 (AI-397): Scan leading overriding indicator
|
|
|
952
|
|
|
953 if Token = Tok_Not then
|
|
|
954 Scan; -- past NOT
|
|
|
955
|
|
|
956 if Token = Tok_Overriding then
|
|
|
957 Scan; -- part OVERRIDING
|
|
|
958 Not_Overriding := True;
|
|
|
959 else
|
|
|
960 Error_Msg_SC -- CODEFIX
|
|
|
961 ("OVERRIDING expected!");
|
|
|
962 end if;
|
|
|
963
|
|
|
964 elsif Token = Tok_Overriding then
|
|
|
965 Scan; -- part OVERRIDING
|
|
|
966 Is_Overriding := True;
|
|
|
967 end if;
|
|
|
968
|
|
|
969 if Is_Overriding or else Not_Overriding then
|
|
|
970 if Ada_Version < Ada_2005 then
|
|
|
971 Error_Msg_SP ("overriding indicator is an Ada 2005 extension");
|
|
|
972 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
|
|
|
973
|
|
|
974 elsif Token /= Tok_Entry then
|
|
|
975 Error_Msg_SC -- CODEFIX
|
|
|
976 ("ENTRY expected!");
|
|
|
977 end if;
|
|
|
978 end if;
|
|
|
979
|
|
|
980 Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr);
|
|
|
981 Scan; -- past ENTRY
|
|
|
982
|
|
|
983 Set_Defining_Identifier
|
|
|
984 (Decl_Node, P_Defining_Identifier (C_Left_Paren_Semicolon));
|
|
|
985
|
|
|
986 -- If left paren, could be (Discrete_Subtype_Definition) or Formal_Part
|
|
|
987
|
|
|
988 if Token = Tok_Left_Paren then
|
|
|
989 Scan; -- past (
|
|
|
990
|
|
|
991 -- If identifier after left paren, could still be either
|
|
|
992
|
|
|
993 if Token = Tok_Identifier then
|
|
|
994 Save_Scan_State (Scan_State); -- at Id
|
|
|
995 Scan; -- past Id
|
|
|
996
|
|
|
997 -- If comma or colon after Id, must be Formal_Part
|
|
|
998
|
|
|
999 if Token = Tok_Comma or else Token = Tok_Colon then
|
|
|
1000 Restore_Scan_State (Scan_State); -- to Id
|
|
|
1001 Set_Parameter_Specifications (Decl_Node, P_Formal_Part);
|
|
|
1002
|
|
|
1003 -- Else if Id without comma or colon, must be discrete subtype
|
|
|
1004 -- defn
|
|
|
1005
|
|
|
1006 else
|
|
|
1007 Restore_Scan_State (Scan_State); -- to Id
|
|
|
1008 Set_Discrete_Subtype_Definition
|
|
|
1009 (Decl_Node, P_Discrete_Subtype_Definition);
|
|
|
1010 T_Right_Paren;
|
|
|
1011 Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile);
|
|
|
1012 end if;
|
|
|
1013
|
|
|
1014 -- If no Id, must be discrete subtype definition
|
|
|
1015
|
|
|
1016 else
|
|
|
1017 Set_Discrete_Subtype_Definition
|
|
|
1018 (Decl_Node, P_Discrete_Subtype_Definition);
|
|
|
1019 T_Right_Paren;
|
|
|
1020 Set_Parameter_Specifications (Decl_Node, P_Parameter_Profile);
|
|
|
1021 end if;
|
|
|
1022 end if;
|
|
|
1023
|
|
|
1024 if Is_Overriding then
|
|
|
1025 Set_Must_Override (Decl_Node);
|
|
|
1026 elsif Not_Overriding then
|
|
|
1027 Set_Must_Not_Override (Decl_Node);
|
|
|
1028 end if;
|
|
|
1029
|
|
|
1030 -- Error recovery check for illegal return
|
|
|
1031
|
|
|
1032 if Token = Tok_Return then
|
|
|
1033 Error_Msg_SC ("entry cannot have return value!");
|
|
|
1034 Scan;
|
|
|
1035 Discard_Junk_Node (P_Subtype_Indication);
|
|
|
1036 end if;
|
|
|
1037
|
|
|
1038 -- Error recovery check for improper use of entry barrier in spec
|
|
|
1039
|
|
|
1040 if Token = Tok_When then
|
|
|
1041 Error_Msg_SC ("barrier not allowed here (belongs in body)");
|
|
|
1042 Scan; -- past WHEN;
|
|
|
1043 Discard_Junk_Node (P_Expression_No_Right_Paren);
|
|
|
1044 end if;
|
|
|
1045
|
|
|
1046 P_Aspect_Specifications (Decl_Node);
|
|
|
1047 return Decl_Node;
|
|
|
1048
|
|
|
1049 exception
|
|
|
1050 when Error_Resync =>
|
|
|
1051 Resync_Past_Semicolon;
|
|
|
1052 return Error;
|
|
|
1053 end P_Entry_Declaration;
|
|
|
1054
|
|
|
1055 -----------------------------
|
|
|
1056 -- 9.5.2 Accept Statement --
|
|
|
1057 -----------------------------
|
|
|
1058
|
|
|
1059 -- ACCEPT_STATEMENT ::=
|
|
|
1060 -- accept entry_DIRECT_NAME
|
|
|
1061 -- [(ENTRY_INDEX)] PARAMETER_PROFILE [do
|
|
|
1062 -- HANDLED_SEQUENCE_OF_STATEMENTS
|
|
|
1063 -- end [entry_IDENTIFIER]];
|
|
|
1064
|
|
|
1065 -- The caller has checked that the initial token is ACCEPT
|
|
|
1066
|
|
|
1067 -- Error recovery: cannot raise Error_Resync. If an error occurs, the
|
|
|
1068 -- scan is resynchronized past the next semicolon and control returns.
|
|
|
1069
|
|
|
1070 function P_Accept_Statement return Node_Id is
|
|
|
1071 Scan_State : Saved_Scan_State;
|
|
|
1072 Accept_Node : Node_Id;
|
|
|
1073 Hand_Seq : Node_Id;
|
|
|
1074
|
|
|
1075 begin
|
|
|
1076 Push_Scope_Stack;
|
|
145
|
1077 Scopes (Scope.Last).Sloc := Token_Ptr;
|
|
|
1078 Scopes (Scope.Last).Ecol := Start_Column;
|
|
111
|
1079
|
|
|
1080 Accept_Node := New_Node (N_Accept_Statement, Token_Ptr);
|
|
|
1081 Scan; -- past ACCEPT
|
|
145
|
1082 Scopes (Scope.Last).Labl := Token_Node;
|
|
131
|
1083 Current_Node := Token_Node;
|
|
111
|
1084
|
|
|
1085 Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do));
|
|
|
1086
|
|
|
1087 -- Left paren could be (Entry_Index) or Formal_Part, determine which
|
|
|
1088
|
|
|
1089 if Token = Tok_Left_Paren then
|
|
|
1090 Save_Scan_State (Scan_State); -- at left paren
|
|
|
1091 Scan; -- past left paren
|
|
|
1092
|
|
|
1093 -- If first token after left paren not identifier, then Entry_Index
|
|
|
1094
|
|
|
1095 if Token /= Tok_Identifier then
|
|
|
1096 Set_Entry_Index (Accept_Node, P_Expression);
|
|
|
1097 T_Right_Paren;
|
|
|
1098 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
|
|
|
1099
|
|
|
1100 -- First token after left paren is identifier, could be either case
|
|
|
1101
|
|
|
1102 else -- Token = Tok_Identifier
|
|
|
1103 Scan; -- past identifier
|
|
|
1104
|
|
|
1105 -- If identifier followed by comma or colon, must be Formal_Part
|
|
|
1106
|
|
|
1107 if Token = Tok_Comma or else Token = Tok_Colon then
|
|
|
1108 Restore_Scan_State (Scan_State); -- to left paren
|
|
|
1109 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
|
|
|
1110
|
|
|
1111 -- If identifier not followed by comma/colon, must be entry index
|
|
|
1112
|
|
|
1113 else
|
|
|
1114 Restore_Scan_State (Scan_State); -- to left paren
|
|
|
1115 Scan; -- past left paren (again)
|
|
|
1116 Set_Entry_Index (Accept_Node, P_Expression);
|
|
|
1117 T_Right_Paren;
|
|
|
1118 Set_Parameter_Specifications (Accept_Node, P_Parameter_Profile);
|
|
|
1119 end if;
|
|
|
1120 end if;
|
|
|
1121 end if;
|
|
|
1122
|
|
|
1123 -- Scan out DO if present
|
|
|
1124
|
|
|
1125 if Token = Tok_Do then
|
|
145
|
1126 Scopes (Scope.Last).Etyp := E_Name;
|
|
|
1127 Scopes (Scope.Last).Lreq := False;
|
|
111
|
1128 Scan; -- past DO
|
|
|
1129 Hand_Seq := P_Handled_Sequence_Of_Statements;
|
|
|
1130 Set_Handled_Statement_Sequence (Accept_Node, Hand_Seq);
|
|
|
1131 End_Statements (Handled_Statement_Sequence (Accept_Node));
|
|
|
1132
|
|
|
1133 -- Exception handlers not allowed in Ada 95 node
|
|
|
1134
|
|
|
1135 if Present (Exception_Handlers (Hand_Seq)) then
|
|
|
1136 if Ada_Version = Ada_83 then
|
|
|
1137 Error_Msg_N
|
|
|
1138 ("(Ada 83) exception handlers in accept not allowed",
|
|
|
1139 First_Non_Pragma (Exception_Handlers (Hand_Seq)));
|
|
|
1140 end if;
|
|
|
1141 end if;
|
|
|
1142
|
|
|
1143 else
|
|
|
1144 Pop_Scope_Stack; -- discard unused entry
|
|
|
1145 TF_Semicolon;
|
|
|
1146 end if;
|
|
|
1147
|
|
|
1148 return Accept_Node;
|
|
|
1149
|
|
|
1150 -- If error, resynchronize past semicolon
|
|
|
1151
|
|
|
1152 exception
|
|
|
1153 when Error_Resync =>
|
|
|
1154 Resync_Past_Semicolon;
|
|
|
1155 Pop_Scope_Stack; -- discard unused entry
|
|
|
1156 return Error;
|
|
|
1157 end P_Accept_Statement;
|
|
|
1158
|
|
|
1159 ------------------------
|
|
|
1160 -- 9.5.2 Entry Index --
|
|
|
1161 ------------------------
|
|
|
1162
|
|
|
1163 -- Parsed by P_Expression (4.4)
|
|
|
1164
|
|
|
1165 --------------------------
|
|
|
1166 -- 9.5.2 Entry Barrier --
|
|
|
1167 --------------------------
|
|
|
1168
|
|
|
1169 -- ENTRY_BARRIER ::= when CONDITION
|
|
|
1170
|
|
|
1171 -- Error_Recovery: cannot raise Error_Resync
|
|
|
1172
|
|
|
1173 function P_Entry_Barrier return Node_Id is
|
|
|
1174 Bnode : Node_Id;
|
|
|
1175
|
|
|
1176 begin
|
|
|
1177 if Token = Tok_When then
|
|
|
1178 Scan; -- past WHEN;
|
|
|
1179 Bnode := P_Expression_No_Right_Paren;
|
|
|
1180
|
|
|
1181 if Token = Tok_Colon_Equal then
|
|
|
1182 Error_Msg_SC -- CODEFIX
|
|
|
1183 ("|"":="" should be ""=""");
|
|
|
1184 Scan;
|
|
|
1185 Bnode := P_Expression_No_Right_Paren;
|
|
|
1186 end if;
|
|
|
1187
|
|
|
1188 else
|
|
|
1189 T_When; -- to give error message
|
|
|
1190 Bnode := Error;
|
|
|
1191 end if;
|
|
|
1192
|
|
|
1193 return Bnode;
|
|
|
1194 end P_Entry_Barrier;
|
|
|
1195
|
|
|
1196 -----------------------
|
|
|
1197 -- 9.5.2 Entry Body --
|
|
|
1198 -----------------------
|
|
|
1199
|
|
|
1200 -- ENTRY_BODY ::=
|
|
|
1201 -- entry DEFINING_IDENTIFIER ENTRY_BODY_FORMAL_PART
|
|
|
1202 -- [ASPECT_SPECIFICATIONS] ENTRY_BARRIER
|
|
|
1203 -- is
|
|
|
1204 -- DECLARATIVE_PART
|
|
|
1205 -- begin
|
|
|
1206 -- HANDLED_SEQUENCE_OF_STATEMENTS
|
|
|
1207 -- end [entry_IDENTIFIER];
|
|
|
1208
|
|
|
1209 -- The caller has checked that the initial token is ENTRY
|
|
|
1210
|
|
|
1211 -- Error_Recovery: cannot raise Error_Resync
|
|
|
1212
|
|
|
1213 function P_Entry_Body return Node_Id is
|
|
|
1214 Dummy_Node : Node_Id;
|
|
|
1215 Entry_Node : Node_Id;
|
|
|
1216 Formal_Part_Node : Node_Id;
|
|
|
1217 Name_Node : Node_Id;
|
|
|
1218
|
|
|
1219 begin
|
|
|
1220 Push_Scope_Stack;
|
|
|
1221 Entry_Node := New_Node (N_Entry_Body, Token_Ptr);
|
|
|
1222 Scan; -- past ENTRY
|
|
|
1223
|
|
145
|
1224 Scopes (Scope.Last).Ecol := Start_Column;
|
|
|
1225 Scopes (Scope.Last).Lreq := False;
|
|
|
1226 Scopes (Scope.Last).Etyp := E_Name;
|
|
|
1227 Scopes (Scope.Last).Sloc := Token_Ptr;
|
|
111
|
1228
|
|
|
1229 Name_Node := P_Defining_Identifier;
|
|
|
1230 Set_Defining_Identifier (Entry_Node, Name_Node);
|
|
145
|
1231 Scopes (Scope.Last).Labl := Name_Node;
|
|
131
|
1232 Current_Node := Name_Node;
|
|
111
|
1233
|
|
|
1234 Formal_Part_Node := P_Entry_Body_Formal_Part;
|
|
|
1235 Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node);
|
|
|
1236
|
|
|
1237 -- Ada 2012 (AI12-0169): Aspect specifications may appear on an entry
|
|
|
1238 -- body immediately after the formal part. Do not parse the aspect
|
|
|
1239 -- specifications directly because the "when" of the entry barrier may
|
|
|
1240 -- be interpreted as a misused "with".
|
|
|
1241
|
|
|
1242 if Token = Tok_With then
|
|
|
1243 P_Aspect_Specifications (Entry_Node, Semicolon => False);
|
|
|
1244 end if;
|
|
|
1245
|
|
|
1246 Set_Condition (Formal_Part_Node, P_Entry_Barrier);
|
|
|
1247
|
|
|
1248 -- Detect an illegal placement of aspect specifications following the
|
|
|
1249 -- entry barrier.
|
|
|
1250
|
|
|
1251 -- entry E ... when Barrier with Aspect is
|
|
|
1252
|
|
|
1253 if Token = Tok_With then
|
|
|
1254 Error_Msg_SC ("aspect specifications must come before entry barrier");
|
|
|
1255
|
|
|
1256 -- Consume the illegal aspects to allow for parsing to continue
|
|
|
1257
|
|
|
1258 Dummy_Node := New_Node (N_Entry_Body, Sloc (Entry_Node));
|
|
|
1259 P_Aspect_Specifications (Dummy_Node, Semicolon => False);
|
|
|
1260 end if;
|
|
|
1261
|
|
|
1262 TF_Is;
|
|
|
1263 Parse_Decls_Begin_End (Entry_Node);
|
|
|
1264
|
|
|
1265 return Entry_Node;
|
|
|
1266 end P_Entry_Body;
|
|
|
1267
|
|
|
1268 -----------------------------------
|
|
|
1269 -- 9.5.2 Entry Body Formal Part --
|
|
|
1270 -----------------------------------
|
|
|
1271
|
|
|
1272 -- ENTRY_BODY_FORMAL_PART ::=
|
|
|
1273 -- [(ENTRY_INDEX_SPECIFICATION)] [PARAMETER_PART]
|
|
|
1274
|
|
|
1275 -- Error_Recovery: cannot raise Error_Resync
|
|
|
1276
|
|
|
1277 function P_Entry_Body_Formal_Part return Node_Id is
|
|
|
1278 Fpart_Node : Node_Id;
|
|
|
1279 Scan_State : Saved_Scan_State;
|
|
|
1280
|
|
|
1281 begin
|
|
|
1282 Fpart_Node := New_Node (N_Entry_Body_Formal_Part, Token_Ptr);
|
|
|
1283
|
|
|
1284 -- See if entry index specification present, and if so parse it
|
|
|
1285
|
|
|
1286 if Token = Tok_Left_Paren then
|
|
|
1287 Save_Scan_State (Scan_State); -- at left paren
|
|
|
1288 Scan; -- past left paren
|
|
|
1289
|
|
|
1290 if Token = Tok_For then
|
|
|
1291 Set_Entry_Index_Specification
|
|
|
1292 (Fpart_Node, P_Entry_Index_Specification);
|
|
|
1293 T_Right_Paren;
|
|
|
1294 else
|
|
|
1295 Restore_Scan_State (Scan_State); -- to left paren
|
|
|
1296 end if;
|
|
|
1297
|
|
|
1298 -- Check for (common?) case of left paren omitted before FOR. This
|
|
|
1299 -- is a tricky case, because the corresponding missing left paren
|
|
|
1300 -- can cause real havoc if a formal part is present which gets
|
|
|
1301 -- treated as part of the discrete subtype definition of the
|
|
|
1302 -- entry index specification, so just give error and resynchronize
|
|
|
1303
|
|
|
1304 elsif Token = Tok_For then
|
|
|
1305 T_Left_Paren; -- to give error message
|
|
|
1306 Resync_To_When;
|
|
|
1307 end if;
|
|
|
1308
|
|
|
1309 Set_Parameter_Specifications (Fpart_Node, P_Parameter_Profile);
|
|
|
1310 return Fpart_Node;
|
|
|
1311 end P_Entry_Body_Formal_Part;
|
|
|
1312
|
|
|
1313 --------------------------------------
|
|
|
1314 -- 9.5.2 Entry Index Specification --
|
|
|
1315 --------------------------------------
|
|
|
1316
|
|
|
1317 -- ENTRY_INDEX_SPECIFICATION ::=
|
|
|
1318 -- for DEFINING_IDENTIFIER in DISCRETE_SUBTYPE_DEFINITION
|
|
|
1319
|
|
|
1320 -- Error recovery: can raise Error_Resync
|
|
|
1321
|
|
|
1322 function P_Entry_Index_Specification return Node_Id is
|
|
|
1323 Iterator_Node : Node_Id;
|
|
|
1324
|
|
|
1325 begin
|
|
|
1326 Iterator_Node := New_Node (N_Entry_Index_Specification, Token_Ptr);
|
|
|
1327 T_For; -- past FOR
|
|
|
1328 Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier (C_In));
|
|
|
1329 T_In;
|
|
|
1330 Set_Discrete_Subtype_Definition
|
|
|
1331 (Iterator_Node, P_Discrete_Subtype_Definition);
|
|
|
1332 return Iterator_Node;
|
|
|
1333 end P_Entry_Index_Specification;
|
|
|
1334
|
|
|
1335 ---------------------------------
|
|
|
1336 -- 9.5.3 Entry Call Statement --
|
|
|
1337 ---------------------------------
|
|
|
1338
|
|
|
1339 -- Parsed by P_Name (4.1). Within a select, an entry call is parsed
|
|
|
1340 -- by P_Select_Statement (9.7)
|
|
|
1341
|
|
|
1342 ------------------------------
|
|
|
1343 -- 9.5.4 Requeue Statement --
|
|
|
1344 ------------------------------
|
|
|
1345
|
|
|
1346 -- REQUEUE_STATEMENT ::= requeue entry_NAME [with abort];
|
|
|
1347
|
|
|
1348 -- The caller has checked that the initial token is requeue
|
|
|
1349
|
|
|
1350 -- Error recovery: can raise Error_Resync
|
|
|
1351
|
|
|
1352 function P_Requeue_Statement return Node_Id is
|
|
|
1353 Requeue_Node : Node_Id;
|
|
|
1354
|
|
|
1355 begin
|
|
|
1356 Requeue_Node := New_Node (N_Requeue_Statement, Token_Ptr);
|
|
|
1357 Scan; -- past REQUEUE
|
|
|
1358 Set_Name (Requeue_Node, P_Name);
|
|
|
1359
|
|
|
1360 if Token = Tok_With then
|
|
|
1361 Scan; -- past WITH
|
|
|
1362 T_Abort;
|
|
|
1363 Set_Abort_Present (Requeue_Node, True);
|
|
|
1364 end if;
|
|
|
1365
|
|
|
1366 TF_Semicolon;
|
|
|
1367 return Requeue_Node;
|
|
|
1368 end P_Requeue_Statement;
|
|
|
1369
|
|
|
1370 --------------------------
|
|
|
1371 -- 9.6 Delay Statement --
|
|
|
1372 --------------------------
|
|
|
1373
|
|
|
1374 -- DELAY_STATEMENT ::=
|
|
|
1375 -- DELAY_UNTIL_STATEMENT
|
|
|
1376 -- | DELAY_RELATIVE_STATEMENT
|
|
|
1377
|
|
|
1378 -- The caller has checked that the initial token is DELAY
|
|
|
1379
|
|
|
1380 -- Error recovery: cannot raise Error_Resync
|
|
|
1381
|
|
|
1382 function P_Delay_Statement return Node_Id is
|
|
|
1383 begin
|
|
|
1384 Scan; -- past DELAY
|
|
|
1385
|
|
|
1386 -- The following check for delay until misused in Ada 83 doesn't catch
|
|
|
1387 -- all cases, but it's good enough to catch most of them.
|
|
|
1388
|
|
|
1389 if Token_Name = Name_Until then
|
|
|
1390 Check_95_Keyword (Tok_Until, Tok_Left_Paren);
|
|
|
1391 Check_95_Keyword (Tok_Until, Tok_Identifier);
|
|
|
1392 end if;
|
|
|
1393
|
|
|
1394 if Token = Tok_Until then
|
|
|
1395 return P_Delay_Until_Statement;
|
|
|
1396 else
|
|
|
1397 return P_Delay_Relative_Statement;
|
|
|
1398 end if;
|
|
|
1399 end P_Delay_Statement;
|
|
|
1400
|
|
|
1401 --------------------------------
|
|
|
1402 -- 9.6 Delay Until Statement --
|
|
|
1403 --------------------------------
|
|
|
1404
|
|
|
1405 -- DELAY_UNTIL_STATEMENT ::= delay until delay_EXPRESSION;
|
|
|
1406
|
|
|
1407 -- The caller has checked that the initial token is DELAY, scanned it
|
|
|
1408 -- out and checked that the current token is UNTIL
|
|
|
1409
|
|
|
1410 -- Error recovery: cannot raise Error_Resync
|
|
|
1411
|
|
|
1412 function P_Delay_Until_Statement return Node_Id is
|
|
|
1413 Delay_Node : Node_Id;
|
|
|
1414
|
|
|
1415 begin
|
|
|
1416 Delay_Node := New_Node (N_Delay_Until_Statement, Prev_Token_Ptr);
|
|
|
1417 Scan; -- past UNTIL
|
|
|
1418 Set_Expression (Delay_Node, P_Expression_No_Right_Paren);
|
|
|
1419 TF_Semicolon;
|
|
|
1420 return Delay_Node;
|
|
|
1421 end P_Delay_Until_Statement;
|
|
|
1422
|
|
|
1423 -----------------------------------
|
|
|
1424 -- 9.6 Delay Relative Statement --
|
|
|
1425 -----------------------------------
|
|
|
1426
|
|
|
1427 -- DELAY_RELATIVE_STATEMENT ::= delay delay_EXPRESSION;
|
|
|
1428
|
|
|
1429 -- The caller has checked that the initial token is DELAY, scanned it
|
|
|
1430 -- out and determined that the current token is not UNTIL
|
|
|
1431
|
|
|
1432 -- Error recovery: cannot raise Error_Resync
|
|
|
1433
|
|
|
1434 function P_Delay_Relative_Statement return Node_Id is
|
|
|
1435 Delay_Node : Node_Id;
|
|
|
1436
|
|
|
1437 begin
|
|
|
1438 Delay_Node := New_Node (N_Delay_Relative_Statement, Prev_Token_Ptr);
|
|
|
1439 Set_Expression (Delay_Node, P_Expression_No_Right_Paren);
|
|
|
1440 Check_Simple_Expression_In_Ada_83 (Expression (Delay_Node));
|
|
|
1441 TF_Semicolon;
|
|
|
1442 return Delay_Node;
|
|
|
1443 end P_Delay_Relative_Statement;
|
|
|
1444
|
|
|
1445 ---------------------------
|
|
|
1446 -- 9.7 Select Statement --
|
|
|
1447 ---------------------------
|
|
|
1448
|
|
|
1449 -- SELECT_STATEMENT ::=
|
|
|
1450 -- SELECTIVE_ACCEPT
|
|
|
1451 -- | TIMED_ENTRY_CALL
|
|
|
1452 -- | CONDITIONAL_ENTRY_CALL
|
|
|
1453 -- | ASYNCHRONOUS_SELECT
|
|
|
1454
|
|
|
1455 -- SELECTIVE_ACCEPT ::=
|
|
|
1456 -- select
|
|
|
1457 -- [GUARD]
|
|
|
1458 -- SELECT_ALTERNATIVE
|
|
|
1459 -- {or
|
|
|
1460 -- [GUARD]
|
|
|
1461 -- SELECT_ALTERNATIVE
|
|
|
1462 -- [else
|
|
|
1463 -- SEQUENCE_OF_STATEMENTS]
|
|
|
1464 -- end select;
|
|
|
1465
|
|
|
1466 -- GUARD ::= when CONDITION =>
|
|
|
1467
|
|
|
1468 -- Note: the guard preceding a select alternative is included as part
|
|
|
1469 -- of the node generated for a selective accept alternative.
|
|
|
1470
|
|
|
1471 -- SELECT_ALTERNATIVE ::=
|
|
|
1472 -- ACCEPT_ALTERNATIVE
|
|
|
1473 -- | DELAY_ALTERNATIVE
|
|
|
1474 -- | TERMINATE_ALTERNATIVE
|
|
|
1475
|
|
|
1476 -- TIMED_ENTRY_CALL ::=
|
|
|
1477 -- select
|
|
|
1478 -- ENTRY_CALL_ALTERNATIVE
|
|
|
1479 -- or
|
|
|
1480 -- DELAY_ALTERNATIVE
|
|
|
1481 -- end select;
|
|
|
1482
|
|
|
1483 -- CONDITIONAL_ENTRY_CALL ::=
|
|
|
1484 -- select
|
|
|
1485 -- ENTRY_CALL_ALTERNATIVE
|
|
|
1486 -- else
|
|
|
1487 -- SEQUENCE_OF_STATEMENTS
|
|
|
1488 -- end select;
|
|
|
1489
|
|
|
1490 -- ENTRY_CALL_ALTERNATIVE ::=
|
|
|
1491 -- ENTRY_CALL_STATEMENT [SEQUENCE_OF_STATEMENTS]
|
|
|
1492
|
|
|
1493 -- ASYNCHRONOUS_SELECT ::=
|
|
|
1494 -- select
|
|
|
1495 -- TRIGGERING_ALTERNATIVE
|
|
|
1496 -- then abort
|
|
|
1497 -- ABORTABLE_PART
|
|
|
1498 -- end select;
|
|
|
1499
|
|
|
1500 -- TRIGGERING_ALTERNATIVE ::=
|
|
|
1501 -- TRIGGERING_STATEMENT [SEQUENCE_OF_STATEMENTS]
|
|
|
1502
|
|
|
1503 -- TRIGGERING_STATEMENT ::= ENTRY_CALL_STATEMENT | DELAY_STATEMENT
|
|
|
1504
|
|
|
1505 -- The caller has checked that the initial token is SELECT
|
|
|
1506
|
|
|
1507 -- Error recovery: can raise Error_Resync
|
|
|
1508
|
|
|
1509 function P_Select_Statement return Node_Id is
|
|
|
1510 Select_Node : Node_Id;
|
|
|
1511 Select_Sloc : Source_Ptr;
|
|
|
1512 Stmnt_Sloc : Source_Ptr;
|
|
|
1513 Ecall_Node : Node_Id;
|
|
|
1514 Alternative : Node_Id;
|
|
|
1515 Select_Pragmas : List_Id;
|
|
|
1516 Alt_Pragmas : List_Id;
|
|
|
1517 Statement_List : List_Id;
|
|
|
1518 Alt_List : List_Id;
|
|
|
1519 Cond_Expr : Node_Id;
|
|
|
1520 Delay_Stmnt : Node_Id;
|
|
|
1521
|
|
|
1522 begin
|
|
|
1523 Push_Scope_Stack;
|
|
145
|
1524 Scopes (Scope.Last).Etyp := E_Select;
|
|
|
1525 Scopes (Scope.Last).Ecol := Start_Column;
|
|
|
1526 Scopes (Scope.Last).Sloc := Token_Ptr;
|
|
|
1527 Scopes (Scope.Last).Labl := Error;
|
|
111
|
1528
|
|
|
1529 Select_Sloc := Token_Ptr;
|
|
|
1530 Scan; -- past SELECT
|
|
|
1531 Stmnt_Sloc := Token_Ptr;
|
|
|
1532 Select_Pragmas := P_Pragmas_Opt;
|
|
|
1533
|
|
|
1534 -- If first token after select is designator, then we have an entry
|
|
|
1535 -- call, which must be the start of a conditional entry call, timed
|
|
|
1536 -- entry call or asynchronous select
|
|
|
1537
|
|
|
1538 if Token in Token_Class_Desig then
|
|
|
1539
|
|
|
1540 -- Scan entry call statement
|
|
|
1541
|
|
|
1542 begin
|
|
|
1543 Ecall_Node := P_Name;
|
|
|
1544
|
|
|
1545 -- ?? The following two clauses exactly parallel code in ch5
|
|
|
1546 -- and should be combined sometime
|
|
|
1547
|
|
|
1548 if Nkind (Ecall_Node) = N_Indexed_Component then
|
|
|
1549 declare
|
|
|
1550 Prefix_Node : constant Node_Id := Prefix (Ecall_Node);
|
|
|
1551 Exprs_Node : constant List_Id := Expressions (Ecall_Node);
|
|
|
1552
|
|
|
1553 begin
|
|
|
1554 Change_Node (Ecall_Node, N_Procedure_Call_Statement);
|
|
|
1555 Set_Name (Ecall_Node, Prefix_Node);
|
|
|
1556 Set_Parameter_Associations (Ecall_Node, Exprs_Node);
|
|
|
1557 end;
|
|
|
1558
|
|
|
1559 elsif Nkind (Ecall_Node) = N_Function_Call then
|
|
|
1560 declare
|
|
|
1561 Fname_Node : constant Node_Id := Name (Ecall_Node);
|
|
|
1562 Params_List : constant List_Id :=
|
|
|
1563 Parameter_Associations (Ecall_Node);
|
|
|
1564
|
|
|
1565 begin
|
|
|
1566 Change_Node (Ecall_Node, N_Procedure_Call_Statement);
|
|
|
1567 Set_Name (Ecall_Node, Fname_Node);
|
|
|
1568 Set_Parameter_Associations (Ecall_Node, Params_List);
|
|
|
1569 end;
|
|
|
1570
|
|
|
1571 elsif Nkind (Ecall_Node) = N_Identifier
|
|
|
1572 or else Nkind (Ecall_Node) = N_Selected_Component
|
|
|
1573 then
|
|
|
1574 -- Case of a call to a parameterless entry
|
|
|
1575
|
|
|
1576 declare
|
|
|
1577 C_Node : constant Node_Id :=
|
|
|
1578 New_Node (N_Procedure_Call_Statement, Stmnt_Sloc);
|
|
|
1579 begin
|
|
|
1580 Set_Name (C_Node, Ecall_Node);
|
|
|
1581 Set_Parameter_Associations (C_Node, No_List);
|
|
|
1582 Ecall_Node := C_Node;
|
|
|
1583 end;
|
|
|
1584 end if;
|
|
|
1585
|
|
|
1586 TF_Semicolon;
|
|
|
1587
|
|
|
1588 exception
|
|
|
1589 when Error_Resync =>
|
|
|
1590 Resync_Past_Semicolon;
|
|
|
1591 return Error;
|
|
|
1592 end;
|
|
|
1593
|
|
|
1594 Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm);
|
|
|
1595
|
|
|
1596 -- OR follows, we have a timed entry call
|
|
|
1597
|
|
|
1598 if Token = Tok_Or then
|
|
|
1599 Scan; -- past OR
|
|
|
1600 Alt_Pragmas := P_Pragmas_Opt;
|
|
|
1601
|
|
|
1602 Select_Node := New_Node (N_Timed_Entry_Call, Select_Sloc);
|
|
|
1603 Set_Entry_Call_Alternative (Select_Node,
|
|
|
1604 Make_Entry_Call_Alternative (Stmnt_Sloc,
|
|
|
1605 Entry_Call_Statement => Ecall_Node,
|
|
|
1606 Pragmas_Before => Select_Pragmas,
|
|
|
1607 Statements => Statement_List));
|
|
|
1608
|
|
|
1609 -- Only possibility is delay alternative. If we have anything
|
|
|
1610 -- else, give message, and treat as conditional entry call.
|
|
|
1611
|
|
|
1612 if Token /= Tok_Delay then
|
|
|
1613 Error_Msg_SC
|
|
|
1614 ("only allowed alternative in timed entry call is delay!");
|
|
|
1615 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
|
|
|
1616 Set_Delay_Alternative (Select_Node, Error);
|
|
|
1617
|
|
|
1618 else
|
|
|
1619 Set_Delay_Alternative (Select_Node, P_Delay_Alternative);
|
|
|
1620 Set_Pragmas_Before
|
|
|
1621 (Delay_Alternative (Select_Node), Alt_Pragmas);
|
|
|
1622 end if;
|
|
|
1623
|
|
|
1624 -- ELSE follows, we have a conditional entry call
|
|
|
1625
|
|
|
1626 elsif Token = Tok_Else then
|
|
|
1627 Scan; -- past ELSE
|
|
|
1628 Select_Node := New_Node (N_Conditional_Entry_Call, Select_Sloc);
|
|
|
1629
|
|
|
1630 Set_Entry_Call_Alternative (Select_Node,
|
|
|
1631 Make_Entry_Call_Alternative (Stmnt_Sloc,
|
|
|
1632 Entry_Call_Statement => Ecall_Node,
|
|
|
1633 Pragmas_Before => Select_Pragmas,
|
|
|
1634 Statements => Statement_List));
|
|
|
1635
|
|
|
1636 Set_Else_Statements
|
|
|
1637 (Select_Node, P_Sequence_Of_Statements (SS_Sreq));
|
|
|
1638
|
|
|
1639 -- Only remaining case is THEN ABORT (asynchronous select)
|
|
|
1640
|
|
|
1641 elsif Token = Tok_Abort then
|
|
|
1642 Select_Node :=
|
|
|
1643 Make_Asynchronous_Select (Select_Sloc,
|
|
|
1644 Triggering_Alternative =>
|
|
|
1645 Make_Triggering_Alternative (Stmnt_Sloc,
|
|
|
1646 Triggering_Statement => Ecall_Node,
|
|
|
1647 Pragmas_Before => Select_Pragmas,
|
|
|
1648 Statements => Statement_List),
|
|
|
1649 Abortable_Part => P_Abortable_Part);
|
|
|
1650
|
|
|
1651 -- Else error
|
|
|
1652
|
|
|
1653 else
|
|
|
1654 if Ada_Version = Ada_83 then
|
|
|
1655 Error_Msg_BC ("OR or ELSE expected");
|
|
|
1656 else
|
|
|
1657 Error_Msg_BC ("OR or ELSE or THEN ABORT expected");
|
|
|
1658 end if;
|
|
|
1659
|
|
|
1660 Select_Node := Error;
|
|
|
1661 end if;
|
|
|
1662
|
|
|
1663 End_Statements;
|
|
|
1664
|
|
|
1665 -- Here we have a selective accept or an asynchronous select (first
|
|
|
1666 -- token after SELECT is other than a designator token).
|
|
|
1667
|
|
|
1668 else
|
|
|
1669 -- If we have delay with no guard, could be asynchronous select
|
|
|
1670
|
|
|
1671 if Token = Tok_Delay then
|
|
|
1672 Delay_Stmnt := P_Delay_Statement;
|
|
|
1673 Statement_List := P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm);
|
|
|
1674
|
|
|
1675 -- Asynchronous select
|
|
|
1676
|
|
|
1677 if Token = Tok_Abort then
|
|
|
1678 Select_Node :=
|
|
|
1679 Make_Asynchronous_Select (Select_Sloc,
|
|
|
1680 Triggering_Alternative =>
|
|
|
1681 Make_Triggering_Alternative (Stmnt_Sloc,
|
|
|
1682 Triggering_Statement => Delay_Stmnt,
|
|
|
1683 Pragmas_Before => Select_Pragmas,
|
|
|
1684 Statements => Statement_List),
|
|
|
1685 Abortable_Part => P_Abortable_Part);
|
|
|
1686
|
|
|
1687 End_Statements;
|
|
|
1688 return Select_Node;
|
|
|
1689
|
|
|
1690 -- Delay which was not an asynchronous select. Must be a selective
|
|
|
1691 -- accept, and since at least one accept statement is required,
|
|
|
1692 -- we must have at least one OR phrase present.
|
|
|
1693
|
|
|
1694 else
|
|
|
1695 Alt_List := New_List (
|
|
|
1696 Make_Delay_Alternative (Stmnt_Sloc,
|
|
|
1697 Delay_Statement => Delay_Stmnt,
|
|
|
1698 Pragmas_Before => Select_Pragmas,
|
|
|
1699 Statements => Statement_List));
|
|
|
1700 T_Or;
|
|
|
1701 Alt_Pragmas := P_Pragmas_Opt;
|
|
|
1702 end if;
|
|
|
1703
|
|
|
1704 -- If not a delay statement, then must be another possibility for
|
|
|
1705 -- a selective accept alternative, or perhaps a guard is present
|
|
|
1706
|
|
|
1707 else
|
|
|
1708 Alt_List := New_List;
|
|
|
1709 Alt_Pragmas := Select_Pragmas;
|
|
|
1710 end if;
|
|
|
1711
|
|
|
1712 Select_Node := New_Node (N_Selective_Accept, Select_Sloc);
|
|
|
1713 Set_Select_Alternatives (Select_Node, Alt_List);
|
|
|
1714
|
|
|
1715 -- Scan out selective accept alternatives. On entry to this loop,
|
|
|
1716 -- we are just past a SELECT or OR token, and any pragmas that
|
|
|
1717 -- immediately follow the SELECT or OR are in Alt_Pragmas.
|
|
|
1718
|
|
|
1719 loop
|
|
|
1720 if Token = Tok_When then
|
|
|
1721
|
|
|
1722 if Present (Alt_Pragmas) then
|
|
|
1723 Error_Msg_SC ("pragmas may not precede guard");
|
|
|
1724 end if;
|
|
|
1725
|
|
|
1726 Scan; -- past WHEN
|
|
|
1727 Cond_Expr := P_Expression_No_Right_Paren;
|
|
|
1728 T_Arrow;
|
|
|
1729 Alt_Pragmas := P_Pragmas_Opt;
|
|
|
1730
|
|
|
1731 else
|
|
|
1732 Cond_Expr := Empty;
|
|
|
1733 end if;
|
|
|
1734
|
|
|
1735 if Token = Tok_Accept then
|
|
|
1736 Alternative := P_Accept_Alternative;
|
|
|
1737
|
|
|
1738 -- Check for junk attempt at asynchronous select using
|
|
|
1739 -- an Accept alternative as the triggering statement
|
|
|
1740
|
|
|
1741 if Token = Tok_Abort
|
|
|
1742 and then Is_Empty_List (Alt_List)
|
|
|
1743 and then No (Cond_Expr)
|
|
|
1744 then
|
|
|
1745 Error_Msg
|
|
|
1746 ("triggering statement must be entry call or delay",
|
|
|
1747 Sloc (Alternative));
|
|
|
1748 Scan; -- past junk ABORT
|
|
|
1749 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
|
|
|
1750 End_Statements;
|
|
|
1751 return Error;
|
|
|
1752 end if;
|
|
|
1753
|
|
|
1754 elsif Token = Tok_Delay then
|
|
|
1755 Alternative := P_Delay_Alternative;
|
|
|
1756
|
|
|
1757 elsif Token = Tok_Terminate then
|
|
|
1758 Alternative := P_Terminate_Alternative;
|
|
|
1759
|
|
|
1760 else
|
|
|
1761 Error_Msg_SC
|
|
|
1762 ("select alternative (ACCEPT, ABORT, DELAY) expected");
|
|
|
1763 Alternative := Error;
|
|
|
1764
|
|
|
1765 if Token = Tok_Semicolon then
|
|
|
1766 Scan; -- past junk semicolon
|
|
|
1767 end if;
|
|
|
1768 end if;
|
|
|
1769
|
|
|
1770 -- THEN ABORT at this stage is just junk
|
|
|
1771
|
|
|
1772 if Token = Tok_Abort then
|
|
|
1773 Error_Msg_SP ("misplaced `THEN ABORT`");
|
|
|
1774 Scan; -- past junk ABORT
|
|
|
1775 Discard_Junk_List (P_Sequence_Of_Statements (SS_Sreq));
|
|
|
1776 End_Statements;
|
|
|
1777 return Error;
|
|
|
1778
|
|
|
1779 else
|
|
|
1780 if Alternative /= Error then
|
|
|
1781 Set_Condition (Alternative, Cond_Expr);
|
|
|
1782 Set_Pragmas_Before (Alternative, Alt_Pragmas);
|
|
|
1783 Append (Alternative, Alt_List);
|
|
|
1784 end if;
|
|
|
1785
|
|
|
1786 exit when Token /= Tok_Or;
|
|
|
1787 end if;
|
|
|
1788
|
|
|
1789 T_Or;
|
|
|
1790 Alt_Pragmas := P_Pragmas_Opt;
|
|
|
1791 end loop;
|
|
|
1792
|
|
|
1793 if Token = Tok_Else then
|
|
|
1794 Scan; -- past ELSE
|
|
|
1795 Set_Else_Statements
|
|
|
1796 (Select_Node, P_Sequence_Of_Statements (SS_Ortm_Sreq));
|
|
|
1797
|
|
|
1798 if Token = Tok_Or then
|
|
|
1799 Error_Msg_SC ("select alternative cannot follow else part!");
|
|
|
1800 end if;
|
|
|
1801 end if;
|
|
|
1802
|
|
|
1803 End_Statements;
|
|
|
1804 end if;
|
|
|
1805
|
|
|
1806 return Select_Node;
|
|
|
1807 end P_Select_Statement;
|
|
|
1808
|
|
|
1809 -----------------------------
|
|
|
1810 -- 9.7.1 Selective Accept --
|
|
|
1811 -----------------------------
|
|
|
1812
|
|
|
1813 -- Parsed by P_Select_Statement (9.7)
|
|
|
1814
|
|
|
1815 ------------------
|
|
|
1816 -- 9.7.1 Guard --
|
|
|
1817 ------------------
|
|
|
1818
|
|
|
1819 -- Parsed by P_Select_Statement (9.7)
|
|
|
1820
|
|
|
1821 -------------------------------
|
|
|
1822 -- 9.7.1 Select Alternative --
|
|
|
1823 -------------------------------
|
|
|
1824
|
|
|
1825 -- SELECT_ALTERNATIVE ::=
|
|
|
1826 -- ACCEPT_ALTERNATIVE
|
|
|
1827 -- | DELAY_ALTERNATIVE
|
|
|
1828 -- | TERMINATE_ALTERNATIVE
|
|
|
1829
|
|
|
1830 -- Note: the guard preceding a select alternative is included as part
|
|
|
1831 -- of the node generated for a selective accept alternative.
|
|
|
1832
|
|
|
1833 -- Error recovery: cannot raise Error_Resync
|
|
|
1834
|
|
|
1835 -------------------------------
|
|
|
1836 -- 9.7.1 Accept Alternative --
|
|
|
1837 -------------------------------
|
|
|
1838
|
|
|
1839 -- ACCEPT_ALTERNATIVE ::=
|
|
|
1840 -- ACCEPT_STATEMENT [SEQUENCE_OF_STATEMENTS]
|
|
|
1841
|
|
|
1842 -- Error_Recovery: Cannot raise Error_Resync
|
|
|
1843
|
|
|
1844 -- Note: the caller is responsible for setting the Pragmas_Before
|
|
|
1845 -- field of the returned N_Terminate_Alternative node.
|
|
|
1846
|
|
|
1847 function P_Accept_Alternative return Node_Id is
|
|
|
1848 Accept_Alt_Node : Node_Id;
|
|
|
1849
|
|
|
1850 begin
|
|
|
1851 Accept_Alt_Node := New_Node (N_Accept_Alternative, Token_Ptr);
|
|
|
1852 Set_Accept_Statement (Accept_Alt_Node, P_Accept_Statement);
|
|
|
1853
|
|
|
1854 -- Note: the reason that we accept THEN ABORT as a terminator for
|
|
|
1855 -- the sequence of statements is for error recovery which allows
|
|
|
1856 -- for misuse of an accept statement as a triggering statement.
|
|
|
1857
|
|
|
1858 Set_Statements
|
|
|
1859 (Accept_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
|
|
|
1860 return Accept_Alt_Node;
|
|
|
1861 end P_Accept_Alternative;
|
|
|
1862
|
|
|
1863 ------------------------------
|
|
|
1864 -- 9.7.1 Delay Alternative --
|
|
|
1865 ------------------------------
|
|
|
1866
|
|
|
1867 -- DELAY_ALTERNATIVE ::=
|
|
|
1868 -- DELAY_STATEMENT [SEQUENCE_OF_STATEMENTS]
|
|
|
1869
|
|
|
1870 -- Error_Recovery: Cannot raise Error_Resync
|
|
|
1871
|
|
|
1872 -- Note: the caller is responsible for setting the Pragmas_Before
|
|
|
1873 -- field of the returned N_Terminate_Alternative node.
|
|
|
1874
|
|
|
1875 function P_Delay_Alternative return Node_Id is
|
|
|
1876 Delay_Alt_Node : Node_Id;
|
|
|
1877
|
|
|
1878 begin
|
|
|
1879 Delay_Alt_Node := New_Node (N_Delay_Alternative, Token_Ptr);
|
|
|
1880 Set_Delay_Statement (Delay_Alt_Node, P_Delay_Statement);
|
|
|
1881
|
|
|
1882 -- Note: the reason that we accept THEN ABORT as a terminator for
|
|
|
1883 -- the sequence of statements is for error recovery which allows
|
|
|
1884 -- for misuse of an accept statement as a triggering statement.
|
|
|
1885
|
|
|
1886 Set_Statements
|
|
|
1887 (Delay_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
|
|
|
1888 return Delay_Alt_Node;
|
|
|
1889 end P_Delay_Alternative;
|
|
|
1890
|
|
|
1891 ----------------------------------
|
|
|
1892 -- 9.7.1 Terminate Alternative --
|
|
|
1893 ----------------------------------
|
|
|
1894
|
|
|
1895 -- TERMINATE_ALTERNATIVE ::= terminate;
|
|
|
1896
|
|
|
1897 -- Error_Recovery: Cannot raise Error_Resync
|
|
|
1898
|
|
|
1899 -- Note: the caller is responsible for setting the Pragmas_Before
|
|
|
1900 -- field of the returned N_Terminate_Alternative node.
|
|
|
1901
|
|
|
1902 function P_Terminate_Alternative return Node_Id is
|
|
|
1903 Terminate_Alt_Node : Node_Id;
|
|
|
1904
|
|
|
1905 begin
|
|
|
1906 Terminate_Alt_Node := New_Node (N_Terminate_Alternative, Token_Ptr);
|
|
|
1907 Scan; -- past TERMINATE
|
|
|
1908 TF_Semicolon;
|
|
|
1909
|
|
|
1910 -- For all other select alternatives, the sequence of statements
|
|
|
1911 -- after the alternative statement will swallow up any pragmas
|
|
|
1912 -- coming in this position. But the terminate alternative has no
|
|
|
1913 -- sequence of statements, so the pragmas here must be treated
|
|
|
1914 -- specially.
|
|
|
1915
|
|
|
1916 Set_Pragmas_After (Terminate_Alt_Node, P_Pragmas_Opt);
|
|
|
1917 return Terminate_Alt_Node;
|
|
|
1918 end P_Terminate_Alternative;
|
|
|
1919
|
|
|
1920 -----------------------------
|
|
|
1921 -- 9.7.2 Timed Entry Call --
|
|
|
1922 -----------------------------
|
|
|
1923
|
|
|
1924 -- Parsed by P_Select_Statement (9.7)
|
|
|
1925
|
|
|
1926 -----------------------------------
|
|
|
1927 -- 9.7.2 Entry Call Alternative --
|
|
|
1928 -----------------------------------
|
|
|
1929
|
|
|
1930 -- Parsed by P_Select_Statement (9.7)
|
|
|
1931
|
|
|
1932 -----------------------------------
|
|
|
1933 -- 9.7.3 Conditional Entry Call --
|
|
|
1934 -----------------------------------
|
|
|
1935
|
|
|
1936 -- Parsed by P_Select_Statement (9.7)
|
|
|
1937
|
|
|
1938 --------------------------------
|
|
|
1939 -- 9.7.4 Asynchronous Select --
|
|
|
1940 --------------------------------
|
|
|
1941
|
|
|
1942 -- Parsed by P_Select_Statement (9.7)
|
|
|
1943
|
|
|
1944 -----------------------------------
|
|
|
1945 -- 9.7.4 Triggering Alternative --
|
|
|
1946 -----------------------------------
|
|
|
1947
|
|
|
1948 -- Parsed by P_Select_Statement (9.7)
|
|
|
1949
|
|
|
1950 ---------------------------------
|
|
|
1951 -- 9.7.4 Triggering Statement --
|
|
|
1952 ---------------------------------
|
|
|
1953
|
|
|
1954 -- Parsed by P_Select_Statement (9.7)
|
|
|
1955
|
|
|
1956 ---------------------------
|
|
|
1957 -- 9.7.4 Abortable Part --
|
|
|
1958 ---------------------------
|
|
|
1959
|
|
|
1960 -- ABORTABLE_PART ::= SEQUENCE_OF_STATEMENTS
|
|
|
1961
|
|
|
1962 -- The caller has verified that THEN ABORT is present, and Token is
|
|
|
1963 -- pointing to the ABORT on entry (or if not, then we have an error)
|
|
|
1964
|
|
|
1965 -- Error recovery: cannot raise Error_Resync
|
|
|
1966
|
|
|
1967 function P_Abortable_Part return Node_Id is
|
|
|
1968 Abortable_Part_Node : Node_Id;
|
|
|
1969
|
|
|
1970 begin
|
|
|
1971 Abortable_Part_Node := New_Node (N_Abortable_Part, Token_Ptr);
|
|
|
1972 T_Abort; -- scan past ABORT
|
|
|
1973
|
|
|
1974 if Ada_Version = Ada_83 then
|
|
|
1975 Error_Msg_SP ("(Ada 83) asynchronous select not allowed!");
|
|
|
1976 end if;
|
|
|
1977
|
|
|
1978 Set_Statements (Abortable_Part_Node, P_Sequence_Of_Statements (SS_Sreq));
|
|
|
1979 return Abortable_Part_Node;
|
|
|
1980 end P_Abortable_Part;
|
|
|
1981
|
|
|
1982 --------------------------
|
|
|
1983 -- 9.8 Abort Statement --
|
|
|
1984 --------------------------
|
|
|
1985
|
|
|
1986 -- ABORT_STATEMENT ::= abort task_NAME {, task_NAME};
|
|
|
1987
|
|
|
1988 -- The caller has checked that the initial token is ABORT
|
|
|
1989
|
|
|
1990 -- Error recovery: cannot raise Error_Resync
|
|
|
1991
|
|
|
1992 function P_Abort_Statement return Node_Id is
|
|
|
1993 Abort_Node : Node_Id;
|
|
|
1994
|
|
|
1995 begin
|
|
|
1996 Abort_Node := New_Node (N_Abort_Statement, Token_Ptr);
|
|
|
1997 Scan; -- past ABORT
|
|
|
1998 Set_Names (Abort_Node, New_List);
|
|
|
1999
|
|
|
2000 loop
|
|
|
2001 Append (P_Name, Names (Abort_Node));
|
|
|
2002 exit when Token /= Tok_Comma;
|
|
|
2003 Scan; -- past comma
|
|
|
2004 end loop;
|
|
|
2005
|
|
|
2006 TF_Semicolon;
|
|
|
2007 return Abort_Node;
|
|
|
2008 end P_Abort_Statement;
|
|
|
2009
|
|
|
2010 end Ch9;
|
