|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- P A R . C H 1 2 --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
11 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
12 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
|
17 -- for more details. You should have received a copy of the GNU General --
|
|
|
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
|
|
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 pragma Style_Checks (All_Checks);
|
|
|
27 -- Turn off subprogram body ordering check. Subprograms are in order
|
|
|
28 -- by RM section rather than alphabetical
|
|
|
29
|
|
|
30 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
|
|
145
|
305 and then Start_Column <= Scopes (Scope.Last).Ecol
|
|
111
|
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
|
|
145
|
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;
|
|
111
|
984
|
|
|
985 elsif Token = Tok_Tagged then
|
|
|
986 Scan;
|
|
|
987
|
|
|
988 if Token = Tok_Private then
|
|
|
989 Error_Msg_SC -- CODEFIX
|
|
|
990 ("TAGGED should be WITH");
|
|
|
991 Set_Private_Present (Def_Node, True);
|
|
|
992 T_Private;
|
|
|
993 else
|
|
|
994 Ignore (Tok_Tagged);
|
|
|
995 end if;
|
|
|
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 ::=
|
|
|
1151 -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION
|
|
|
1152 -- | FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION
|
|
|
1153
|
|
|
1154 -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION ::=
|
|
|
1155 -- with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT]
|
|
|
1156 -- [ASPECT_SPECIFICATIONS];
|
|
|
1157
|
|
|
1158 -- FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION ::=
|
|
|
1159 -- with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT]
|
|
|
1160 -- [ASPECT_SPECIFICATIONS];
|
|
|
1161
|
|
|
1162 -- SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <>
|
|
|
1163
|
|
|
1164 -- DEFAULT_NAME ::= NAME | null
|
|
|
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
|
|
|
1169 -- A null default is an Ada 2005 feature
|
|
|
1170
|
|
|
1171 -- Error recovery: cannot raise Error_Resync
|
|
|
1172
|
|
|
1173 function P_Formal_Subprogram_Declaration return Node_Id is
|
|
|
1174 Prev_Sloc : constant Source_Ptr := Prev_Token_Ptr;
|
|
|
1175 Spec_Node : constant Node_Id := P_Subprogram_Specification;
|
|
|
1176 Def_Node : Node_Id;
|
|
|
1177
|
|
|
1178 begin
|
|
|
1179 if Token = Tok_Is then
|
|
|
1180 T_Is; -- past IS, skip extra IS or ";"
|
|
|
1181
|
|
|
1182 if Token = Tok_Abstract then
|
|
|
1183 Def_Node :=
|
|
|
1184 New_Node (N_Formal_Abstract_Subprogram_Declaration, Prev_Sloc);
|
|
|
1185 Scan; -- past ABSTRACT
|
|
|
1186
|
|
|
1187 if Ada_Version < Ada_2005 then
|
|
|
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
|
|
|
1201 null;
|
|
|
1202
|
|
|
1203 elsif Aspect_Specifications_Present then
|
|
|
1204 null;
|
|
|
1205
|
|
|
1206 elsif Token = Tok_Box then
|
|
|
1207 Set_Box_Present (Def_Node, True);
|
|
|
1208 Scan; -- past <>
|
|
|
1209
|
|
|
1210 elsif Token = Tok_Null then
|
|
|
1211 if Ada_Version < Ada_2005 then
|
|
|
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
|
|
|
1224
|
|
|
1225 else
|
|
|
1226 Set_Default_Name (Def_Node, P_Name);
|
|
|
1227 end if;
|
|
|
1228
|
|
|
1229 else
|
|
|
1230 Def_Node :=
|
|
|
1231 New_Node (N_Formal_Concrete_Subprogram_Declaration, Prev_Sloc);
|
|
|
1232 Set_Specification (Def_Node, Spec_Node);
|
|
|
1233 end if;
|
|
|
1234
|
|
|
1235 P_Aspect_Specifications (Def_Node);
|
|
|
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
|
|
|
1257 -- is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART
|
|
|
1258 -- [ASPECT_SPECIFICATIONS];
|
|
|
1259
|
|
|
1260 -- FORMAL_PACKAGE_ACTUAL_PART ::=
|
|
|
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 => <>
|
|
|
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
|
|
|
1282 Set_Defining_Identifier (Def_Node, P_Defining_Identifier (C_Is));
|
|
|
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
|
|
|
1302 P_Aspect_Specifications (Def_Node);
|
|
|
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;
|
