]>
Commit | Line | Data |
---|---|---|
19235870 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- P A R . C H 1 2 -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
1d005acc | 9 | -- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- |
19235870 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
19235870 RK |
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 -- | |
b5c84c3c RD |
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. -- | |
19235870 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
19235870 RK |
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 ::= | |
718deaf1 AC |
64 | -- GENERIC_FORMAL_PART SUBPROGRAM_SPECIFICATION |
65 | -- [ASPECT_SPECIFICATIONS]; | |
19235870 RK |
66 | |
67 | -- GENERIC_PACKAGE_DECLARATION ::= | |
718deaf1 AC |
68 | -- GENERIC_FORMAL_PART PACKAGE_SPECIFICATION |
69 | -- [ASPECT_SPECIFICATIONS]; | |
19235870 RK |
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 | |
cdcf1c7a | 77 | -- [ASPECT_SPECIFICATIONS]; |
19235870 RK |
78 | -- | generic procedure DEFINING_PROGRAM_UNIT_NAME |
79 | -- renames generic_procedure_NAME | |
cdcf1c7a | 80 | -- [ASPECT_SPECIFICATIONS]; |
19235870 RK |
81 | -- | generic function DEFINING_PROGRAM_UNIT_NAME |
82 | -- renames generic_function_NAME | |
cdcf1c7a | 83 | -- [ASPECT_SPECIFICATIONS]; |
19235870 RK |
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 | |
4e7a4f6e AC |
108 | Error_Msg_SC -- CODEFIX |
109 | ("PRIVATE goes before GENERIC, not after"); | |
19235870 RK |
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); | |
cdcf1c7a AC |
146 | |
147 | P_Aspect_Specifications (Decl_Node, Semicolon => False); | |
19235870 RK |
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); | |
a276fddf RD |
163 | |
164 | if Token = Tok_Private then | |
165 | Error_Msg_S ("generic private child packages not permitted"); | |
166 | Scan; -- past PRIVATE | |
167 | end if; | |
19235870 RK |
168 | |
169 | if Token = Tok_Use then | |
851e9f19 | 170 | P_Use_Clause (Decls); |
37368818 | 171 | |
19235870 RK |
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 | |
4e7a4f6e | 191 | Error_Msg_BC -- CODEFIX |
19235870 RK |
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; | |
19235870 RK |
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); | |
1c54829e | 211 | Set_Specification (Gen_Decl, P_Package (Pf_Spcn)); |
718deaf1 | 212 | |
7271429c AC |
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 | ||
19235870 RK |
218 | else |
219 | Gen_Decl := New_Node (N_Generic_Subprogram_Declaration, Gen_Sloc); | |
220 | Set_Specification (Gen_Decl, P_Subprogram_Specification); | |
5453d5bd | 221 | |
cc335f43 AC |
222 | if Nkind (Defining_Unit_Name (Specification (Gen_Decl))) = |
223 | N_Defining_Program_Unit_Name | |
5453d5bd AC |
224 | and then Scope.Last > 0 |
225 | then | |
226 | Error_Msg_SP ("child unit allowed only at library level"); | |
227 | end if; | |
718deaf1 AC |
228 | |
229 | P_Aspect_Specifications (Gen_Decl); | |
19235870 RK |
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 | |
308e6f3a | 291 | -- or if we have aspect specifications present. |
19235870 | 292 | |
718deaf1 | 293 | if Token = Tok_Semicolon or else Aspect_Specifications_Present then |
19235870 RK |
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 | |
0bba838d | 305 | and then Start_Column <= Scopes (Scope.Last).Ecol |
19235870 RK |
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 | ||
885c4871 | 349 | -- Ada 2005: an association can be given by: others => <> |
fd6342ec HK |
350 | |
351 | if Token = Tok_Others then | |
0791fbe9 | 352 | if Ada_Version < Ada_2005 then |
fd6342ec | 353 | Error_Msg_SP |
32bba3c9 AC |
354 | ("partial parameterization of formal packages" |
355 | & " is an Ada 2005 extension"); | |
fd6342ec HK |
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 | |
ed2233dc | 363 | Error_Msg_BC ("expect arrow after others"); |
fd6342ec HK |
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 | ||
f92f17e6 ES |
374 | -- Source position of the others choice is beginning of construct |
375 | ||
376 | return New_Node (N_Others_Choice, Sloc (Generic_Assoc_Node)); | |
fd6342ec HK |
377 | end if; |
378 | ||
19235870 RK |
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 | ||
b11e8d6f | 392 | -- In Ada 2005 the actual can be a box |
fd6342ec HK |
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 | ||
19235870 RK |
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 : | |
718deaf1 AC |
419 | -- MODE [NULL_EXCLUSION] SUBTYPE_MARK [:= DEFAULT_EXPRESSION] |
420 | -- [ASPECT_SPECIFICATIONS]; | |
fd6342ec HK |
421 | -- | DEFINING_IDENTIFIER_LIST : |
422 | -- MODE ACCESS_DEFINITION [:= DEFAULT_EXPRESSION]; | |
718deaf1 | 423 | -- [ASPECT_SPECIFICATIONS]; |
19235870 RK |
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 | |
fd6342ec HK |
430 | Decl_Node : Node_Id; |
431 | Ident : Nat; | |
432 | Not_Null_Present : Boolean := False; | |
433 | Num_Idents : Nat; | |
434 | Scan_State : Saved_Scan_State; | |
19235870 RK |
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 | |
bde58e32 | 442 | Idents (1) := P_Defining_Identifier (C_Comma_Colon); |
19235870 | 443 | Num_Idents := 1; |
19235870 RK |
444 | while Comma_Present loop |
445 | Num_Idents := Num_Idents + 1; | |
bde58e32 | 446 | Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon); |
19235870 RK |
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); | |
fd6342ec HK |
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 | ||
0791fbe9 | 481 | if Ada_Version < Ada_2005 then |
fd6342ec HK |
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 | ||
19235870 | 495 | No_Constraint; |
fd6342ec | 496 | Set_Default_Expression (Decl_Node, Init_Expr_Opt); |
718deaf1 | 497 | P_Aspect_Specifications (Decl_Node); |
19235870 RK |
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; | |
19235870 RK |
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] | |
718deaf1 AC |
521 | -- is FORMAL_TYPE_DEFINITION |
522 | -- [ASPECT_SPECIFICATIONS]; | |
19235870 RK |
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; | |
dd5875a6 | 530 | Def_Node : Node_Id; |
19235870 RK |
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 | ||
d3cb4cc0 AC |
544 | if Token = Tok_Semicolon then |
545 | ||
5d59eef2 | 546 | -- Ada 2012: Incomplete formal type |
d3cb4cc0 AC |
547 | |
548 | Scan; -- past semicolon | |
549 | ||
fb620b37 AC |
550 | Error_Msg_Ada_2012_Feature |
551 | ("formal incomplete type", Sloc (Decl_Node)); | |
d3cb4cc0 AC |
552 | |
553 | Set_Formal_Type_Definition | |
554 | (Decl_Node, | |
164e06c6 | 555 | New_Node (N_Formal_Incomplete_Type_Definition, Token_Ptr)); |
d3cb4cc0 AC |
556 | return Decl_Node; |
557 | ||
558 | else | |
559 | T_Is; | |
560 | end if; | |
19235870 | 561 | |
dd5875a6 ES |
562 | Def_Node := P_Formal_Type_Definition; |
563 | ||
fb620b37 AC |
564 | if Nkind (Def_Node) = N_Formal_Incomplete_Type_Definition then |
565 | Error_Msg_Ada_2012_Feature | |
566 | ("formal incomplete type", Sloc (Decl_Node)); | |
d3cb4cc0 AC |
567 | end if; |
568 | ||
dd5875a6 ES |
569 | if Def_Node /= Error then |
570 | Set_Formal_Type_Definition (Decl_Node, Def_Node); | |
718deaf1 | 571 | P_Aspect_Specifications (Decl_Node); |
de76a39c | 572 | |
dd5875a6 ES |
573 | else |
574 | Decl_Node := Error; | |
f311e166 | 575 | |
718deaf1 AC |
576 | -- If we have aspect specifications, skip them |
577 | ||
578 | if Aspect_Specifications_Present then | |
579 | P_Aspect_Specifications (Error); | |
580 | ||
de76a39c GB |
581 | -- If we have semicolon, skip it to avoid cascaded errors |
582 | ||
718deaf1 AC |
583 | elsif Token = Tok_Semicolon then |
584 | Scan; -- past semicolon | |
f311e166 | 585 | end if; |
dd5875a6 ES |
586 | end if; |
587 | ||
19235870 RK |
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 | |
d3cb4cc0 | 597 | -- | FORMAL_INCOMPLETE_TYPE_DEFINITION |
19235870 RK |
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 | |
a9d8907c | 607 | -- | FORMAL_INTERFACE_TYPE_DEFINITION |
19235870 RK |
608 | |
609 | -- FORMAL_ARRAY_TYPE_DEFINITION ::= ARRAY_TYPE_DEFINITION | |
610 | ||
611 | -- FORMAL_ACCESS_TYPE_DEFINITION ::= ACCESS_TYPE_DEFINITION | |
612 | ||
a9d8907c JM |
613 | -- FORMAL_INTERFACE_TYPE_DEFINITION ::= INTERFACE_TYPE_DEFINITION |
614 | ||
19235870 | 615 | function P_Formal_Type_Definition return Node_Id is |
a9d8907c JM |
616 | Scan_State : Saved_Scan_State; |
617 | Typedef_Node : Node_Id; | |
19235870 RK |
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 | ||
653da906 RD |
635 | -- In addition, in Ada 2005 LIMITED may appear after abstract, so |
636 | -- that the lookahead must be extended by one more token. | |
637 | ||
19235870 RK |
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 | ||
653da906 RD |
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 | ||
fd6342ec HK |
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 | ||
19235870 RK |
664 | else |
665 | Restore_Scan_State (Scan_State); -- to ABSTRACT | |
666 | return P_Formal_Private_Type_Definition; | |
667 | end if; | |
668 | ||
a9d8907c JM |
669 | when Tok_Access => |
670 | return P_Access_Type_Definition; | |
19235870 | 671 | |
a9d8907c JM |
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) | |
dee4682a | 682 | return P_Interface_Type_Definition (Abstract_Present => False); |
19235870 RK |
683 | |
684 | when Tok_Left_Paren => | |
685 | return P_Formal_Discrete_Type_Definition; | |
686 | ||
a9d8907c JM |
687 | when Tok_Limited => |
688 | Save_Scan_State (Scan_State); | |
689 | Scan; -- past LIMITED | |
690 | ||
691 | if Token = Tok_Interface then | |
dee4682a JM |
692 | Typedef_Node := |
693 | P_Interface_Type_Definition (Abstract_Present => False); | |
a9d8907c JM |
694 | Set_Limited_Present (Typedef_Node); |
695 | return Typedef_Node; | |
696 | ||
653da906 RD |
697 | elsif Token = Tok_New then |
698 | Restore_Scan_State (Scan_State); -- to LIMITED | |
699 | return P_Formal_Derived_Type_Definition; | |
700 | ||
a9d8907c | 701 | else |
653da906 | 702 | if Token = Tok_Abstract then |
4e7a4f6e AC |
703 | Error_Msg_SC -- CODEFIX |
704 | ("ABSTRACT must come before LIMITED"); | |
653da906 RD |
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 | ||
a9d8907c JM |
717 | Restore_Scan_State (Scan_State); |
718 | return P_Formal_Private_Type_Definition; | |
719 | end if; | |
19235870 RK |
720 | |
721 | when Tok_Mod => | |
722 | return P_Formal_Modular_Type_Definition; | |
723 | ||
a9d8907c JM |
724 | when Tok_New => |
725 | return P_Formal_Derived_Type_Definition; | |
19235870 | 726 | |
f92f17e6 ES |
727 | when Tok_Not => |
728 | if P_Null_Exclusion then | |
c8307596 | 729 | Typedef_Node := P_Access_Type_Definition; |
f92f17e6 ES |
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 | ||
9fe696a3 | 739 | when Tok_Private => |
a9d8907c | 740 | return P_Formal_Private_Type_Definition; |
19235870 | 741 | |
9fe696a3 | 742 | when Tok_Tagged => |
d3cb4cc0 AC |
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 | ||
a9d8907c JM |
755 | when Tok_Range => |
756 | return P_Formal_Signed_Integer_Type_Definition; | |
19235870 RK |
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 | ||
fd6342ec HK |
763 | -- Ada 2005 (AI-345): Task, Protected or Synchronized interface or |
764 | -- (AI-443): Synchronized formal derived type declaration. | |
a9d8907c | 765 | |
d8f43ee6 HK |
766 | when Tok_Protected |
767 | | Tok_Synchronized | |
768 | | Tok_Task | |
769 | => | |
a9d8907c | 770 | declare |
fd6342ec | 771 | Saved_Token : constant Token_Type := Token; |
a9d8907c JM |
772 | |
773 | begin | |
fd6342ec | 774 | Scan; -- past TASK, PROTECTED or SYNCHRONIZED |
a9d8907c | 775 | |
fd6342ec | 776 | -- Synchronized derived type |
a9d8907c | 777 | |
fd6342ec HK |
778 | if Token = Tok_New then |
779 | Typedef_Node := P_Formal_Derived_Type_Definition; | |
a9d8907c | 780 | |
fd6342ec | 781 | if Saved_Token = Tok_Synchronized then |
a9d8907c | 782 | Set_Synchronized_Present (Typedef_Node); |
fd6342ec HK |
783 | else |
784 | Error_Msg_SC ("invalid kind of formal derived type"); | |
785 | end if; | |
a9d8907c | 786 | |
fd6342ec HK |
787 | -- Interface |
788 | ||
789 | else | |
dee4682a JM |
790 | Typedef_Node := |
791 | P_Interface_Type_Definition (Abstract_Present => False); | |
fd6342ec HK |
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; | |
a9d8907c JM |
807 | |
808 | return Typedef_Node; | |
809 | end; | |
810 | ||
19235870 RK |
811 | when others => |
812 | Error_Msg_BC ("expecting generic type definition here"); | |
813 | Resync_Past_Semicolon; | |
814 | return Error; | |
19235870 RK |
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 | ||
653da906 RD |
861 | if Token = Tok_Abstract then |
862 | if Prev_Token = Tok_Tagged then | |
4e7a4f6e AC |
863 | Error_Msg_SC -- CODEFIX |
864 | ("ABSTRACT must come before TAGGED"); | |
653da906 | 865 | elsif Prev_Token = Tok_Limited then |
4e7a4f6e AC |
866 | Error_Msg_SC -- CODEFIX |
867 | ("ABSTRACT must come before LIMITED"); | |
653da906 RD |
868 | end if; |
869 | ||
870 | Resync_Past_Semicolon; | |
871 | ||
872 | elsif Token = Tok_Tagged then | |
4e7a4f6e AC |
873 | Error_Msg_SC -- CODEFIX |
874 | ("TAGGED must come before LIMITED"); | |
653da906 RD |
875 | Resync_Past_Semicolon; |
876 | end if; | |
877 | ||
19235870 RK |
878 | Set_Sloc (Def_Node, Token_Ptr); |
879 | T_Private; | |
92cbddaa AC |
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 | ||
19235870 RK |
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 ::= | |
fd6342ec HK |
902 | -- [abstract] [limited | synchronized] |
903 | -- new SUBTYPE_MARK [[and INTERFACE_LIST] with private] | |
19235870 | 904 | |
dec55d76 | 905 | -- The caller has checked the initial token(s) is/are NEW, ABSTRACT NEW, |
fd6342ec HK |
906 | -- or LIMITED NEW, ABSTRACT LIMITED NEW, SYNCHRONIZED NEW or ABSTRACT |
907 | -- SYNCHRONIZED NEW. | |
19235870 RK |
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 | ||
653da906 RD |
922 | if Token = Tok_Limited then |
923 | Set_Limited_Present (Def_Node); | |
fd6342ec | 924 | Scan; -- past LIMITED |
653da906 | 925 | |
0791fbe9 | 926 | if Ada_Version < Ada_2005 then |
653da906 RD |
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 | ||
fd6342ec HK |
933 | elsif Token = Tok_Synchronized then |
934 | Set_Synchronized_Present (Def_Node); | |
935 | Scan; -- past SYNCHRONIZED | |
936 | ||
0791fbe9 | 937 | if Ada_Version < Ada_2005 then |
fd6342ec HK |
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"); | |
653da906 RD |
942 | end if; |
943 | end if; | |
944 | ||
fd6342ec HK |
945 | if Token = Tok_Abstract then |
946 | Scan; -- past ABSTRACT, diagnosed already in caller. | |
947 | end if; | |
948 | ||
19235870 RK |
949 | Scan; -- past NEW; |
950 | Set_Subtype_Mark (Def_Node, P_Subtype_Mark); | |
951 | No_Constraint; | |
952 | ||
a9d8907c JM |
953 | -- Ada 2005 (AI-251): Deal with interfaces |
954 | ||
955 | if Token = Tok_And then | |
956 | Scan; -- past AND | |
957 | ||
0791fbe9 | 958 | if Ada_Version < Ada_2005 then |
a9d8907c JM |
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 | ||
19235870 | 973 | if Token = Tok_With then |
64c6e367 ES |
974 | |
975 | if Ada_Version >= Ada_2020 and Token /= Tok_Private then | |
976 | -- Formal type has aspect specifications, parsed later. | |
977 | return Def_Node; | |
978 | ||
979 | else | |
980 | Scan; -- past WITH | |
981 | Set_Private_Present (Def_Node, True); | |
982 | T_Private; | |
983 | end if; | |
dd5875a6 ES |
984 | |
985 | elsif Token = Tok_Tagged then | |
986 | Scan; | |
987 | ||
988 | if Token = Tok_Private then | |
ed2233dc AC |
989 | Error_Msg_SC -- CODEFIX |
990 | ("TAGGED should be WITH"); | |
dd5875a6 ES |
991 | Set_Private_Present (Def_Node, True); |
992 | T_Private; | |
993 | else | |
994 | Ignore (Tok_Tagged); | |
995 | end if; | |
19235870 RK |
996 | end if; |
997 | ||
998 | return Def_Node; | |
999 | end P_Formal_Derived_Type_Definition; | |
1000 | ||
1001 | --------------------------------------------- | |
1002 | -- 12.5.2 Formal Discrete Type Definition -- | |
1003 | --------------------------------------------- | |
1004 | ||
1005 | -- FORMAL_DISCRETE_TYPE_DEFINITION ::= (<>) | |
1006 | ||
1007 | -- The caller has checked the initial token is left paren | |
1008 | ||
1009 | -- Error recovery: cannot raise Error_Resync | |
1010 | ||
1011 | function P_Formal_Discrete_Type_Definition return Node_Id is | |
1012 | Def_Node : Node_Id; | |
1013 | ||
1014 | begin | |
1015 | Def_Node := New_Node (N_Formal_Discrete_Type_Definition, Token_Ptr); | |
1016 | Scan; -- past left paren | |
1017 | T_Box; | |
1018 | T_Right_Paren; | |
1019 | return Def_Node; | |
1020 | end P_Formal_Discrete_Type_Definition; | |
1021 | ||
1022 | --------------------------------------------------- | |
1023 | -- 12.5.2 Formal Signed Integer Type Definition -- | |
1024 | --------------------------------------------------- | |
1025 | ||
1026 | -- FORMAL_SIGNED_INTEGER_TYPE_DEFINITION ::= range <> | |
1027 | ||
1028 | -- The caller has checked the initial token is RANGE | |
1029 | ||
1030 | -- Error recovery: cannot raise Error_Resync | |
1031 | ||
1032 | function P_Formal_Signed_Integer_Type_Definition return Node_Id is | |
1033 | Def_Node : Node_Id; | |
1034 | ||
1035 | begin | |
1036 | Def_Node := | |
1037 | New_Node (N_Formal_Signed_Integer_Type_Definition, Token_Ptr); | |
1038 | Scan; -- past RANGE | |
1039 | T_Box; | |
1040 | return Def_Node; | |
1041 | end P_Formal_Signed_Integer_Type_Definition; | |
1042 | ||
1043 | -------------------------------------------- | |
1044 | -- 12.5.2 Formal Modular Type Definition -- | |
1045 | -------------------------------------------- | |
1046 | ||
1047 | -- FORMAL_MODULAR_TYPE_DEFINITION ::= mod <> | |
1048 | ||
1049 | -- The caller has checked the initial token is MOD | |
1050 | ||
1051 | -- Error recovery: cannot raise Error_Resync | |
1052 | ||
1053 | function P_Formal_Modular_Type_Definition return Node_Id is | |
1054 | Def_Node : Node_Id; | |
1055 | ||
1056 | begin | |
1057 | Def_Node := | |
1058 | New_Node (N_Formal_Modular_Type_Definition, Token_Ptr); | |
1059 | Scan; -- past MOD | |
1060 | T_Box; | |
1061 | return Def_Node; | |
1062 | end P_Formal_Modular_Type_Definition; | |
1063 | ||
1064 | ---------------------------------------------- | |
1065 | -- 12.5.2 Formal Floating Point Definition -- | |
1066 | ---------------------------------------------- | |
1067 | ||
1068 | -- FORMAL_FLOATING_POINT_DEFINITION ::= digits <> | |
1069 | ||
1070 | -- The caller has checked the initial token is DIGITS | |
1071 | ||
1072 | -- Error recovery: cannot raise Error_Resync | |
1073 | ||
1074 | function P_Formal_Floating_Point_Definition return Node_Id is | |
1075 | Def_Node : Node_Id; | |
1076 | ||
1077 | begin | |
1078 | Def_Node := | |
1079 | New_Node (N_Formal_Floating_Point_Definition, Token_Ptr); | |
1080 | Scan; -- past DIGITS | |
1081 | T_Box; | |
1082 | return Def_Node; | |
1083 | end P_Formal_Floating_Point_Definition; | |
1084 | ||
1085 | ------------------------------------------- | |
1086 | -- 12.5.2 Formal Fixed Point Definition -- | |
1087 | ------------------------------------------- | |
1088 | ||
1089 | -- This routine parses either a formal ordinary fixed point definition | |
1090 | -- or a formal decimal fixed point definition: | |
1091 | ||
1092 | -- FORMAL_ORDINARY_FIXED_POINT_DEFINITION ::= delta <> | |
1093 | ||
1094 | -- FORMAL_DECIMAL_FIXED_POINT_DEFINITION ::= delta <> digits <> | |
1095 | ||
1096 | -- The caller has checked the initial token is DELTA | |
1097 | ||
1098 | -- Error recovery: cannot raise Error_Resync | |
1099 | ||
1100 | function P_Formal_Fixed_Point_Definition return Node_Id is | |
1101 | Def_Node : Node_Id; | |
1102 | Delta_Sloc : Source_Ptr; | |
1103 | ||
1104 | begin | |
1105 | Delta_Sloc := Token_Ptr; | |
1106 | Scan; -- past DELTA | |
1107 | T_Box; | |
1108 | ||
1109 | if Token = Tok_Digits then | |
1110 | Def_Node := | |
1111 | New_Node (N_Formal_Decimal_Fixed_Point_Definition, Delta_Sloc); | |
1112 | Scan; -- past DIGITS | |
1113 | T_Box; | |
1114 | else | |
1115 | Def_Node := | |
1116 | New_Node (N_Formal_Ordinary_Fixed_Point_Definition, Delta_Sloc); | |
1117 | end if; | |
1118 | ||
1119 | return Def_Node; | |
1120 | end P_Formal_Fixed_Point_Definition; | |
1121 | ||
1122 | ---------------------------------------------------- | |
1123 | -- 12.5.2 Formal Ordinary Fixed Point Definition -- | |
1124 | ---------------------------------------------------- | |
1125 | ||
1126 | -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2) | |
1127 | ||
1128 | --------------------------------------------------- | |
1129 | -- 12.5.2 Formal Decimal Fixed Point Definition -- | |
1130 | --------------------------------------------------- | |
1131 | ||
1132 | -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2) | |
1133 | ||
1134 | ------------------------------------------ | |
1135 | -- 12.5.3 Formal Array Type Definition -- | |
1136 | ------------------------------------------ | |
1137 | ||
1138 | -- Parsed by P_Formal_Type_Definition (12.5) | |
1139 | ||
1140 | ------------------------------------------- | |
1141 | -- 12.5.4 Formal Access Type Definition -- | |
1142 | ------------------------------------------- | |
1143 | ||
1144 | -- Parsed by P_Formal_Type_Definition (12.5) | |
1145 | ||
1146 | ----------------------------------------- | |
1147 | -- 12.6 Formal Subprogram Declaration -- | |
1148 | ----------------------------------------- | |
1149 | ||
1150 | -- FORMAL_SUBPROGRAM_DECLARATION ::= | |
82c80734 RD |
1151 | -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION |
1152 | -- | FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION | |
1153 | ||
1154 | -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION ::= | |
718deaf1 AC |
1155 | -- with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT] |
1156 | -- [ASPECT_SPECIFICATIONS]; | |
19235870 | 1157 | |
82c80734 | 1158 | -- FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION ::= |
718deaf1 AC |
1159 | -- with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT] |
1160 | -- [ASPECT_SPECIFICATIONS]; | |
82c80734 | 1161 | |
19235870 RK |
1162 | -- SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <> |
1163 | ||
edd63e9b | 1164 | -- DEFAULT_NAME ::= NAME | null |
19235870 RK |
1165 | |
1166 | -- The caller has checked that the initial tokens are WITH FUNCTION or | |
1167 | -- WITH PROCEDURE, and the initial WITH has been scanned out. | |
1168 | ||
9de61fcb | 1169 | -- A null default is an Ada 2005 feature |
edd63e9b | 1170 | |
19235870 RK |
1171 | -- Error recovery: cannot raise Error_Resync |
1172 | ||
1173 | function P_Formal_Subprogram_Declaration return Node_Id is | |
82c80734 RD |
1174 | Prev_Sloc : constant Source_Ptr := Prev_Token_Ptr; |
1175 | Spec_Node : constant Node_Id := P_Subprogram_Specification; | |
1176 | Def_Node : Node_Id; | |
19235870 RK |
1177 | |
1178 | begin | |
19235870 RK |
1179 | if Token = Tok_Is then |
1180 | T_Is; -- past IS, skip extra IS or ";" | |
1181 | ||
82c80734 RD |
1182 | if Token = Tok_Abstract then |
1183 | Def_Node := | |
1184 | New_Node (N_Formal_Abstract_Subprogram_Declaration, Prev_Sloc); | |
1185 | Scan; -- past ABSTRACT | |
1186 | ||
0791fbe9 | 1187 | if Ada_Version < Ada_2005 then |
82c80734 RD |
1188 | Error_Msg_SP |
1189 | ("formal abstract subprograms are an Ada 2005 extension"); | |
1190 | Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); | |
1191 | end if; | |
1192 | ||
1193 | else | |
1194 | Def_Node := | |
1195 | New_Node (N_Formal_Concrete_Subprogram_Declaration, Prev_Sloc); | |
1196 | end if; | |
1197 | ||
1198 | Set_Specification (Def_Node, Spec_Node); | |
1199 | ||
1200 | if Token = Tok_Semicolon then | |
718deaf1 AC |
1201 | null; |
1202 | ||
1203 | elsif Aspect_Specifications_Present then | |
1204 | null; | |
82c80734 RD |
1205 | |
1206 | elsif Token = Tok_Box then | |
19235870 RK |
1207 | Set_Box_Present (Def_Node, True); |
1208 | Scan; -- past <> | |
1209 | ||
edd63e9b | 1210 | elsif Token = Tok_Null then |
0791fbe9 | 1211 | if Ada_Version < Ada_2005 then |
edd63e9b ES |
1212 | Error_Msg_SP |
1213 | ("null default subprograms are an Ada 2005 extension"); | |
1214 | Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); | |
1215 | end if; | |
1216 | ||
1217 | if Nkind (Spec_Node) = N_Procedure_Specification then | |
1218 | Set_Null_Present (Spec_Node); | |
1219 | else | |
1220 | Error_Msg_SP ("only procedures can be null"); | |
1221 | end if; | |
1222 | ||
1223 | Scan; -- past NULL | |
edd63e9b | 1224 | |
19235870 RK |
1225 | else |
1226 | Set_Default_Name (Def_Node, P_Name); | |
1227 | end if; | |
1228 | ||
82c80734 RD |
1229 | else |
1230 | Def_Node := | |
1231 | New_Node (N_Formal_Concrete_Subprogram_Declaration, Prev_Sloc); | |
1232 | Set_Specification (Def_Node, Spec_Node); | |
19235870 RK |
1233 | end if; |
1234 | ||
718deaf1 | 1235 | P_Aspect_Specifications (Def_Node); |
19235870 RK |
1236 | return Def_Node; |
1237 | end P_Formal_Subprogram_Declaration; | |
1238 | ||
1239 | ------------------------------ | |
1240 | -- 12.6 Subprogram Default -- | |
1241 | ------------------------------ | |
1242 | ||
1243 | -- Parsed by P_Formal_Procedure_Declaration (12.6) | |
1244 | ||
1245 | ------------------------ | |
1246 | -- 12.6 Default Name -- | |
1247 | ------------------------ | |
1248 | ||
1249 | -- Parsed by P_Formal_Procedure_Declaration (12.6) | |
1250 | ||
1251 | -------------------------------------- | |
1252 | -- 12.7 Formal Package Declaration -- | |
1253 | -------------------------------------- | |
1254 | ||
1255 | -- FORMAL_PACKAGE_DECLARATION ::= | |
1256 | -- with package DEFINING_IDENTIFIER | |
718deaf1 AC |
1257 | -- is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART |
1258 | -- [ASPECT_SPECIFICATIONS]; | |
19235870 RK |
1259 | |
1260 | -- FORMAL_PACKAGE_ACTUAL_PART ::= | |
fd6342ec HK |
1261 | -- ([OTHERS =>] <>) | |
1262 | -- [GENERIC_ACTUAL_PART] | |
1263 | -- (FORMAL_PACKAGE_ASSOCIATION {, FORMAL_PACKAGE_ASSOCIATION} | |
1264 | -- [, OTHERS => <>) | |
1265 | ||
1266 | -- FORMAL_PACKAGE_ASSOCIATION ::= | |
1267 | -- GENERIC_ASSOCIATION | |
1268 | -- | GENERIC_FORMAL_PARAMETER_SELECTOR_NAME => <> | |
19235870 RK |
1269 | |
1270 | -- The caller has checked that the initial tokens are WITH PACKAGE, | |
1271 | -- and the initial WITH has been scanned out (so Token = Tok_Package). | |
1272 | ||
1273 | -- Error recovery: cannot raise Error_Resync | |
1274 | ||
1275 | function P_Formal_Package_Declaration return Node_Id is | |
1276 | Def_Node : Node_Id; | |
1277 | Scan_State : Saved_Scan_State; | |
1278 | ||
1279 | begin | |
1280 | Def_Node := New_Node (N_Formal_Package_Declaration, Prev_Token_Ptr); | |
1281 | Scan; -- past PACKAGE | |
bde58e32 | 1282 | Set_Defining_Identifier (Def_Node, P_Defining_Identifier (C_Is)); |
19235870 RK |
1283 | T_Is; |
1284 | T_New; | |
1285 | Set_Name (Def_Node, P_Qualified_Simple_Name); | |
1286 | ||
1287 | if Token = Tok_Left_Paren then | |
1288 | Save_Scan_State (Scan_State); -- at the left paren | |
1289 | Scan; -- past the left paren | |
1290 | ||
1291 | if Token = Tok_Box then | |
1292 | Set_Box_Present (Def_Node, True); | |
1293 | Scan; -- past box | |
1294 | T_Right_Paren; | |
1295 | ||
1296 | else | |
1297 | Restore_Scan_State (Scan_State); -- to the left paren | |
1298 | Set_Generic_Associations (Def_Node, P_Generic_Actual_Part_Opt); | |
1299 | end if; | |
1300 | end if; | |
1301 | ||
718deaf1 | 1302 | P_Aspect_Specifications (Def_Node); |
19235870 RK |
1303 | return Def_Node; |
1304 | end P_Formal_Package_Declaration; | |
1305 | ||
1306 | -------------------------------------- | |
1307 | -- 12.7 Formal Package Actual Part -- | |
1308 | -------------------------------------- | |
1309 | ||
1310 | -- Parsed by P_Formal_Package_Declaration (12.7) | |
1311 | ||
1312 | end Ch12; |