1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 pragma Style_Checks
(All_Checks
);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
33 -- Local functions, used only in this chapter
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
;
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.
53 --------------------------------
54 -- 12.1 Generic (also 8.5.5) --
55 --------------------------------
57 -- This routine parses either one of the forms of a generic declaration
58 -- or a generic renaming declaration.
60 -- GENERIC_DECLARATION ::=
61 -- GENERIC_SUBPROGRAM_DECLARATION | GENERIC_PACKAGE_DECLARATION
63 -- GENERIC_SUBPROGRAM_DECLARATION ::=
64 -- GENERIC_FORMAL_PART SUBPROGRAM_SPECIFICATION
65 -- [ASPECT_SPECIFICATIONS];
67 -- GENERIC_PACKAGE_DECLARATION ::=
68 -- GENERIC_FORMAL_PART PACKAGE_SPECIFICATION
69 -- [ASPECT_SPECIFICATIONS];
71 -- GENERIC_FORMAL_PART ::=
72 -- generic {GENERIC_FORMAL_PARAMETER_DECLARATION | USE_CLAUSE}
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];
85 -- GENERIC_FORMAL_PARAMETER_DECLARATION ::=
86 -- FORMAL_OBJECT_DECLARATION
87 -- | FORMAL_TYPE_DECLARATION
88 -- | FORMAL_SUBPROGRAM_DECLARATION
89 -- | FORMAL_PACKAGE_DECLARATION
91 -- The caller has checked that the initial token is GENERIC
93 -- Error recovery: can raise Error_Resync
95 function P_Generic
return Node_Id
is
96 Gen_Sloc
: constant Source_Ptr
:= Token_Ptr
;
101 Ren_Token
: Token_Type
;
102 Scan_State
: Saved_Scan_State
;
105 Scan
; -- past GENERIC
107 if Token
= Tok_Private
then
108 Error_Msg_SC
-- CODEFIX
109 ("PRIVATE goes before GENERIC, not after");
110 Scan
; -- past junk PRIVATE token
113 Save_Scan_State
(Scan_State
); -- at token past GENERIC
115 -- Check for generic renaming declaration case
117 if Token
= Tok_Package
118 or else Token
= Tok_Function
119 or else Token
= Tok_Procedure
122 Scan
; -- scan past PACKAGE, FUNCTION or PROCEDURE
124 if Token
= Tok_Identifier
then
125 Def_Unit
:= P_Defining_Program_Unit_Name
;
127 Check_Misspelling_Of
(Tok_Renames
);
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
);
134 elsif Ren_Token
= Tok_Procedure
then
135 Decl_Node
:= New_Node
136 (N_Generic_Procedure_Renaming_Declaration
, Gen_Sloc
);
138 else -- Ren_Token = Tok_Function then
139 Decl_Node
:= New_Node
140 (N_Generic_Function_Renaming_Declaration
, Gen_Sloc
);
143 Scan
; -- past RENAMES
144 Set_Defining_Unit_Name
(Decl_Node
, Def_Unit
);
145 Set_Name
(Decl_Node
, P_Name
);
147 P_Aspect_Specifications
(Decl_Node
, Semicolon
=> False);
154 -- Fall through if this is *not* a generic renaming declaration
156 Restore_Scan_State
(Scan_State
);
159 -- Loop through generic parameter declarations and use clauses
162 P_Pragmas_Opt
(Decls
);
164 if Token
= Tok_Private
then
165 Error_Msg_S
("generic private child packages not permitted");
166 Scan
; -- past PRIVATE
169 if Token
= Tok_Use
then
170 P_Use_Clause
(Decls
);
173 -- Parse a generic parameter declaration
175 if Token
= Tok_Identifier
then
176 P_Formal_Object_Declarations
(Decls
);
178 elsif Token
= Tok_Type
then
179 Append
(P_Formal_Type_Declaration
, Decls
);
181 elsif Token
= Tok_With
then
184 if Token
= Tok_Package
then
185 Append
(P_Formal_Package_Declaration
, Decls
);
187 elsif Token
= Tok_Procedure
or Token
= Tok_Function
then
188 Append
(P_Formal_Subprogram_Declaration
, Decls
);
191 Error_Msg_BC
-- CODEFIX
192 ("FUNCTION, PROCEDURE or PACKAGE expected here");
193 Resync_Past_Semicolon
;
196 elsif Token
= Tok_Subtype
then
197 Error_Msg_SC
("subtype declaration not allowed " &
198 "as generic parameter declaration!");
199 Resync_Past_Semicolon
;
207 -- Generic formal part is scanned, scan out subprogram or package spec
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
));
213 -- Aspects have been parsed by the package spec. Move them to the
214 -- generic declaration where they belong.
216 Move_Aspects
(Specification
(Gen_Decl
), Gen_Decl
);
219 Gen_Decl
:= New_Node
(N_Generic_Subprogram_Declaration
, Gen_Sloc
);
220 Set_Specification
(Gen_Decl
, P_Subprogram_Specification
);
222 if Nkind
(Defining_Unit_Name
(Specification
(Gen_Decl
))) =
223 N_Defining_Program_Unit_Name
224 and then Scope
.Last
> 0
226 Error_Msg_SP
("child unit allowed only at library level");
229 P_Aspect_Specifications
(Gen_Decl
);
232 Set_Generic_Formal_Declarations
(Gen_Decl
, Decls
);
236 -------------------------------
237 -- 12.1 Generic Declaration --
238 -------------------------------
240 -- Parsed by P_Generic (12.1)
242 ------------------------------------------
243 -- 12.1 Generic Subprogram Declaration --
244 ------------------------------------------
246 -- Parsed by P_Generic (12.1)
248 ---------------------------------------
249 -- 12.1 Generic Package Declaration --
250 ---------------------------------------
252 -- Parsed by P_Generic (12.1)
254 -------------------------------
255 -- 12.1 Generic Formal Part --
256 -------------------------------
258 -- Parsed by P_Generic (12.1)
260 -------------------------------------------------
261 -- 12.1 Generic Formal Parameter Declaration --
262 -------------------------------------------------
264 -- Parsed by P_Generic (12.1)
266 ---------------------------------
267 -- 12.3 Generic Instantiation --
268 ---------------------------------
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)
274 -------------------------------
275 -- 12.3 Generic Actual Part --
276 -------------------------------
278 -- GENERIC_ACTUAL_PART ::=
279 -- (GENERIC_ASSOCIATION {, GENERIC_ASSOCIATION})
281 -- Returns a list of generic associations, or Empty if none are present
283 -- Error recovery: cannot raise Error_Resync
285 function P_Generic_Actual_Part_Opt
return List_Id
is
286 Association_List
: List_Id
;
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.
293 if Token
= Tok_Semicolon
or else Aspect_Specifications_Present
then
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
303 elsif Token
/= Tok_Left_Paren
304 and then Token_Is_At_Start_Of_Line
305 and then Start_Column
<= Scopes
(Scope
.Last
).Ecol
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)
313 Association_List
:= New_List
;
317 Append
(P_Generic_Association
, Association_List
);
318 exit when not Comma_Present
;
322 return Association_List
;
325 end P_Generic_Actual_Part_Opt
;
327 -------------------------------
328 -- 12.3 Generic Association --
329 -------------------------------
331 -- GENERIC_ASSOCIATION ::=
332 -- [generic_formal_parameter_SELECTOR_NAME =>]
333 -- EXPLICIT_GENERIC_ACTUAL_PARAMETER
335 -- EXPLICIT_GENERIC_ACTUAL_PARAMETER ::=
336 -- EXPRESSION | variable_NAME | subprogram_NAME
337 -- | entry_NAME | SUBTYPE_MARK | package_instance_NAME
339 -- Error recovery: cannot raise Error_Resync
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
;
347 Generic_Assoc_Node
:= New_Node
(N_Generic_Association
, Token_Ptr
);
349 -- Ada 2005: an association can be given by: others => <>
351 if Token
= Tok_Others
then
352 Error_Msg_Ada_2005_Extension
353 ("partial parameterization of formal package");
357 if Token
/= Tok_Arrow
then
358 Error_Msg_BC
("expect `='>` after OTHERS");
363 if Token
/= Tok_Box
then
364 Error_Msg_BC
("expect `'<'>` after `='>`");
369 -- Source position of the others choice is beginning of construct
371 return New_Node
(N_Others_Choice
, Sloc
(Generic_Assoc_Node
));
374 if Token
in Token_Class_Desig
then
375 Param_Name_Node
:= Token_Node
;
376 Save_Scan_State
(Scan_State
); -- at designator
377 Scan
; -- past simple name or operator symbol
379 if Token
= Tok_Arrow
then
381 Set_Selector_Name
(Generic_Assoc_Node
, Param_Name_Node
);
383 Restore_Scan_State
(Scan_State
); -- to designator
387 -- In Ada 2005 the actual can be a box
389 if Token
= Tok_Box
then
391 Set_Box_Present
(Generic_Assoc_Node
);
392 Set_Explicit_Generic_Actual_Parameter
(Generic_Assoc_Node
, Empty
);
395 Set_Explicit_Generic_Actual_Parameter
396 (Generic_Assoc_Node
, P_Expression
);
399 return Generic_Assoc_Node
;
400 end P_Generic_Association
;
402 ---------------------------------------------
403 -- 12.3 Explicit Generic Actual Parameter --
404 ---------------------------------------------
406 -- Parsed by P_Generic_Association (12.3)
408 --------------------------------------
409 -- 12.4 Formal Object Declarations --
410 --------------------------------------
412 -- FORMAL_OBJECT_DECLARATION ::=
413 -- DEFINING_IDENTIFIER_LIST :
414 -- MODE [NULL_EXCLUSION] SUBTYPE_MARK [:= DEFAULT_EXPRESSION]
415 -- [ASPECT_SPECIFICATIONS];
416 -- | DEFINING_IDENTIFIER_LIST :
417 -- MODE ACCESS_DEFINITION [:= DEFAULT_EXPRESSION];
418 -- [ASPECT_SPECIFICATIONS];
420 -- The caller has checked that the initial token is an identifier
422 -- Error recovery: cannot raise Error_Resync
424 procedure P_Formal_Object_Declarations
(Decls
: List_Id
) is
427 Not_Null_Present
: Boolean := False;
429 Scan_State
: Saved_Scan_State
;
431 Idents
: array (Pos
range 1 .. 4096) of Entity_Id
;
432 -- This array holds the list of defining identifiers. The upper bound
433 -- of 4096 is intended to be essentially infinite, and we do not even
434 -- bother to check for it being exceeded.
437 Idents
(1) := P_Defining_Identifier
(C_Comma_Colon
);
439 while Comma_Present
loop
440 Num_Idents
:= Num_Idents
+ 1;
441 Idents
(Num_Idents
) := P_Defining_Identifier
(C_Comma_Colon
);
446 -- If there are multiple identifiers, we repeatedly scan the
447 -- type and initialization expression information by resetting
448 -- the scan pointer (so that we get completely separate trees
449 -- for each occurrence).
451 if Num_Idents
> 1 then
452 Save_Scan_State
(Scan_State
);
455 -- Loop through defining identifiers in list
459 Decl_Node
:= New_Node
(N_Formal_Object_Declaration
, Token_Ptr
);
460 Set_Defining_Identifier
(Decl_Node
, Idents
(Ident
));
463 Not_Null_Present
:= P_Null_Exclusion
; -- Ada 2005 (AI-423)
465 -- Ada 2005 (AI-423): Formal object with an access definition
467 if Token
= Tok_Access
then
469 -- The access definition is still parsed and set even though
470 -- the compilation may not use the proper switch. This action
471 -- ensures the required local error recovery.
473 Set_Access_Definition
(Decl_Node
,
474 P_Access_Definition
(Not_Null_Present
));
476 Error_Msg_Ada_2005_Extension
477 ("access definition in formal object declaration");
479 -- Formal object with a subtype mark
482 Set_Null_Exclusion_Present
(Decl_Node
, Not_Null_Present
);
483 Set_Subtype_Mark
(Decl_Node
, P_Subtype_Mark_Resync
);
487 Set_Default_Expression
(Decl_Node
, Init_Expr_Opt
);
488 P_Aspect_Specifications
(Decl_Node
);
491 Set_Prev_Ids
(Decl_Node
, True);
494 if Ident
< Num_Idents
then
495 Set_More_Ids
(Decl_Node
, True);
498 Append
(Decl_Node
, Decls
);
500 exit Ident_Loop
when Ident
= Num_Idents
;
502 Restore_Scan_State
(Scan_State
);
504 end P_Formal_Object_Declarations
;
506 -----------------------------------
507 -- 12.5 Formal Type Declaration --
508 -----------------------------------
510 -- FORMAL_TYPE_DECLARATION ::=
511 -- type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
512 -- is FORMAL_TYPE_DEFINITION
513 -- [ASPECT_SPECIFICATIONS];
515 -- The caller has checked that the initial token is TYPE
517 -- Error recovery: cannot raise Error_Resync
519 function P_Formal_Type_Declaration
return Node_Id
is
524 Decl_Node
:= New_Node
(N_Formal_Type_Declaration
, Token_Ptr
);
526 Set_Defining_Identifier
(Decl_Node
, P_Defining_Identifier
);
528 if P_Unknown_Discriminant_Part_Opt
then
529 Set_Unknown_Discriminants_Present
(Decl_Node
, True);
531 Set_Discriminant_Specifications
532 (Decl_Node
, P_Known_Discriminant_Part_Opt
);
535 if Token
= Tok_Semicolon
then
537 -- Ada 2012: Incomplete formal type
539 Scan
; -- past semicolon
541 Error_Msg_Ada_2012_Feature
542 ("formal incomplete type", Sloc
(Decl_Node
));
544 Set_Formal_Type_Definition
546 New_Node
(N_Formal_Incomplete_Type_Definition
, Token_Ptr
));
553 Def_Node
:= P_Formal_Type_Definition
;
555 if Nkind
(Def_Node
) = N_Formal_Incomplete_Type_Definition
then
556 Error_Msg_Ada_2012_Feature
557 ("formal incomplete type", Sloc
(Decl_Node
));
560 if Def_Node
/= Error
then
561 Set_Formal_Type_Definition
(Decl_Node
, Def_Node
);
563 if Token
= Tok_Or
then
564 Error_Msg_Ada_2022_Feature
565 ("default for formal type", Sloc
(Decl_Node
));
568 if Token
/= Tok_Use
then
569 Error_Msg_SC
("missing USE for default subtype");
572 Set_Default_Subtype_Mark
(Decl_Node
, P_Name
);
576 P_Aspect_Specifications
(Decl_Node
);
581 -- If we have aspect specifications, skip them
583 if Aspect_Specifications_Present
then
584 P_Aspect_Specifications
(Error
);
586 -- If we have semicolon, skip it to avoid cascaded errors
588 elsif Token
= Tok_Semicolon
then
589 Scan
; -- past semicolon
594 end P_Formal_Type_Declaration
;
596 ----------------------------------
597 -- 12.5 Formal Type Definition --
598 ----------------------------------
600 -- FORMAL_TYPE_DEFINITION ::=
601 -- FORMAL_PRIVATE_TYPE_DEFINITION
602 -- | FORMAL_INCOMPLETE_TYPE_DEFINITION
603 -- | FORMAL_DERIVED_TYPE_DEFINITION
604 -- | FORMAL_DISCRETE_TYPE_DEFINITION
605 -- | FORMAL_SIGNED_INTEGER_TYPE_DEFINITION
606 -- | FORMAL_MODULAR_TYPE_DEFINITION
607 -- | FORMAL_FLOATING_POINT_DEFINITION
608 -- | FORMAL_ORDINARY_FIXED_POINT_DEFINITION
609 -- | FORMAL_DECIMAL_FIXED_POINT_DEFINITION
610 -- | FORMAL_ARRAY_TYPE_DEFINITION
611 -- | FORMAL_ACCESS_TYPE_DEFINITION
612 -- | FORMAL_INTERFACE_TYPE_DEFINITION
614 -- FORMAL_ARRAY_TYPE_DEFINITION ::= ARRAY_TYPE_DEFINITION
616 -- FORMAL_ACCESS_TYPE_DEFINITION ::= ACCESS_TYPE_DEFINITION
618 -- FORMAL_INTERFACE_TYPE_DEFINITION ::= INTERFACE_TYPE_DEFINITION
620 function P_Formal_Type_Definition
return Node_Id
is
621 Scan_State
: Saved_Scan_State
;
622 Typedef_Node
: Node_Id
;
625 if Token_Name
= Name_Abstract
then
626 Check_95_Keyword
(Tok_Abstract
, Tok_Tagged
);
629 if Token_Name
= Name_Tagged
then
630 Check_95_Keyword
(Tok_Tagged
, Tok_Private
);
631 Check_95_Keyword
(Tok_Tagged
, Tok_Limited
);
636 -- Mostly we can tell what we have from the initial token. The one
637 -- exception is ABSTRACT, where we have to scan ahead to see if we
638 -- have a formal derived type or a formal private type definition.
640 -- In addition, in Ada 2005 LIMITED may appear after abstract, so
641 -- that the lookahead must be extended by one more token.
644 Save_Scan_State
(Scan_State
);
645 Scan
; -- past ABSTRACT
647 if Token
= Tok_New
then
648 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
649 return P_Formal_Derived_Type_Definition
;
651 elsif Token
= Tok_Limited
then
652 Scan
; -- past LIMITED
654 if Token
= Tok_New
then
655 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
656 return P_Formal_Derived_Type_Definition
;
659 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
660 return P_Formal_Private_Type_Definition
;
663 -- Ada 2005 (AI-443): Abstract synchronized formal derived type
665 elsif Token
= Tok_Synchronized
then
666 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
667 return P_Formal_Derived_Type_Definition
;
670 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
671 return P_Formal_Private_Type_Definition
;
675 return P_Access_Type_Definition
;
678 return P_Array_Type_Definition
;
681 return P_Formal_Fixed_Point_Definition
;
684 return P_Formal_Floating_Point_Definition
;
686 when Tok_Interface
=> -- Ada 2005 (AI-251)
687 return P_Interface_Type_Definition
(Abstract_Present
=> False);
689 when Tok_Left_Paren
=>
690 return P_Formal_Discrete_Type_Definition
;
693 Save_Scan_State
(Scan_State
);
694 Scan
; -- past LIMITED
696 if Token
= Tok_Interface
then
698 P_Interface_Type_Definition
(Abstract_Present
=> False);
699 Set_Limited_Present
(Typedef_Node
);
702 elsif Token
= Tok_New
then
703 Restore_Scan_State
(Scan_State
); -- to LIMITED
704 return P_Formal_Derived_Type_Definition
;
707 if Token
= Tok_Abstract
then
708 Error_Msg_SC
-- CODEFIX
709 ("ABSTRACT must come before LIMITED");
710 Scan
; -- past improper ABSTRACT
712 if Token
= Tok_New
then
713 Restore_Scan_State
(Scan_State
); -- to LIMITED
714 return P_Formal_Derived_Type_Definition
;
717 Restore_Scan_State
(Scan_State
);
718 return P_Formal_Private_Type_Definition
;
722 Restore_Scan_State
(Scan_State
);
723 return P_Formal_Private_Type_Definition
;
727 return P_Formal_Modular_Type_Definition
;
730 return P_Formal_Derived_Type_Definition
;
733 if P_Null_Exclusion
then
734 Typedef_Node
:= P_Access_Type_Definition
;
735 Set_Null_Exclusion_Present
(Typedef_Node
);
739 Error_Msg_SC
("expect valid formal access definition!");
740 Resync_Past_Semicolon
;
745 -- Ada_2022: incomplete type with default
747 New_Node
(N_Formal_Incomplete_Type_Definition
, Token_Ptr
);
750 return P_Formal_Private_Type_Definition
;
753 if Next_Token_Is
(Tok_Semicolon
)
754 or else Next_Token_Is
(Tok_Or
)
757 New_Node
(N_Formal_Incomplete_Type_Definition
, Token_Ptr
);
758 Set_Tagged_Present
(Typedef_Node
);
764 return P_Formal_Private_Type_Definition
;
768 return P_Formal_Signed_Integer_Type_Definition
;
771 Error_Msg_SC
("record not allowed in generic type definition!");
772 Discard_Junk_Node
(P_Record_Definition
);
775 -- Ada 2005 (AI-345): Task, Protected or Synchronized interface or
776 -- (AI-443): Synchronized formal derived type declaration.
783 Saved_Token
: constant Token_Type
:= Token
;
786 Scan
; -- past TASK, PROTECTED or SYNCHRONIZED
788 -- Synchronized derived type
790 if Token
= Tok_New
then
791 Typedef_Node
:= P_Formal_Derived_Type_Definition
;
793 if Saved_Token
= Tok_Synchronized
then
794 Set_Synchronized_Present
(Typedef_Node
);
796 Error_Msg_SC
("invalid kind of formal derived type");
803 P_Interface_Type_Definition
(Abstract_Present
=> False);
807 Set_Task_Present
(Typedef_Node
);
809 when Tok_Protected
=>
810 Set_Protected_Present
(Typedef_Node
);
812 when Tok_Synchronized
=>
813 Set_Synchronized_Present
(Typedef_Node
);
824 Error_Msg_BC
("expecting generic type definition here");
825 Resync_Past_Semicolon
;
828 end P_Formal_Type_Definition
;
830 --------------------------------------------
831 -- 12.5.1 Formal Private Type Definition --
832 --------------------------------------------
834 -- FORMAL_PRIVATE_TYPE_DEFINITION ::=
835 -- [[abstract] tagged] [limited] private
837 -- The caller has checked the initial token is PRIVATE, ABSTRACT,
840 -- Error recovery: cannot raise Error_Resync
842 function P_Formal_Private_Type_Definition
return Node_Id
is
846 Def_Node
:= New_Node
(N_Formal_Private_Type_Definition
, Token_Ptr
);
848 if Token
= Tok_Abstract
then
849 Scan
; -- past ABSTRACT
851 if Token_Name
= Name_Tagged
then
852 Check_95_Keyword
(Tok_Tagged
, Tok_Private
);
853 Check_95_Keyword
(Tok_Tagged
, Tok_Limited
);
856 if Token
/= Tok_Tagged
then
857 Error_Msg_SP
("ABSTRACT must be followed by TAGGED");
859 Set_Abstract_Present
(Def_Node
, True);
863 if Token
= Tok_Tagged
then
864 Set_Tagged_Present
(Def_Node
, True);
868 if Token
= Tok_Limited
then
869 Set_Limited_Present
(Def_Node
, True);
870 Scan
; -- past LIMITED
873 if Token
= Tok_Abstract
then
874 if Prev_Token
= Tok_Tagged
then
875 Error_Msg_SC
-- CODEFIX
876 ("ABSTRACT must come before TAGGED");
877 elsif Prev_Token
= Tok_Limited
then
878 Error_Msg_SC
-- CODEFIX
879 ("ABSTRACT must come before LIMITED");
882 Resync_Past_Semicolon
;
884 elsif Token
= Tok_Tagged
then
885 Error_Msg_SC
-- CODEFIX
886 ("TAGGED must come before LIMITED");
887 Resync_Past_Semicolon
;
890 Set_Sloc
(Def_Node
, Token_Ptr
);
893 if Token
= Tok_Tagged
then -- CODEFIX
894 Error_Msg_SC
("TAGGED must come before PRIVATE");
897 elsif Token
= Tok_Abstract
then -- CODEFIX
898 Error_Msg_SC
("`ABSTRACT TAGGED` must come before PRIVATE");
899 Scan
; -- past ABSTRACT
901 if Token
= Tok_Tagged
then
907 end P_Formal_Private_Type_Definition
;
909 --------------------------------------------
910 -- 12.5.1 Formal Derived Type Definition --
911 --------------------------------------------
913 -- FORMAL_DERIVED_TYPE_DEFINITION ::=
914 -- [abstract] [limited | synchronized]
915 -- new SUBTYPE_MARK [[and INTERFACE_LIST] with private]
917 -- The caller has checked the initial token(s) is/are NEW, ABSTRACT NEW,
918 -- or LIMITED NEW, ABSTRACT LIMITED NEW, SYNCHRONIZED NEW or ABSTRACT
921 -- Error recovery: cannot raise Error_Resync
923 function P_Formal_Derived_Type_Definition
return Node_Id
is
927 Def_Node
:= New_Node
(N_Formal_Derived_Type_Definition
, Token_Ptr
);
929 if Token
= Tok_Abstract
then
930 Set_Abstract_Present
(Def_Node
);
931 Scan
; -- past ABSTRACT
934 if Token
= Tok_Limited
then
935 Set_Limited_Present
(Def_Node
);
936 Scan
; -- past LIMITED
938 Error_Msg_Ada_2005_Extension
("LIMITED in derived type");
940 elsif Token
= Tok_Synchronized
then
941 Set_Synchronized_Present
(Def_Node
);
942 Scan
; -- past SYNCHRONIZED
944 Error_Msg_Ada_2005_Extension
("SYNCHRONIZED in derived type");
947 if Token
= Tok_Abstract
then
948 Scan
; -- past ABSTRACT, diagnosed already in caller.
952 Set_Subtype_Mark
(Def_Node
, P_Subtype_Mark
);
955 -- Ada 2005 (AI-251): Deal with interfaces
957 if Token
= Tok_And
then
960 Error_Msg_Ada_2005_Extension
("abstract interface");
962 Set_Interface_List
(Def_Node
, New_List
);
965 Append
(P_Qualified_Simple_Name
, Interface_List
(Def_Node
));
966 exit when Token
/= Tok_And
;
971 if Token
= Tok_With
then
973 if Next_Token_Is
(Tok_Private
) then
975 Set_Private_Present
(Def_Node
, True);
978 -- Formal type has aspect specifications, parsed later.
979 -- Otherwise this is a formal derived type. Note that it may
980 -- also include later aspect specifications, as in:
982 -- type DT is new T with private with Atomic;
984 Error_Msg_Ada_2022_Feature
985 ("formal type with aspect specification", Token_Ptr
);
990 elsif Token
= Tok_Tagged
then
993 if Token
= Tok_Private
then
994 Error_Msg_SC
-- CODEFIX
995 ("TAGGED should be WITH");
996 Set_Private_Present
(Def_Node
, True);
1004 end P_Formal_Derived_Type_Definition
;
1006 ---------------------------------------------
1007 -- 12.5.2 Formal Discrete Type Definition --
1008 ---------------------------------------------
1010 -- FORMAL_DISCRETE_TYPE_DEFINITION ::= (<>)
1012 -- The caller has checked the initial token is left paren
1014 -- Error recovery: cannot raise Error_Resync
1016 function P_Formal_Discrete_Type_Definition
return Node_Id
is
1020 Def_Node
:= New_Node
(N_Formal_Discrete_Type_Definition
, Token_Ptr
);
1021 Scan
; -- past left paren
1025 end P_Formal_Discrete_Type_Definition
;
1027 ---------------------------------------------------
1028 -- 12.5.2 Formal Signed Integer Type Definition --
1029 ---------------------------------------------------
1031 -- FORMAL_SIGNED_INTEGER_TYPE_DEFINITION ::= range <>
1033 -- The caller has checked the initial token is RANGE
1035 -- Error recovery: cannot raise Error_Resync
1037 function P_Formal_Signed_Integer_Type_Definition
return Node_Id
is
1042 New_Node
(N_Formal_Signed_Integer_Type_Definition
, Token_Ptr
);
1046 end P_Formal_Signed_Integer_Type_Definition
;
1048 --------------------------------------------
1049 -- 12.5.2 Formal Modular Type Definition --
1050 --------------------------------------------
1052 -- FORMAL_MODULAR_TYPE_DEFINITION ::= mod <>
1054 -- The caller has checked the initial token is MOD
1056 -- Error recovery: cannot raise Error_Resync
1058 function P_Formal_Modular_Type_Definition
return Node_Id
is
1063 New_Node
(N_Formal_Modular_Type_Definition
, Token_Ptr
);
1067 end P_Formal_Modular_Type_Definition
;
1069 ----------------------------------------------
1070 -- 12.5.2 Formal Floating Point Definition --
1071 ----------------------------------------------
1073 -- FORMAL_FLOATING_POINT_DEFINITION ::= digits <>
1075 -- The caller has checked the initial token is DIGITS
1077 -- Error recovery: cannot raise Error_Resync
1079 function P_Formal_Floating_Point_Definition
return Node_Id
is
1084 New_Node
(N_Formal_Floating_Point_Definition
, Token_Ptr
);
1085 Scan
; -- past DIGITS
1088 end P_Formal_Floating_Point_Definition
;
1090 -------------------------------------------
1091 -- 12.5.2 Formal Fixed Point Definition --
1092 -------------------------------------------
1094 -- This routine parses either a formal ordinary fixed point definition
1095 -- or a formal decimal fixed point definition:
1097 -- FORMAL_ORDINARY_FIXED_POINT_DEFINITION ::= delta <>
1099 -- FORMAL_DECIMAL_FIXED_POINT_DEFINITION ::= delta <> digits <>
1101 -- The caller has checked the initial token is DELTA
1103 -- Error recovery: cannot raise Error_Resync
1105 function P_Formal_Fixed_Point_Definition
return Node_Id
is
1107 Delta_Sloc
: Source_Ptr
;
1110 Delta_Sloc
:= Token_Ptr
;
1114 if Token
= Tok_Digits
then
1116 New_Node
(N_Formal_Decimal_Fixed_Point_Definition
, Delta_Sloc
);
1117 Scan
; -- past DIGITS
1121 New_Node
(N_Formal_Ordinary_Fixed_Point_Definition
, Delta_Sloc
);
1125 end P_Formal_Fixed_Point_Definition
;
1127 ----------------------------------------------------
1128 -- 12.5.2 Formal Ordinary Fixed Point Definition --
1129 ----------------------------------------------------
1131 -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2)
1133 ---------------------------------------------------
1134 -- 12.5.2 Formal Decimal Fixed Point Definition --
1135 ---------------------------------------------------
1137 -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2)
1139 ------------------------------------------
1140 -- 12.5.3 Formal Array Type Definition --
1141 ------------------------------------------
1143 -- Parsed by P_Formal_Type_Definition (12.5)
1145 -------------------------------------------
1146 -- 12.5.4 Formal Access Type Definition --
1147 -------------------------------------------
1149 -- Parsed by P_Formal_Type_Definition (12.5)
1151 -----------------------------------------
1152 -- 12.6 Formal Subprogram Declaration --
1153 -----------------------------------------
1155 -- FORMAL_SUBPROGRAM_DECLARATION ::=
1156 -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION
1157 -- | FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION
1159 -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION ::=
1160 -- with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT]
1161 -- [ASPECT_SPECIFICATIONS];
1163 -- FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION ::=
1164 -- with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT]
1165 -- [ASPECT_SPECIFICATIONS];
1167 -- SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <>
1168 -- | ( EXPRESSION ) -- Allowed as extension (-gnatX)
1170 -- DEFAULT_NAME ::= NAME | null
1172 -- The caller has checked that the initial tokens are WITH FUNCTION or
1173 -- WITH PROCEDURE, and the initial WITH has been scanned out.
1175 -- A null default is an Ada 2005 feature
1177 -- Error recovery: cannot raise Error_Resync
1179 function P_Formal_Subprogram_Declaration
return Node_Id
is
1180 Prev_Sloc
: constant Source_Ptr
:= Prev_Token_Ptr
;
1181 Spec_Node
: constant Node_Id
:= P_Subprogram_Specification
;
1185 if Token
= Tok_Is
then
1186 T_Is
; -- past IS, skip extra IS or ";"
1188 if Token
= Tok_Abstract
then
1190 New_Node
(N_Formal_Abstract_Subprogram_Declaration
, Prev_Sloc
);
1191 Scan
; -- past ABSTRACT
1193 Error_Msg_Ada_2005_Extension
("formal abstract subprogram");
1197 New_Node
(N_Formal_Concrete_Subprogram_Declaration
, Prev_Sloc
);
1200 Set_Specification
(Def_Node
, Spec_Node
);
1202 if Token
= Tok_Semicolon
then
1205 elsif Aspect_Specifications_Present
then
1208 elsif Token
= Tok_Box
then
1209 Set_Box_Present
(Def_Node
, True);
1212 elsif Token
= Tok_Null
then
1213 Error_Msg_Ada_2005_Extension
("null default subprogram");
1215 if Nkind
(Spec_Node
) = N_Procedure_Specification
then
1216 Set_Null_Present
(Spec_Node
);
1218 Error_Msg_SP
("only procedures can be null");
1223 -- When extensions are enabled, a formal function can have a default
1224 -- given by a parenthesized expression (expression function syntax).
1226 elsif Token
= Tok_Left_Paren
then
1227 Error_Msg_GNAT_Extension
1228 ("expression default for formal subprograms");
1230 if Nkind
(Spec_Node
) = N_Function_Specification
then
1233 Set_Expression
(Def_Node
, P_Expression
);
1235 if Token
/= Tok_Right_Paren
then
1236 Error_Msg_SC
("missing "")"" at end of expression default");
1243 ("only functions can specify a default expression");
1247 Set_Default_Name
(Def_Node
, P_Name
);
1252 New_Node
(N_Formal_Concrete_Subprogram_Declaration
, Prev_Sloc
);
1253 Set_Specification
(Def_Node
, Spec_Node
);
1256 P_Aspect_Specifications
(Def_Node
);
1258 end P_Formal_Subprogram_Declaration
;
1260 ------------------------------
1261 -- 12.6 Subprogram Default --
1262 ------------------------------
1264 -- Parsed by P_Formal_Procedure_Declaration (12.6)
1266 ------------------------
1267 -- 12.6 Default Name --
1268 ------------------------
1270 -- Parsed by P_Formal_Procedure_Declaration (12.6)
1272 --------------------------------------
1273 -- 12.7 Formal Package Declaration --
1274 --------------------------------------
1276 -- FORMAL_PACKAGE_DECLARATION ::=
1277 -- with package DEFINING_IDENTIFIER
1278 -- is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART
1279 -- [ASPECT_SPECIFICATIONS];
1281 -- FORMAL_PACKAGE_ACTUAL_PART ::=
1282 -- ([OTHERS =>] <>) |
1283 -- [GENERIC_ACTUAL_PART]
1284 -- (FORMAL_PACKAGE_ASSOCIATION {, FORMAL_PACKAGE_ASSOCIATION}
1287 -- FORMAL_PACKAGE_ASSOCIATION ::=
1288 -- GENERIC_ASSOCIATION
1289 -- | GENERIC_FORMAL_PARAMETER_SELECTOR_NAME => <>
1291 -- The caller has checked that the initial tokens are WITH PACKAGE,
1292 -- and the initial WITH has been scanned out (so Token = Tok_Package).
1294 -- Error recovery: cannot raise Error_Resync
1296 function P_Formal_Package_Declaration
return Node_Id
is
1298 Scan_State
: Saved_Scan_State
;
1301 Def_Node
:= New_Node
(N_Formal_Package_Declaration
, Prev_Token_Ptr
);
1302 Scan
; -- past PACKAGE
1303 Set_Defining_Identifier
(Def_Node
, P_Defining_Identifier
(C_Is
));
1306 Set_Name
(Def_Node
, P_Qualified_Simple_Name
);
1308 if Token
= Tok_Left_Paren
then
1309 Save_Scan_State
(Scan_State
); -- at the left paren
1310 Scan
; -- past the left paren
1312 if Token
= Tok_Box
then
1313 Set_Box_Present
(Def_Node
, True);
1318 Restore_Scan_State
(Scan_State
); -- to the left paren
1319 Set_Generic_Associations
(Def_Node
, P_Generic_Actual_Part_Opt
);
1323 P_Aspect_Specifications
(Def_Node
);
1325 end P_Formal_Package_Declaration
;
1327 --------------------------------------
1328 -- 12.7 Formal Package Actual Part --
1329 --------------------------------------
1331 -- Parsed by P_Formal_Package_Declaration (12.7)