Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/par-ch12.adb @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ------------------------------------------------------------------------------ | |
2 -- -- | |
3 -- GNAT COMPILER COMPONENTS -- | |
4 -- -- | |
5 -- P A R . C H 1 2 -- | |
6 -- -- | |
7 -- B o d y -- | |
8 -- -- | |
9 -- Copyright (C) 1992-2017, 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 separate (Par) | |
31 package body Ch12 is | |
32 | |
33 -- Local functions, used only in this chapter | |
34 | |
35 function P_Formal_Derived_Type_Definition return Node_Id; | |
36 function P_Formal_Discrete_Type_Definition return Node_Id; | |
37 function P_Formal_Fixed_Point_Definition return Node_Id; | |
38 function P_Formal_Floating_Point_Definition return Node_Id; | |
39 function P_Formal_Modular_Type_Definition return Node_Id; | |
40 function P_Formal_Package_Declaration return Node_Id; | |
41 function P_Formal_Private_Type_Definition return Node_Id; | |
42 function P_Formal_Signed_Integer_Type_Definition return Node_Id; | |
43 function P_Formal_Subprogram_Declaration return Node_Id; | |
44 function P_Formal_Type_Declaration return Node_Id; | |
45 function P_Formal_Type_Definition return Node_Id; | |
46 function P_Generic_Association return Node_Id; | |
47 | |
48 procedure P_Formal_Object_Declarations (Decls : List_Id); | |
49 -- Scans one or more formal object declarations and appends them to | |
50 -- Decls. Scans more than one declaration only in the case where the | |
51 -- source has a declaration with multiple defining identifiers. | |
52 | |
53 -------------------------------- | |
54 -- 12.1 Generic (also 8.5.5) -- | |
55 -------------------------------- | |
56 | |
57 -- This routine parses either one of the forms of a generic declaration | |
58 -- or a generic renaming declaration. | |
59 | |
60 -- GENERIC_DECLARATION ::= | |
61 -- GENERIC_SUBPROGRAM_DECLARATION | GENERIC_PACKAGE_DECLARATION | |
62 | |
63 -- GENERIC_SUBPROGRAM_DECLARATION ::= | |
64 -- GENERIC_FORMAL_PART SUBPROGRAM_SPECIFICATION | |
65 -- [ASPECT_SPECIFICATIONS]; | |
66 | |
67 -- GENERIC_PACKAGE_DECLARATION ::= | |
68 -- GENERIC_FORMAL_PART PACKAGE_SPECIFICATION | |
69 -- [ASPECT_SPECIFICATIONS]; | |
70 | |
71 -- GENERIC_FORMAL_PART ::= | |
72 -- generic {GENERIC_FORMAL_PARAMETER_DECLARATION | USE_CLAUSE} | |
73 | |
74 -- GENERIC_RENAMING_DECLARATION ::= | |
75 -- generic package DEFINING_PROGRAM_UNIT_NAME | |
76 -- renames generic_package_NAME | |
77 -- [ASPECT_SPECIFICATIONS]; | |
78 -- | generic procedure DEFINING_PROGRAM_UNIT_NAME | |
79 -- renames generic_procedure_NAME | |
80 -- [ASPECT_SPECIFICATIONS]; | |
81 -- | generic function DEFINING_PROGRAM_UNIT_NAME | |
82 -- renames generic_function_NAME | |
83 -- [ASPECT_SPECIFICATIONS]; | |
84 | |
85 -- GENERIC_FORMAL_PARAMETER_DECLARATION ::= | |
86 -- FORMAL_OBJECT_DECLARATION | |
87 -- | FORMAL_TYPE_DECLARATION | |
88 -- | FORMAL_SUBPROGRAM_DECLARATION | |
89 -- | FORMAL_PACKAGE_DECLARATION | |
90 | |
91 -- The caller has checked that the initial token is GENERIC | |
92 | |
93 -- Error recovery: can raise Error_Resync | |
94 | |
95 function P_Generic return Node_Id is | |
96 Gen_Sloc : constant Source_Ptr := Token_Ptr; | |
97 Gen_Decl : Node_Id; | |
98 Decl_Node : Node_Id; | |
99 Decls : List_Id; | |
100 Def_Unit : Node_Id; | |
101 Ren_Token : Token_Type; | |
102 Scan_State : Saved_Scan_State; | |
103 | |
104 begin | |
105 Scan; -- past GENERIC | |
106 | |
107 if Token = Tok_Private then | |
108 Error_Msg_SC -- CODEFIX | |
109 ("PRIVATE goes before GENERIC, not after"); | |
110 Scan; -- past junk PRIVATE token | |
111 end if; | |
112 | |
113 Save_Scan_State (Scan_State); -- at token past GENERIC | |
114 | |
115 -- Check for generic renaming declaration case | |
116 | |
117 if Token = Tok_Package | |
118 or else Token = Tok_Function | |
119 or else Token = Tok_Procedure | |
120 then | |
121 Ren_Token := Token; | |
122 Scan; -- scan past PACKAGE, FUNCTION or PROCEDURE | |
123 | |
124 if Token = Tok_Identifier then | |
125 Def_Unit := P_Defining_Program_Unit_Name; | |
126 | |
127 Check_Misspelling_Of (Tok_Renames); | |
128 | |
129 if Token = Tok_Renames then | |
130 if Ren_Token = Tok_Package then | |
131 Decl_Node := New_Node | |
132 (N_Generic_Package_Renaming_Declaration, Gen_Sloc); | |
133 | |
134 elsif Ren_Token = Tok_Procedure then | |
135 Decl_Node := New_Node | |
136 (N_Generic_Procedure_Renaming_Declaration, Gen_Sloc); | |
137 | |
138 else -- Ren_Token = Tok_Function then | |
139 Decl_Node := New_Node | |
140 (N_Generic_Function_Renaming_Declaration, Gen_Sloc); | |
141 end if; | |
142 | |
143 Scan; -- past RENAMES | |
144 Set_Defining_Unit_Name (Decl_Node, Def_Unit); | |
145 Set_Name (Decl_Node, P_Name); | |
146 | |
147 P_Aspect_Specifications (Decl_Node, Semicolon => False); | |
148 TF_Semicolon; | |
149 return Decl_Node; | |
150 end if; | |
151 end if; | |
152 end if; | |
153 | |
154 -- Fall through if this is *not* a generic renaming declaration | |
155 | |
156 Restore_Scan_State (Scan_State); | |
157 Decls := New_List; | |
158 | |
159 -- Loop through generic parameter declarations and use clauses | |
160 | |
161 Decl_Loop : loop | |
162 P_Pragmas_Opt (Decls); | |
163 | |
164 if Token = Tok_Private then | |
165 Error_Msg_S ("generic private child packages not permitted"); | |
166 Scan; -- past PRIVATE | |
167 end if; | |
168 | |
169 if Token = Tok_Use then | |
170 P_Use_Clause (Decls); | |
171 | |
172 else | |
173 -- Parse a generic parameter declaration | |
174 | |
175 if Token = Tok_Identifier then | |
176 P_Formal_Object_Declarations (Decls); | |
177 | |
178 elsif Token = Tok_Type then | |
179 Append (P_Formal_Type_Declaration, Decls); | |
180 | |
181 elsif Token = Tok_With then | |
182 Scan; -- past WITH | |
183 | |
184 if Token = Tok_Package then | |
185 Append (P_Formal_Package_Declaration, Decls); | |
186 | |
187 elsif Token = Tok_Procedure or Token = Tok_Function then | |
188 Append (P_Formal_Subprogram_Declaration, Decls); | |
189 | |
190 else | |
191 Error_Msg_BC -- CODEFIX | |
192 ("FUNCTION, PROCEDURE or PACKAGE expected here"); | |
193 Resync_Past_Semicolon; | |
194 end if; | |
195 | |
196 elsif Token = Tok_Subtype then | |
197 Error_Msg_SC ("subtype declaration not allowed " & | |
198 "as generic parameter declaration!"); | |
199 Resync_Past_Semicolon; | |
200 | |
201 else | |
202 exit Decl_Loop; | |
203 end if; | |
204 end if; | |
205 end loop Decl_Loop; | |
206 | |
207 -- Generic formal part is scanned, scan out subprogram or package spec | |
208 | |
209 if Token = Tok_Package then | |
210 Gen_Decl := New_Node (N_Generic_Package_Declaration, Gen_Sloc); | |
211 Set_Specification (Gen_Decl, P_Package (Pf_Spcn)); | |
212 | |
213 -- Aspects have been parsed by the package spec. Move them to the | |
214 -- generic declaration where they belong. | |
215 | |
216 Move_Aspects (Specification (Gen_Decl), Gen_Decl); | |
217 | |
218 else | |
219 Gen_Decl := New_Node (N_Generic_Subprogram_Declaration, Gen_Sloc); | |
220 Set_Specification (Gen_Decl, P_Subprogram_Specification); | |
221 | |
222 if Nkind (Defining_Unit_Name (Specification (Gen_Decl))) = | |
223 N_Defining_Program_Unit_Name | |
224 and then Scope.Last > 0 | |
225 then | |
226 Error_Msg_SP ("child unit allowed only at library level"); | |
227 end if; | |
228 | |
229 P_Aspect_Specifications (Gen_Decl); | |
230 end if; | |
231 | |
232 Set_Generic_Formal_Declarations (Gen_Decl, Decls); | |
233 return Gen_Decl; | |
234 end P_Generic; | |
235 | |
236 ------------------------------- | |
237 -- 12.1 Generic Declaration -- | |
238 ------------------------------- | |
239 | |
240 -- Parsed by P_Generic (12.1) | |
241 | |
242 ------------------------------------------ | |
243 -- 12.1 Generic Subprogram Declaration -- | |
244 ------------------------------------------ | |
245 | |
246 -- Parsed by P_Generic (12.1) | |
247 | |
248 --------------------------------------- | |
249 -- 12.1 Generic Package Declaration -- | |
250 --------------------------------------- | |
251 | |
252 -- Parsed by P_Generic (12.1) | |
253 | |
254 ------------------------------- | |
255 -- 12.1 Generic Formal Part -- | |
256 ------------------------------- | |
257 | |
258 -- Parsed by P_Generic (12.1) | |
259 | |
260 ------------------------------------------------- | |
261 -- 12.1 Generic Formal Parameter Declaration -- | |
262 ------------------------------------------------- | |
263 | |
264 -- Parsed by P_Generic (12.1) | |
265 | |
266 --------------------------------- | |
267 -- 12.3 Generic Instantiation -- | |
268 --------------------------------- | |
269 | |
270 -- Generic package instantiation parsed by P_Package (7.1) | |
271 -- Generic procedure instantiation parsed by P_Subprogram (6.1) | |
272 -- Generic function instantiation parsed by P_Subprogram (6.1) | |
273 | |
274 ------------------------------- | |
275 -- 12.3 Generic Actual Part -- | |
276 ------------------------------- | |
277 | |
278 -- GENERIC_ACTUAL_PART ::= | |
279 -- (GENERIC_ASSOCIATION {, GENERIC_ASSOCIATION}) | |
280 | |
281 -- Returns a list of generic associations, or Empty if none are present | |
282 | |
283 -- Error recovery: cannot raise Error_Resync | |
284 | |
285 function P_Generic_Actual_Part_Opt return List_Id is | |
286 Association_List : List_Id; | |
287 | |
288 begin | |
289 -- Figure out if a generic actual part operation is present. Clearly | |
290 -- there is no generic actual part if the current token is semicolon | |
291 -- or if we have aspect specifications present. | |
292 | |
293 if Token = Tok_Semicolon or else Aspect_Specifications_Present then | |
294 return No_List; | |
295 | |
296 -- If we don't have a left paren, then we have an error, and the job | |
297 -- is to figure out whether a left paren or semicolon was intended. | |
298 -- We assume a missing left paren (and hence a generic actual part | |
299 -- present) if the current token is not on a new line, or if it is | |
300 -- indented from the subprogram token. Otherwise assume missing | |
301 -- semicolon (which will be diagnosed by caller) and no generic part | |
302 | |
303 elsif Token /= Tok_Left_Paren | |
304 and then Token_Is_At_Start_Of_Line | |
305 and then Start_Column <= Scope.Table (Scope.Last).Ecol | |
306 then | |
307 return No_List; | |
308 | |
309 -- Otherwise we have a generic actual part (either a left paren is | |
310 -- present, or we have decided that there must be a missing left paren) | |
311 | |
312 else | |
313 Association_List := New_List; | |
314 T_Left_Paren; | |
315 | |
316 loop | |
317 Append (P_Generic_Association, Association_List); | |
318 exit when not Comma_Present; | |
319 end loop; | |
320 | |
321 T_Right_Paren; | |
322 return Association_List; | |
323 end if; | |
324 | |
325 end P_Generic_Actual_Part_Opt; | |
326 | |
327 ------------------------------- | |
328 -- 12.3 Generic Association -- | |
329 ------------------------------- | |
330 | |
331 -- GENERIC_ASSOCIATION ::= | |
332 -- [generic_formal_parameter_SELECTOR_NAME =>] | |
333 -- EXPLICIT_GENERIC_ACTUAL_PARAMETER | |
334 | |
335 -- EXPLICIT_GENERIC_ACTUAL_PARAMETER ::= | |
336 -- EXPRESSION | variable_NAME | subprogram_NAME | |
337 -- | entry_NAME | SUBTYPE_MARK | package_instance_NAME | |
338 | |
339 -- Error recovery: cannot raise Error_Resync | |
340 | |
341 function P_Generic_Association return Node_Id is | |
342 Scan_State : Saved_Scan_State; | |
343 Param_Name_Node : Node_Id; | |
344 Generic_Assoc_Node : Node_Id; | |
345 | |
346 begin | |
347 Generic_Assoc_Node := New_Node (N_Generic_Association, Token_Ptr); | |
348 | |
349 -- Ada 2005: an association can be given by: others => <> | |
350 | |
351 if Token = Tok_Others then | |
352 if Ada_Version < Ada_2005 then | |
353 Error_Msg_SP | |
354 ("partial parameterization of formal packages" | |
355 & " is an Ada 2005 extension"); | |
356 Error_Msg_SP | |
357 ("\unit must be compiled with -gnat05 switch"); | |
358 end if; | |
359 | |
360 Scan; -- past OTHERS | |
361 | |
362 if Token /= Tok_Arrow then | |
363 Error_Msg_BC ("expect arrow after others"); | |
364 else | |
365 Scan; -- past arrow | |
366 end if; | |
367 | |
368 if Token /= Tok_Box then | |
369 Error_Msg_BC ("expect Box after arrow"); | |
370 else | |
371 Scan; -- past box | |
372 end if; | |
373 | |
374 -- Source position of the others choice is beginning of construct | |
375 | |
376 return New_Node (N_Others_Choice, Sloc (Generic_Assoc_Node)); | |
377 end if; | |
378 | |
379 if Token in Token_Class_Desig then | |
380 Param_Name_Node := Token_Node; | |
381 Save_Scan_State (Scan_State); -- at designator | |
382 Scan; -- past simple name or operator symbol | |
383 | |
384 if Token = Tok_Arrow then | |
385 Scan; -- past arrow | |
386 Set_Selector_Name (Generic_Assoc_Node, Param_Name_Node); | |
387 else | |
388 Restore_Scan_State (Scan_State); -- to designator | |
389 end if; | |
390 end if; | |
391 | |
392 -- In Ada 2005 the actual can be a box | |
393 | |
394 if Token = Tok_Box then | |
395 Scan; | |
396 Set_Box_Present (Generic_Assoc_Node); | |
397 Set_Explicit_Generic_Actual_Parameter (Generic_Assoc_Node, Empty); | |
398 | |
399 else | |
400 Set_Explicit_Generic_Actual_Parameter | |
401 (Generic_Assoc_Node, P_Expression); | |
402 end if; | |
403 | |
404 return Generic_Assoc_Node; | |
405 end P_Generic_Association; | |
406 | |
407 --------------------------------------------- | |
408 -- 12.3 Explicit Generic Actual Parameter -- | |
409 --------------------------------------------- | |
410 | |
411 -- Parsed by P_Generic_Association (12.3) | |
412 | |
413 -------------------------------------- | |
414 -- 12.4 Formal Object Declarations -- | |
415 -------------------------------------- | |
416 | |
417 -- FORMAL_OBJECT_DECLARATION ::= | |
418 -- DEFINING_IDENTIFIER_LIST : | |
419 -- MODE [NULL_EXCLUSION] SUBTYPE_MARK [:= DEFAULT_EXPRESSION] | |
420 -- [ASPECT_SPECIFICATIONS]; | |
421 -- | DEFINING_IDENTIFIER_LIST : | |
422 -- MODE ACCESS_DEFINITION [:= DEFAULT_EXPRESSION]; | |
423 -- [ASPECT_SPECIFICATIONS]; | |
424 | |
425 -- The caller has checked that the initial token is an identifier | |
426 | |
427 -- Error recovery: cannot raise Error_Resync | |
428 | |
429 procedure P_Formal_Object_Declarations (Decls : List_Id) is | |
430 Decl_Node : Node_Id; | |
431 Ident : Nat; | |
432 Not_Null_Present : Boolean := False; | |
433 Num_Idents : Nat; | |
434 Scan_State : Saved_Scan_State; | |
435 | |
436 Idents : array (Int range 1 .. 4096) of Entity_Id; | |
437 -- This array holds the list of defining identifiers. The upper bound | |
438 -- of 4096 is intended to be essentially infinite, and we do not even | |
439 -- bother to check for it being exceeded. | |
440 | |
441 begin | |
442 Idents (1) := P_Defining_Identifier (C_Comma_Colon); | |
443 Num_Idents := 1; | |
444 while Comma_Present loop | |
445 Num_Idents := Num_Idents + 1; | |
446 Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon); | |
447 end loop; | |
448 | |
449 T_Colon; | |
450 | |
451 -- If there are multiple identifiers, we repeatedly scan the | |
452 -- type and initialization expression information by resetting | |
453 -- the scan pointer (so that we get completely separate trees | |
454 -- for each occurrence). | |
455 | |
456 if Num_Idents > 1 then | |
457 Save_Scan_State (Scan_State); | |
458 end if; | |
459 | |
460 -- Loop through defining identifiers in list | |
461 | |
462 Ident := 1; | |
463 Ident_Loop : loop | |
464 Decl_Node := New_Node (N_Formal_Object_Declaration, Token_Ptr); | |
465 Set_Defining_Identifier (Decl_Node, Idents (Ident)); | |
466 P_Mode (Decl_Node); | |
467 | |
468 Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-423) | |
469 | |
470 -- Ada 2005 (AI-423): Formal object with an access definition | |
471 | |
472 if Token = Tok_Access then | |
473 | |
474 -- The access definition is still parsed and set even though | |
475 -- the compilation may not use the proper switch. This action | |
476 -- ensures the required local error recovery. | |
477 | |
478 Set_Access_Definition (Decl_Node, | |
479 P_Access_Definition (Not_Null_Present)); | |
480 | |
481 if Ada_Version < Ada_2005 then | |
482 Error_Msg_SP | |
483 ("access definition not allowed in formal object " & | |
484 "declaration"); | |
485 Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); | |
486 end if; | |
487 | |
488 -- Formal object with a subtype mark | |
489 | |
490 else | |
491 Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present); | |
492 Set_Subtype_Mark (Decl_Node, P_Subtype_Mark_Resync); | |
493 end if; | |
494 | |
495 No_Constraint; | |
496 Set_Default_Expression (Decl_Node, Init_Expr_Opt); | |
497 P_Aspect_Specifications (Decl_Node); | |
498 | |
499 if Ident > 1 then | |
500 Set_Prev_Ids (Decl_Node, True); | |
501 end if; | |
502 | |
503 if Ident < Num_Idents then | |
504 Set_More_Ids (Decl_Node, True); | |
505 end if; | |
506 | |
507 Append (Decl_Node, Decls); | |
508 | |
509 exit Ident_Loop when Ident = Num_Idents; | |
510 Ident := Ident + 1; | |
511 Restore_Scan_State (Scan_State); | |
512 end loop Ident_Loop; | |
513 end P_Formal_Object_Declarations; | |
514 | |
515 ----------------------------------- | |
516 -- 12.5 Formal Type Declaration -- | |
517 ----------------------------------- | |
518 | |
519 -- FORMAL_TYPE_DECLARATION ::= | |
520 -- type DEFINING_IDENTIFIER [DISCRIMINANT_PART] | |
521 -- is FORMAL_TYPE_DEFINITION | |
522 -- [ASPECT_SPECIFICATIONS]; | |
523 | |
524 -- The caller has checked that the initial token is TYPE | |
525 | |
526 -- Error recovery: cannot raise Error_Resync | |
527 | |
528 function P_Formal_Type_Declaration return Node_Id is | |
529 Decl_Node : Node_Id; | |
530 Def_Node : Node_Id; | |
531 | |
532 begin | |
533 Decl_Node := New_Node (N_Formal_Type_Declaration, Token_Ptr); | |
534 Scan; -- past TYPE | |
535 Set_Defining_Identifier (Decl_Node, P_Defining_Identifier); | |
536 | |
537 if P_Unknown_Discriminant_Part_Opt then | |
538 Set_Unknown_Discriminants_Present (Decl_Node, True); | |
539 else | |
540 Set_Discriminant_Specifications | |
541 (Decl_Node, P_Known_Discriminant_Part_Opt); | |
542 end if; | |
543 | |
544 if Token = Tok_Semicolon then | |
545 | |
546 -- Ada 2012: Incomplete formal type | |
547 | |
548 Scan; -- past semicolon | |
549 | |
550 Error_Msg_Ada_2012_Feature | |
551 ("formal incomplete type", Sloc (Decl_Node)); | |
552 | |
553 Set_Formal_Type_Definition | |
554 (Decl_Node, | |
555 New_Node (N_Formal_Incomplete_Type_Definition, Token_Ptr)); | |
556 return Decl_Node; | |
557 | |
558 else | |
559 T_Is; | |
560 end if; | |
561 | |
562 Def_Node := P_Formal_Type_Definition; | |
563 | |
564 if Nkind (Def_Node) = N_Formal_Incomplete_Type_Definition then | |
565 Error_Msg_Ada_2012_Feature | |
566 ("formal incomplete type", Sloc (Decl_Node)); | |
567 end if; | |
568 | |
569 if Def_Node /= Error then | |
570 Set_Formal_Type_Definition (Decl_Node, Def_Node); | |
571 P_Aspect_Specifications (Decl_Node); | |
572 | |
573 else | |
574 Decl_Node := Error; | |
575 | |
576 -- If we have aspect specifications, skip them | |
577 | |
578 if Aspect_Specifications_Present then | |
579 P_Aspect_Specifications (Error); | |
580 | |
581 -- If we have semicolon, skip it to avoid cascaded errors | |
582 | |
583 elsif Token = Tok_Semicolon then | |
584 Scan; -- past semicolon | |
585 end if; | |
586 end if; | |
587 | |
588 return Decl_Node; | |
589 end P_Formal_Type_Declaration; | |
590 | |
591 ---------------------------------- | |
592 -- 12.5 Formal Type Definition -- | |
593 ---------------------------------- | |
594 | |
595 -- FORMAL_TYPE_DEFINITION ::= | |
596 -- FORMAL_PRIVATE_TYPE_DEFINITION | |
597 -- | FORMAL_INCOMPLETE_TYPE_DEFINITION | |
598 -- | FORMAL_DERIVED_TYPE_DEFINITION | |
599 -- | FORMAL_DISCRETE_TYPE_DEFINITION | |
600 -- | FORMAL_SIGNED_INTEGER_TYPE_DEFINITION | |
601 -- | FORMAL_MODULAR_TYPE_DEFINITION | |
602 -- | FORMAL_FLOATING_POINT_DEFINITION | |
603 -- | FORMAL_ORDINARY_FIXED_POINT_DEFINITION | |
604 -- | FORMAL_DECIMAL_FIXED_POINT_DEFINITION | |
605 -- | FORMAL_ARRAY_TYPE_DEFINITION | |
606 -- | FORMAL_ACCESS_TYPE_DEFINITION | |
607 -- | FORMAL_INTERFACE_TYPE_DEFINITION | |
608 | |
609 -- FORMAL_ARRAY_TYPE_DEFINITION ::= ARRAY_TYPE_DEFINITION | |
610 | |
611 -- FORMAL_ACCESS_TYPE_DEFINITION ::= ACCESS_TYPE_DEFINITION | |
612 | |
613 -- FORMAL_INTERFACE_TYPE_DEFINITION ::= INTERFACE_TYPE_DEFINITION | |
614 | |
615 function P_Formal_Type_Definition return Node_Id is | |
616 Scan_State : Saved_Scan_State; | |
617 Typedef_Node : Node_Id; | |
618 | |
619 begin | |
620 if Token_Name = Name_Abstract then | |
621 Check_95_Keyword (Tok_Abstract, Tok_Tagged); | |
622 end if; | |
623 | |
624 if Token_Name = Name_Tagged then | |
625 Check_95_Keyword (Tok_Tagged, Tok_Private); | |
626 Check_95_Keyword (Tok_Tagged, Tok_Limited); | |
627 end if; | |
628 | |
629 case Token is | |
630 | |
631 -- Mostly we can tell what we have from the initial token. The one | |
632 -- exception is ABSTRACT, where we have to scan ahead to see if we | |
633 -- have a formal derived type or a formal private type definition. | |
634 | |
635 -- In addition, in Ada 2005 LIMITED may appear after abstract, so | |
636 -- that the lookahead must be extended by one more token. | |
637 | |
638 when Tok_Abstract => | |
639 Save_Scan_State (Scan_State); | |
640 Scan; -- past ABSTRACT | |
641 | |
642 if Token = Tok_New then | |
643 Restore_Scan_State (Scan_State); -- to ABSTRACT | |
644 return P_Formal_Derived_Type_Definition; | |
645 | |
646 elsif Token = Tok_Limited then | |
647 Scan; -- past LIMITED | |
648 | |
649 if Token = Tok_New then | |
650 Restore_Scan_State (Scan_State); -- to ABSTRACT | |
651 return P_Formal_Derived_Type_Definition; | |
652 | |
653 else | |
654 Restore_Scan_State (Scan_State); -- to ABSTRACT | |
655 return P_Formal_Private_Type_Definition; | |
656 end if; | |
657 | |
658 -- Ada 2005 (AI-443): Abstract synchronized formal derived type | |
659 | |
660 elsif Token = Tok_Synchronized then | |
661 Restore_Scan_State (Scan_State); -- to ABSTRACT | |
662 return P_Formal_Derived_Type_Definition; | |
663 | |
664 else | |
665 Restore_Scan_State (Scan_State); -- to ABSTRACT | |
666 return P_Formal_Private_Type_Definition; | |
667 end if; | |
668 | |
669 when Tok_Access => | |
670 return P_Access_Type_Definition; | |
671 | |
672 when Tok_Array => | |
673 return P_Array_Type_Definition; | |
674 | |
675 when Tok_Delta => | |
676 return P_Formal_Fixed_Point_Definition; | |
677 | |
678 when Tok_Digits => | |
679 return P_Formal_Floating_Point_Definition; | |
680 | |
681 when Tok_Interface => -- Ada 2005 (AI-251) | |
682 return P_Interface_Type_Definition (Abstract_Present => False); | |
683 | |
684 when Tok_Left_Paren => | |
685 return P_Formal_Discrete_Type_Definition; | |
686 | |
687 when Tok_Limited => | |
688 Save_Scan_State (Scan_State); | |
689 Scan; -- past LIMITED | |
690 | |
691 if Token = Tok_Interface then | |
692 Typedef_Node := | |
693 P_Interface_Type_Definition (Abstract_Present => False); | |
694 Set_Limited_Present (Typedef_Node); | |
695 return Typedef_Node; | |
696 | |
697 elsif Token = Tok_New then | |
698 Restore_Scan_State (Scan_State); -- to LIMITED | |
699 return P_Formal_Derived_Type_Definition; | |
700 | |
701 else | |
702 if Token = Tok_Abstract then | |
703 Error_Msg_SC -- CODEFIX | |
704 ("ABSTRACT must come before LIMITED"); | |
705 Scan; -- past improper ABSTRACT | |
706 | |
707 if Token = Tok_New then | |
708 Restore_Scan_State (Scan_State); -- to LIMITED | |
709 return P_Formal_Derived_Type_Definition; | |
710 | |
711 else | |
712 Restore_Scan_State (Scan_State); | |
713 return P_Formal_Private_Type_Definition; | |
714 end if; | |
715 end if; | |
716 | |
717 Restore_Scan_State (Scan_State); | |
718 return P_Formal_Private_Type_Definition; | |
719 end if; | |
720 | |
721 when Tok_Mod => | |
722 return P_Formal_Modular_Type_Definition; | |
723 | |
724 when Tok_New => | |
725 return P_Formal_Derived_Type_Definition; | |
726 | |
727 when Tok_Not => | |
728 if P_Null_Exclusion then | |
729 Typedef_Node := P_Access_Type_Definition; | |
730 Set_Null_Exclusion_Present (Typedef_Node); | |
731 return Typedef_Node; | |
732 | |
733 else | |
734 Error_Msg_SC ("expect valid formal access definition!"); | |
735 Resync_Past_Semicolon; | |
736 return Error; | |
737 end if; | |
738 | |
739 when Tok_Private => | |
740 return P_Formal_Private_Type_Definition; | |
741 | |
742 when Tok_Tagged => | |
743 if Next_Token_Is (Tok_Semicolon) then | |
744 Typedef_Node := | |
745 New_Node (N_Formal_Incomplete_Type_Definition, Token_Ptr); | |
746 Set_Tagged_Present (Typedef_Node); | |
747 | |
748 Scan; -- past tagged | |
749 return Typedef_Node; | |
750 | |
751 else | |
752 return P_Formal_Private_Type_Definition; | |
753 end if; | |
754 | |
755 when Tok_Range => | |
756 return P_Formal_Signed_Integer_Type_Definition; | |
757 | |
758 when Tok_Record => | |
759 Error_Msg_SC ("record not allowed in generic type definition!"); | |
760 Discard_Junk_Node (P_Record_Definition); | |
761 return Error; | |
762 | |
763 -- Ada 2005 (AI-345): Task, Protected or Synchronized interface or | |
764 -- (AI-443): Synchronized formal derived type declaration. | |
765 | |
766 when Tok_Protected | |
767 | Tok_Synchronized | |
768 | Tok_Task | |
769 => | |
770 declare | |
771 Saved_Token : constant Token_Type := Token; | |
772 | |
773 begin | |
774 Scan; -- past TASK, PROTECTED or SYNCHRONIZED | |
775 | |
776 -- Synchronized derived type | |
777 | |
778 if Token = Tok_New then | |
779 Typedef_Node := P_Formal_Derived_Type_Definition; | |
780 | |
781 if Saved_Token = Tok_Synchronized then | |
782 Set_Synchronized_Present (Typedef_Node); | |
783 else | |
784 Error_Msg_SC ("invalid kind of formal derived type"); | |
785 end if; | |
786 | |
787 -- Interface | |
788 | |
789 else | |
790 Typedef_Node := | |
791 P_Interface_Type_Definition (Abstract_Present => False); | |
792 | |
793 case Saved_Token is | |
794 when Tok_Task => | |
795 Set_Task_Present (Typedef_Node); | |
796 | |
797 when Tok_Protected => | |
798 Set_Protected_Present (Typedef_Node); | |
799 | |
800 when Tok_Synchronized => | |
801 Set_Synchronized_Present (Typedef_Node); | |
802 | |
803 when others => | |
804 null; | |
805 end case; | |
806 end if; | |
807 | |
808 return Typedef_Node; | |
809 end; | |
810 | |
811 when others => | |
812 Error_Msg_BC ("expecting generic type definition here"); | |
813 Resync_Past_Semicolon; | |
814 return Error; | |
815 end case; | |
816 end P_Formal_Type_Definition; | |
817 | |
818 -------------------------------------------- | |
819 -- 12.5.1 Formal Private Type Definition -- | |
820 -------------------------------------------- | |
821 | |
822 -- FORMAL_PRIVATE_TYPE_DEFINITION ::= | |
823 -- [[abstract] tagged] [limited] private | |
824 | |
825 -- The caller has checked the initial token is PRIVATE, ABSTRACT, | |
826 -- TAGGED or LIMITED | |
827 | |
828 -- Error recovery: cannot raise Error_Resync | |
829 | |
830 function P_Formal_Private_Type_Definition return Node_Id is | |
831 Def_Node : Node_Id; | |
832 | |
833 begin | |
834 Def_Node := New_Node (N_Formal_Private_Type_Definition, Token_Ptr); | |
835 | |
836 if Token = Tok_Abstract then | |
837 Scan; -- past ABSTRACT | |
838 | |
839 if Token_Name = Name_Tagged then | |
840 Check_95_Keyword (Tok_Tagged, Tok_Private); | |
841 Check_95_Keyword (Tok_Tagged, Tok_Limited); | |
842 end if; | |
843 | |
844 if Token /= Tok_Tagged then | |
845 Error_Msg_SP ("ABSTRACT must be followed by TAGGED"); | |
846 else | |
847 Set_Abstract_Present (Def_Node, True); | |
848 end if; | |
849 end if; | |
850 | |
851 if Token = Tok_Tagged then | |
852 Set_Tagged_Present (Def_Node, True); | |
853 Scan; -- past TAGGED | |
854 end if; | |
855 | |
856 if Token = Tok_Limited then | |
857 Set_Limited_Present (Def_Node, True); | |
858 Scan; -- past LIMITED | |
859 end if; | |
860 | |
861 if Token = Tok_Abstract then | |
862 if Prev_Token = Tok_Tagged then | |
863 Error_Msg_SC -- CODEFIX | |
864 ("ABSTRACT must come before TAGGED"); | |
865 elsif Prev_Token = Tok_Limited then | |
866 Error_Msg_SC -- CODEFIX | |
867 ("ABSTRACT must come before LIMITED"); | |
868 end if; | |
869 | |
870 Resync_Past_Semicolon; | |
871 | |
872 elsif Token = Tok_Tagged then | |
873 Error_Msg_SC -- CODEFIX | |
874 ("TAGGED must come before LIMITED"); | |
875 Resync_Past_Semicolon; | |
876 end if; | |
877 | |
878 Set_Sloc (Def_Node, Token_Ptr); | |
879 T_Private; | |
880 | |
881 if Token = Tok_Tagged then -- CODEFIX | |
882 Error_Msg_SC ("TAGGED must come before PRIVATE"); | |
883 Scan; -- past TAGGED | |
884 | |
885 elsif Token = Tok_Abstract then -- CODEFIX | |
886 Error_Msg_SC ("`ABSTRACT TAGGED` must come before PRIVATE"); | |
887 Scan; -- past ABSTRACT | |
888 | |
889 if Token = Tok_Tagged then | |
890 Scan; -- past TAGGED | |
891 end if; | |
892 end if; | |
893 | |
894 return Def_Node; | |
895 end P_Formal_Private_Type_Definition; | |
896 | |
897 -------------------------------------------- | |
898 -- 12.5.1 Formal Derived Type Definition -- | |
899 -------------------------------------------- | |
900 | |
901 -- FORMAL_DERIVED_TYPE_DEFINITION ::= | |
902 -- [abstract] [limited | synchronized] | |
903 -- new SUBTYPE_MARK [[and INTERFACE_LIST] with private] | |
904 | |
905 -- The caller has checked the initial token(s) is/are NEW, ABSTRACT NEW, | |
906 -- or LIMITED NEW, ABSTRACT LIMITED NEW, SYNCHRONIZED NEW or ABSTRACT | |
907 -- SYNCHRONIZED NEW. | |
908 | |
909 -- Error recovery: cannot raise Error_Resync | |
910 | |
911 function P_Formal_Derived_Type_Definition return Node_Id is | |
912 Def_Node : Node_Id; | |
913 | |
914 begin | |
915 Def_Node := New_Node (N_Formal_Derived_Type_Definition, Token_Ptr); | |
916 | |
917 if Token = Tok_Abstract then | |
918 Set_Abstract_Present (Def_Node); | |
919 Scan; -- past ABSTRACT | |
920 end if; | |
921 | |
922 if Token = Tok_Limited then | |
923 Set_Limited_Present (Def_Node); | |
924 Scan; -- past LIMITED | |
925 | |
926 if Ada_Version < Ada_2005 then | |
927 Error_Msg_SP | |
928 ("LIMITED in derived type is an Ada 2005 extension"); | |
929 Error_Msg_SP | |
930 ("\unit must be compiled with -gnat05 switch"); | |
931 end if; | |
932 | |
933 elsif Token = Tok_Synchronized then | |
934 Set_Synchronized_Present (Def_Node); | |
935 Scan; -- past SYNCHRONIZED | |
936 | |
937 if Ada_Version < Ada_2005 then | |
938 Error_Msg_SP | |
939 ("SYNCHRONIZED in derived type is an Ada 2005 extension"); | |
940 Error_Msg_SP | |
941 ("\unit must be compiled with -gnat05 switch"); | |
942 end if; | |
943 end if; | |
944 | |
945 if Token = Tok_Abstract then | |
946 Scan; -- past ABSTRACT, diagnosed already in caller. | |
947 end if; | |
948 | |
949 Scan; -- past NEW; | |
950 Set_Subtype_Mark (Def_Node, P_Subtype_Mark); | |
951 No_Constraint; | |
952 | |
953 -- Ada 2005 (AI-251): Deal with interfaces | |
954 | |
955 if Token = Tok_And then | |
956 Scan; -- past AND | |
957 | |
958 if Ada_Version < Ada_2005 then | |
959 Error_Msg_SP | |
960 ("abstract interface is an Ada 2005 extension"); | |
961 Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); | |
962 end if; | |
963 | |
964 Set_Interface_List (Def_Node, New_List); | |
965 | |
966 loop | |
967 Append (P_Qualified_Simple_Name, Interface_List (Def_Node)); | |
968 exit when Token /= Tok_And; | |
969 Scan; -- past AND | |
970 end loop; | |
971 end if; | |
972 | |
973 if Token = Tok_With then | |
974 Scan; -- past WITH | |
975 Set_Private_Present (Def_Node, True); | |
976 T_Private; | |
977 | |
978 elsif Token = Tok_Tagged then | |
979 Scan; | |
980 | |
981 if Token = Tok_Private then | |
982 Error_Msg_SC -- CODEFIX | |
983 ("TAGGED should be WITH"); | |
984 Set_Private_Present (Def_Node, True); | |
985 T_Private; | |
986 else | |
987 Ignore (Tok_Tagged); | |
988 end if; | |
989 end if; | |
990 | |
991 return Def_Node; | |
992 end P_Formal_Derived_Type_Definition; | |
993 | |
994 --------------------------------------------- | |
995 -- 12.5.2 Formal Discrete Type Definition -- | |
996 --------------------------------------------- | |
997 | |
998 -- FORMAL_DISCRETE_TYPE_DEFINITION ::= (<>) | |
999 | |
1000 -- The caller has checked the initial token is left paren | |
1001 | |
1002 -- Error recovery: cannot raise Error_Resync | |
1003 | |
1004 function P_Formal_Discrete_Type_Definition return Node_Id is | |
1005 Def_Node : Node_Id; | |
1006 | |
1007 begin | |
1008 Def_Node := New_Node (N_Formal_Discrete_Type_Definition, Token_Ptr); | |
1009 Scan; -- past left paren | |
1010 T_Box; | |
1011 T_Right_Paren; | |
1012 return Def_Node; | |
1013 end P_Formal_Discrete_Type_Definition; | |
1014 | |
1015 --------------------------------------------------- | |
1016 -- 12.5.2 Formal Signed Integer Type Definition -- | |
1017 --------------------------------------------------- | |
1018 | |
1019 -- FORMAL_SIGNED_INTEGER_TYPE_DEFINITION ::= range <> | |
1020 | |
1021 -- The caller has checked the initial token is RANGE | |
1022 | |
1023 -- Error recovery: cannot raise Error_Resync | |
1024 | |
1025 function P_Formal_Signed_Integer_Type_Definition return Node_Id is | |
1026 Def_Node : Node_Id; | |
1027 | |
1028 begin | |
1029 Def_Node := | |
1030 New_Node (N_Formal_Signed_Integer_Type_Definition, Token_Ptr); | |
1031 Scan; -- past RANGE | |
1032 T_Box; | |
1033 return Def_Node; | |
1034 end P_Formal_Signed_Integer_Type_Definition; | |
1035 | |
1036 -------------------------------------------- | |
1037 -- 12.5.2 Formal Modular Type Definition -- | |
1038 -------------------------------------------- | |
1039 | |
1040 -- FORMAL_MODULAR_TYPE_DEFINITION ::= mod <> | |
1041 | |
1042 -- The caller has checked the initial token is MOD | |
1043 | |
1044 -- Error recovery: cannot raise Error_Resync | |
1045 | |
1046 function P_Formal_Modular_Type_Definition return Node_Id is | |
1047 Def_Node : Node_Id; | |
1048 | |
1049 begin | |
1050 Def_Node := | |
1051 New_Node (N_Formal_Modular_Type_Definition, Token_Ptr); | |
1052 Scan; -- past MOD | |
1053 T_Box; | |
1054 return Def_Node; | |
1055 end P_Formal_Modular_Type_Definition; | |
1056 | |
1057 ---------------------------------------------- | |
1058 -- 12.5.2 Formal Floating Point Definition -- | |
1059 ---------------------------------------------- | |
1060 | |
1061 -- FORMAL_FLOATING_POINT_DEFINITION ::= digits <> | |
1062 | |
1063 -- The caller has checked the initial token is DIGITS | |
1064 | |
1065 -- Error recovery: cannot raise Error_Resync | |
1066 | |
1067 function P_Formal_Floating_Point_Definition return Node_Id is | |
1068 Def_Node : Node_Id; | |
1069 | |
1070 begin | |
1071 Def_Node := | |
1072 New_Node (N_Formal_Floating_Point_Definition, Token_Ptr); | |
1073 Scan; -- past DIGITS | |
1074 T_Box; | |
1075 return Def_Node; | |
1076 end P_Formal_Floating_Point_Definition; | |
1077 | |
1078 ------------------------------------------- | |
1079 -- 12.5.2 Formal Fixed Point Definition -- | |
1080 ------------------------------------------- | |
1081 | |
1082 -- This routine parses either a formal ordinary fixed point definition | |
1083 -- or a formal decimal fixed point definition: | |
1084 | |
1085 -- FORMAL_ORDINARY_FIXED_POINT_DEFINITION ::= delta <> | |
1086 | |
1087 -- FORMAL_DECIMAL_FIXED_POINT_DEFINITION ::= delta <> digits <> | |
1088 | |
1089 -- The caller has checked the initial token is DELTA | |
1090 | |
1091 -- Error recovery: cannot raise Error_Resync | |
1092 | |
1093 function P_Formal_Fixed_Point_Definition return Node_Id is | |
1094 Def_Node : Node_Id; | |
1095 Delta_Sloc : Source_Ptr; | |
1096 | |
1097 begin | |
1098 Delta_Sloc := Token_Ptr; | |
1099 Scan; -- past DELTA | |
1100 T_Box; | |
1101 | |
1102 if Token = Tok_Digits then | |
1103 Def_Node := | |
1104 New_Node (N_Formal_Decimal_Fixed_Point_Definition, Delta_Sloc); | |
1105 Scan; -- past DIGITS | |
1106 T_Box; | |
1107 else | |
1108 Def_Node := | |
1109 New_Node (N_Formal_Ordinary_Fixed_Point_Definition, Delta_Sloc); | |
1110 end if; | |
1111 | |
1112 return Def_Node; | |
1113 end P_Formal_Fixed_Point_Definition; | |
1114 | |
1115 ---------------------------------------------------- | |
1116 -- 12.5.2 Formal Ordinary Fixed Point Definition -- | |
1117 ---------------------------------------------------- | |
1118 | |
1119 -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2) | |
1120 | |
1121 --------------------------------------------------- | |
1122 -- 12.5.2 Formal Decimal Fixed Point Definition -- | |
1123 --------------------------------------------------- | |
1124 | |
1125 -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2) | |
1126 | |
1127 ------------------------------------------ | |
1128 -- 12.5.3 Formal Array Type Definition -- | |
1129 ------------------------------------------ | |
1130 | |
1131 -- Parsed by P_Formal_Type_Definition (12.5) | |
1132 | |
1133 ------------------------------------------- | |
1134 -- 12.5.4 Formal Access Type Definition -- | |
1135 ------------------------------------------- | |
1136 | |
1137 -- Parsed by P_Formal_Type_Definition (12.5) | |
1138 | |
1139 ----------------------------------------- | |
1140 -- 12.6 Formal Subprogram Declaration -- | |
1141 ----------------------------------------- | |
1142 | |
1143 -- FORMAL_SUBPROGRAM_DECLARATION ::= | |
1144 -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION | |
1145 -- | FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION | |
1146 | |
1147 -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION ::= | |
1148 -- with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT] | |
1149 -- [ASPECT_SPECIFICATIONS]; | |
1150 | |
1151 -- FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION ::= | |
1152 -- with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT] | |
1153 -- [ASPECT_SPECIFICATIONS]; | |
1154 | |
1155 -- SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <> | |
1156 | |
1157 -- DEFAULT_NAME ::= NAME | null | |
1158 | |
1159 -- The caller has checked that the initial tokens are WITH FUNCTION or | |
1160 -- WITH PROCEDURE, and the initial WITH has been scanned out. | |
1161 | |
1162 -- A null default is an Ada 2005 feature | |
1163 | |
1164 -- Error recovery: cannot raise Error_Resync | |
1165 | |
1166 function P_Formal_Subprogram_Declaration return Node_Id is | |
1167 Prev_Sloc : constant Source_Ptr := Prev_Token_Ptr; | |
1168 Spec_Node : constant Node_Id := P_Subprogram_Specification; | |
1169 Def_Node : Node_Id; | |
1170 | |
1171 begin | |
1172 if Token = Tok_Is then | |
1173 T_Is; -- past IS, skip extra IS or ";" | |
1174 | |
1175 if Token = Tok_Abstract then | |
1176 Def_Node := | |
1177 New_Node (N_Formal_Abstract_Subprogram_Declaration, Prev_Sloc); | |
1178 Scan; -- past ABSTRACT | |
1179 | |
1180 if Ada_Version < Ada_2005 then | |
1181 Error_Msg_SP | |
1182 ("formal abstract subprograms are an Ada 2005 extension"); | |
1183 Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); | |
1184 end if; | |
1185 | |
1186 else | |
1187 Def_Node := | |
1188 New_Node (N_Formal_Concrete_Subprogram_Declaration, Prev_Sloc); | |
1189 end if; | |
1190 | |
1191 Set_Specification (Def_Node, Spec_Node); | |
1192 | |
1193 if Token = Tok_Semicolon then | |
1194 null; | |
1195 | |
1196 elsif Aspect_Specifications_Present then | |
1197 null; | |
1198 | |
1199 elsif Token = Tok_Box then | |
1200 Set_Box_Present (Def_Node, True); | |
1201 Scan; -- past <> | |
1202 | |
1203 elsif Token = Tok_Null then | |
1204 if Ada_Version < Ada_2005 then | |
1205 Error_Msg_SP | |
1206 ("null default subprograms are an Ada 2005 extension"); | |
1207 Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); | |
1208 end if; | |
1209 | |
1210 if Nkind (Spec_Node) = N_Procedure_Specification then | |
1211 Set_Null_Present (Spec_Node); | |
1212 else | |
1213 Error_Msg_SP ("only procedures can be null"); | |
1214 end if; | |
1215 | |
1216 Scan; -- past NULL | |
1217 | |
1218 else | |
1219 Set_Default_Name (Def_Node, P_Name); | |
1220 end if; | |
1221 | |
1222 else | |
1223 Def_Node := | |
1224 New_Node (N_Formal_Concrete_Subprogram_Declaration, Prev_Sloc); | |
1225 Set_Specification (Def_Node, Spec_Node); | |
1226 end if; | |
1227 | |
1228 P_Aspect_Specifications (Def_Node); | |
1229 return Def_Node; | |
1230 end P_Formal_Subprogram_Declaration; | |
1231 | |
1232 ------------------------------ | |
1233 -- 12.6 Subprogram Default -- | |
1234 ------------------------------ | |
1235 | |
1236 -- Parsed by P_Formal_Procedure_Declaration (12.6) | |
1237 | |
1238 ------------------------ | |
1239 -- 12.6 Default Name -- | |
1240 ------------------------ | |
1241 | |
1242 -- Parsed by P_Formal_Procedure_Declaration (12.6) | |
1243 | |
1244 -------------------------------------- | |
1245 -- 12.7 Formal Package Declaration -- | |
1246 -------------------------------------- | |
1247 | |
1248 -- FORMAL_PACKAGE_DECLARATION ::= | |
1249 -- with package DEFINING_IDENTIFIER | |
1250 -- is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART | |
1251 -- [ASPECT_SPECIFICATIONS]; | |
1252 | |
1253 -- FORMAL_PACKAGE_ACTUAL_PART ::= | |
1254 -- ([OTHERS =>] <>) | | |
1255 -- [GENERIC_ACTUAL_PART] | |
1256 -- (FORMAL_PACKAGE_ASSOCIATION {, FORMAL_PACKAGE_ASSOCIATION} | |
1257 -- [, OTHERS => <>) | |
1258 | |
1259 -- FORMAL_PACKAGE_ASSOCIATION ::= | |
1260 -- GENERIC_ASSOCIATION | |
1261 -- | GENERIC_FORMAL_PARAMETER_SELECTOR_NAME => <> | |
1262 | |
1263 -- The caller has checked that the initial tokens are WITH PACKAGE, | |
1264 -- and the initial WITH has been scanned out (so Token = Tok_Package). | |
1265 | |
1266 -- Error recovery: cannot raise Error_Resync | |
1267 | |
1268 function P_Formal_Package_Declaration return Node_Id is | |
1269 Def_Node : Node_Id; | |
1270 Scan_State : Saved_Scan_State; | |
1271 | |
1272 begin | |
1273 Def_Node := New_Node (N_Formal_Package_Declaration, Prev_Token_Ptr); | |
1274 Scan; -- past PACKAGE | |
1275 Set_Defining_Identifier (Def_Node, P_Defining_Identifier (C_Is)); | |
1276 T_Is; | |
1277 T_New; | |
1278 Set_Name (Def_Node, P_Qualified_Simple_Name); | |
1279 | |
1280 if Token = Tok_Left_Paren then | |
1281 Save_Scan_State (Scan_State); -- at the left paren | |
1282 Scan; -- past the left paren | |
1283 | |
1284 if Token = Tok_Box then | |
1285 Set_Box_Present (Def_Node, True); | |
1286 Scan; -- past box | |
1287 T_Right_Paren; | |
1288 | |
1289 else | |
1290 Restore_Scan_State (Scan_State); -- to the left paren | |
1291 Set_Generic_Associations (Def_Node, P_Generic_Actual_Part_Opt); | |
1292 end if; | |
1293 end if; | |
1294 | |
1295 P_Aspect_Specifications (Def_Node); | |
1296 return Def_Node; | |
1297 end P_Formal_Package_Declaration; | |
1298 | |
1299 -------------------------------------- | |
1300 -- 12.7 Formal Package Actual Part -- | |
1301 -------------------------------------- | |
1302 | |
1303 -- Parsed by P_Formal_Package_Declaration (12.7) | |
1304 | |
1305 end Ch12; |