1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2023, 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
in Tok_Package | Tok_Function | Tok_Procedure
then
119 Scan
; -- scan past PACKAGE, FUNCTION or PROCEDURE
121 if Token
= Tok_Identifier
then
122 Def_Unit
:= P_Defining_Program_Unit_Name
;
124 Check_Misspelling_Of
(Tok_Renames
);
126 if Token
= Tok_Renames
then
127 if Ren_Token
= Tok_Package
then
128 Decl_Node
:= New_Node
129 (N_Generic_Package_Renaming_Declaration
, Gen_Sloc
);
131 elsif Ren_Token
= Tok_Procedure
then
132 Decl_Node
:= New_Node
133 (N_Generic_Procedure_Renaming_Declaration
, Gen_Sloc
);
135 else -- Ren_Token = Tok_Function then
136 Decl_Node
:= New_Node
137 (N_Generic_Function_Renaming_Declaration
, Gen_Sloc
);
140 Scan
; -- past RENAMES
141 Set_Defining_Unit_Name
(Decl_Node
, Def_Unit
);
142 Set_Name
(Decl_Node
, P_Name
);
144 P_Aspect_Specifications
(Decl_Node
, Semicolon
=> False);
151 -- Fall through if this is *not* a generic renaming declaration
153 Restore_Scan_State
(Scan_State
);
156 -- Loop through generic parameter declarations and use clauses
159 P_Pragmas_Opt
(Decls
);
161 if Token
= Tok_Private
then
162 Error_Msg_S
("generic private child packages not permitted");
163 Scan
; -- past PRIVATE
166 if Token
= Tok_Use
then
167 P_Use_Clause
(Decls
);
170 -- Parse a generic parameter declaration
172 if Token
= Tok_Identifier
then
173 P_Formal_Object_Declarations
(Decls
);
175 elsif Token
= Tok_Type
then
176 Append
(P_Formal_Type_Declaration
, Decls
);
178 elsif Token
= Tok_With
then
181 if Token
= Tok_Package
then
182 Append
(P_Formal_Package_Declaration
, Decls
);
184 elsif Token
in Tok_Procedure | Tok_Function
then
185 Append
(P_Formal_Subprogram_Declaration
, Decls
);
188 Error_Msg_BC
-- CODEFIX
189 ("FUNCTION, PROCEDURE or PACKAGE expected here");
190 Resync_Past_Semicolon
;
193 elsif Token
= Tok_Subtype
then
194 Error_Msg_SC
("subtype declaration not allowed " &
195 "as generic parameter declaration!");
196 Resync_Past_Semicolon
;
204 -- Generic formal part is scanned, scan out subprogram or package spec
206 if Token
= Tok_Package
then
207 Gen_Decl
:= New_Node
(N_Generic_Package_Declaration
, Gen_Sloc
);
208 Set_Specification
(Gen_Decl
, P_Package
(Pf_Spcn
));
210 -- Aspects have been parsed by the package spec. Move them to the
211 -- generic declaration where they belong.
213 Move_Aspects
(Specification
(Gen_Decl
), Gen_Decl
);
216 Gen_Decl
:= New_Node
(N_Generic_Subprogram_Declaration
, Gen_Sloc
);
217 Set_Specification
(Gen_Decl
, P_Subprogram_Specification
);
219 if Nkind
(Defining_Unit_Name
(Specification
(Gen_Decl
))) =
220 N_Defining_Program_Unit_Name
221 and then Scope
.Last
> 0
223 Error_Msg_SP
("child unit allowed only at library level");
226 P_Aspect_Specifications
(Gen_Decl
);
229 Set_Generic_Formal_Declarations
(Gen_Decl
, Decls
);
233 -------------------------------
234 -- 12.1 Generic Declaration --
235 -------------------------------
237 -- Parsed by P_Generic (12.1)
239 ------------------------------------------
240 -- 12.1 Generic Subprogram Declaration --
241 ------------------------------------------
243 -- Parsed by P_Generic (12.1)
245 ---------------------------------------
246 -- 12.1 Generic Package Declaration --
247 ---------------------------------------
249 -- Parsed by P_Generic (12.1)
251 -------------------------------
252 -- 12.1 Generic Formal Part --
253 -------------------------------
255 -- Parsed by P_Generic (12.1)
257 -------------------------------------------------
258 -- 12.1 Generic Formal Parameter Declaration --
259 -------------------------------------------------
261 -- Parsed by P_Generic (12.1)
263 ---------------------------------
264 -- 12.3 Generic Instantiation --
265 ---------------------------------
267 -- Generic package instantiation parsed by P_Package (7.1)
268 -- Generic procedure instantiation parsed by P_Subprogram (6.1)
269 -- Generic function instantiation parsed by P_Subprogram (6.1)
271 -------------------------------
272 -- 12.3 Generic Actual Part --
273 -------------------------------
275 -- GENERIC_ACTUAL_PART ::=
276 -- (GENERIC_ASSOCIATION {, GENERIC_ASSOCIATION})
278 -- Returns a list of generic associations, or Empty if none are present
280 -- Error recovery: cannot raise Error_Resync
282 function P_Generic_Actual_Part_Opt
return List_Id
is
283 Association_List
: List_Id
;
286 -- Figure out if a generic actual part operation is present. Clearly
287 -- there is no generic actual part if the current token is semicolon
288 -- or if we have aspect specifications present.
290 if Token
= Tok_Semicolon
or else Aspect_Specifications_Present
then
293 -- If we don't have a left paren, then we have an error, and the job
294 -- is to figure out whether a left paren or semicolon was intended.
295 -- We assume a missing left paren (and hence a generic actual part
296 -- present) if the current token is not on a new line, or if it is
297 -- indented from the subprogram token. Otherwise assume missing
298 -- semicolon (which will be diagnosed by caller) and no generic part
300 elsif Token
/= Tok_Left_Paren
301 and then Token_Is_At_Start_Of_Line
302 and then Start_Column
<= Scopes
(Scope
.Last
).Ecol
306 -- Otherwise we have a generic actual part (either a left paren is
307 -- present, or we have decided that there must be a missing left paren)
310 Association_List
:= New_List
;
314 Append
(P_Generic_Association
, Association_List
);
315 exit when not Comma_Present
;
319 return Association_List
;
322 end P_Generic_Actual_Part_Opt
;
324 -------------------------------
325 -- 12.3 Generic Association --
326 -------------------------------
328 -- GENERIC_ASSOCIATION ::=
329 -- [generic_formal_parameter_SELECTOR_NAME =>]
330 -- EXPLICIT_GENERIC_ACTUAL_PARAMETER
332 -- EXPLICIT_GENERIC_ACTUAL_PARAMETER ::=
333 -- EXPRESSION | variable_NAME | subprogram_NAME
334 -- | entry_NAME | SUBTYPE_MARK | package_instance_NAME
336 -- Error recovery: cannot raise Error_Resync
338 function P_Generic_Association
return Node_Id
is
339 Scan_State
: Saved_Scan_State
;
340 Param_Name_Node
: Node_Id
;
341 Generic_Assoc_Node
: Node_Id
;
344 Generic_Assoc_Node
:= New_Node
(N_Generic_Association
, Token_Ptr
);
346 -- Ada 2005: an association can be given by: others => <>
348 if Token
= Tok_Others
then
349 Error_Msg_Ada_2005_Extension
350 ("partial parameterization of formal package");
354 if Token
/= Tok_Arrow
then
355 Error_Msg_BC
("expect `='>` after OTHERS");
360 if Token
/= Tok_Box
then
361 Error_Msg_BC
("expect `'<'>` after `='>`");
366 -- Source position of the others choice is beginning of construct
368 return New_Node
(N_Others_Choice
, Sloc
(Generic_Assoc_Node
));
371 if Token
in Token_Class_Desig
then
372 Param_Name_Node
:= Token_Node
;
373 Save_Scan_State
(Scan_State
); -- at designator
374 Scan
; -- past simple name or operator symbol
376 if Token
= Tok_Arrow
then
378 Set_Selector_Name
(Generic_Assoc_Node
, Param_Name_Node
);
380 Restore_Scan_State
(Scan_State
); -- to designator
384 -- In Ada 2005 the actual can be a box
386 if Token
= Tok_Box
then
388 Set_Box_Present
(Generic_Assoc_Node
);
389 Set_Explicit_Generic_Actual_Parameter
(Generic_Assoc_Node
, Empty
);
392 Set_Explicit_Generic_Actual_Parameter
393 (Generic_Assoc_Node
, P_Expression
);
396 return Generic_Assoc_Node
;
397 end P_Generic_Association
;
399 ---------------------------------------------
400 -- 12.3 Explicit Generic Actual Parameter --
401 ---------------------------------------------
403 -- Parsed by P_Generic_Association (12.3)
405 --------------------------------------
406 -- 12.4 Formal Object Declarations --
407 --------------------------------------
409 -- FORMAL_OBJECT_DECLARATION ::=
410 -- DEFINING_IDENTIFIER_LIST :
411 -- MODE [NULL_EXCLUSION] SUBTYPE_MARK [:= DEFAULT_EXPRESSION]
412 -- [ASPECT_SPECIFICATIONS];
413 -- | DEFINING_IDENTIFIER_LIST :
414 -- MODE ACCESS_DEFINITION [:= DEFAULT_EXPRESSION];
415 -- [ASPECT_SPECIFICATIONS];
417 -- The caller has checked that the initial token is an identifier
419 -- Error recovery: cannot raise Error_Resync
421 procedure P_Formal_Object_Declarations
(Decls
: List_Id
) is
424 Not_Null_Present
: Boolean := False;
426 Scan_State
: Saved_Scan_State
;
428 Idents
: array (Pos
range 1 .. 4096) of Entity_Id
;
429 -- This array holds the list of defining identifiers. The upper bound
430 -- of 4096 is intended to be essentially infinite, and we do not even
431 -- bother to check for it being exceeded.
434 Idents
(1) := P_Defining_Identifier
(C_Comma_Colon
);
436 while Comma_Present
loop
437 Num_Idents
:= Num_Idents
+ 1;
438 Idents
(Num_Idents
) := P_Defining_Identifier
(C_Comma_Colon
);
443 -- If there are multiple identifiers, we repeatedly scan the
444 -- type and initialization expression information by resetting
445 -- the scan pointer (so that we get completely separate trees
446 -- for each occurrence).
448 if Num_Idents
> 1 then
449 Save_Scan_State
(Scan_State
);
452 -- Loop through defining identifiers in list
456 Decl_Node
:= New_Node
(N_Formal_Object_Declaration
, Token_Ptr
);
457 Set_Defining_Identifier
(Decl_Node
, Idents
(Ident
));
460 Not_Null_Present
:= P_Null_Exclusion
; -- Ada 2005 (AI-423)
462 -- Ada 2005 (AI-423): Formal object with an access definition
464 if Token
= Tok_Access
then
466 -- The access definition is still parsed and set even though
467 -- the compilation may not use the proper switch. This action
468 -- ensures the required local error recovery.
470 Set_Access_Definition
(Decl_Node
,
471 P_Access_Definition
(Not_Null_Present
));
473 Error_Msg_Ada_2005_Extension
474 ("access definition in formal object declaration");
476 -- Formal object with a subtype mark
479 Set_Null_Exclusion_Present
(Decl_Node
, Not_Null_Present
);
480 Set_Subtype_Mark
(Decl_Node
, P_Subtype_Mark_Resync
);
484 Set_Default_Expression
(Decl_Node
, Init_Expr_Opt
);
485 P_Aspect_Specifications
(Decl_Node
);
488 Set_Prev_Ids
(Decl_Node
, True);
491 if Ident
< Num_Idents
then
492 Set_More_Ids
(Decl_Node
, True);
495 Append
(Decl_Node
, Decls
);
497 exit Ident_Loop
when Ident
= Num_Idents
;
499 Restore_Scan_State
(Scan_State
);
501 end P_Formal_Object_Declarations
;
503 -----------------------------------
504 -- 12.5 Formal Type Declaration --
505 -----------------------------------
507 -- FORMAL_TYPE_DECLARATION ::=
508 -- type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
509 -- is FORMAL_TYPE_DEFINITION
510 -- [ASPECT_SPECIFICATIONS];
512 -- The caller has checked that the initial token is TYPE
514 -- Error recovery: cannot raise Error_Resync
516 function P_Formal_Type_Declaration
return Node_Id
is
521 Decl_Node
:= New_Node
(N_Formal_Type_Declaration
, Token_Ptr
);
523 Set_Defining_Identifier
(Decl_Node
, P_Defining_Identifier
);
525 if P_Unknown_Discriminant_Part_Opt
then
526 Set_Unknown_Discriminants_Present
(Decl_Node
, True);
528 Set_Discriminant_Specifications
529 (Decl_Node
, P_Known_Discriminant_Part_Opt
);
532 if Token
= Tok_Semicolon
then
534 -- Ada 2012: Incomplete formal type
536 Scan
; -- past semicolon
538 Error_Msg_Ada_2012_Feature
539 ("formal incomplete type", Sloc
(Decl_Node
));
541 Set_Formal_Type_Definition
543 New_Node
(N_Formal_Incomplete_Type_Definition
, Token_Ptr
));
550 Def_Node
:= P_Formal_Type_Definition
;
552 if Nkind
(Def_Node
) = N_Formal_Incomplete_Type_Definition
then
553 Error_Msg_Ada_2012_Feature
554 ("formal incomplete type", Sloc
(Decl_Node
));
557 if Def_Node
/= Error
then
558 Set_Formal_Type_Definition
(Decl_Node
, Def_Node
);
560 if Token
= Tok_Or
then
561 Error_Msg_Ada_2022_Feature
562 ("default for formal type", Sloc
(Decl_Node
));
565 if Token
/= Tok_Use
then
566 Error_Msg_SC
("missing USE for default subtype");
569 Set_Default_Subtype_Mark
(Decl_Node
, P_Name
);
573 P_Aspect_Specifications
(Decl_Node
);
578 -- If we have aspect specifications, skip them
580 if Aspect_Specifications_Present
then
581 P_Aspect_Specifications
(Error
);
583 -- If we have semicolon, skip it to avoid cascaded errors
585 elsif Token
= Tok_Semicolon
then
586 Scan
; -- past semicolon
591 end P_Formal_Type_Declaration
;
593 ----------------------------------
594 -- 12.5 Formal Type Definition --
595 ----------------------------------
597 -- FORMAL_TYPE_DEFINITION ::=
598 -- FORMAL_PRIVATE_TYPE_DEFINITION
599 -- | FORMAL_INCOMPLETE_TYPE_DEFINITION
600 -- | FORMAL_DERIVED_TYPE_DEFINITION
601 -- | FORMAL_DISCRETE_TYPE_DEFINITION
602 -- | FORMAL_SIGNED_INTEGER_TYPE_DEFINITION
603 -- | FORMAL_MODULAR_TYPE_DEFINITION
604 -- | FORMAL_FLOATING_POINT_DEFINITION
605 -- | FORMAL_ORDINARY_FIXED_POINT_DEFINITION
606 -- | FORMAL_DECIMAL_FIXED_POINT_DEFINITION
607 -- | FORMAL_ARRAY_TYPE_DEFINITION
608 -- | FORMAL_ACCESS_TYPE_DEFINITION
609 -- | FORMAL_INTERFACE_TYPE_DEFINITION
611 -- FORMAL_ARRAY_TYPE_DEFINITION ::= ARRAY_TYPE_DEFINITION
613 -- FORMAL_ACCESS_TYPE_DEFINITION ::= ACCESS_TYPE_DEFINITION
615 -- FORMAL_INTERFACE_TYPE_DEFINITION ::= INTERFACE_TYPE_DEFINITION
617 function P_Formal_Type_Definition
return Node_Id
is
618 Scan_State
: Saved_Scan_State
;
619 Typedef_Node
: Node_Id
;
622 if Token_Name
= Name_Abstract
then
623 Check_95_Keyword
(Tok_Abstract
, Tok_Tagged
);
626 if Token_Name
= Name_Tagged
then
627 Check_95_Keyword
(Tok_Tagged
, Tok_Private
);
628 Check_95_Keyword
(Tok_Tagged
, Tok_Limited
);
633 -- Mostly we can tell what we have from the initial token. The one
634 -- exception is ABSTRACT, where we have to scan ahead to see if we
635 -- have a formal derived type or a formal private type definition.
637 -- In addition, in Ada 2005 LIMITED may appear after abstract, so
638 -- that the lookahead must be extended by one more token.
641 Save_Scan_State
(Scan_State
);
642 Scan
; -- past ABSTRACT
644 if Token
= Tok_New
then
645 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
646 return P_Formal_Derived_Type_Definition
;
648 elsif Token
= Tok_Limited
then
649 Scan
; -- past LIMITED
651 if Token
= Tok_New
then
652 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
653 return P_Formal_Derived_Type_Definition
;
656 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
657 return P_Formal_Private_Type_Definition
;
660 -- Ada 2005 (AI-443): Abstract synchronized formal derived type
662 elsif Token
= Tok_Synchronized
then
663 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
664 return P_Formal_Derived_Type_Definition
;
667 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
668 return P_Formal_Private_Type_Definition
;
672 return P_Access_Type_Definition
;
675 return P_Array_Type_Definition
;
678 return P_Formal_Fixed_Point_Definition
;
681 return P_Formal_Floating_Point_Definition
;
683 when Tok_Interface
=> -- Ada 2005 (AI-251)
684 return P_Interface_Type_Definition
(Abstract_Present
=> False);
686 when Tok_Left_Paren
=>
687 return P_Formal_Discrete_Type_Definition
;
690 Save_Scan_State
(Scan_State
);
691 Scan
; -- past LIMITED
693 if Token
= Tok_Interface
then
695 P_Interface_Type_Definition
(Abstract_Present
=> False);
696 Set_Limited_Present
(Typedef_Node
);
699 elsif Token
= Tok_New
then
700 Restore_Scan_State
(Scan_State
); -- to LIMITED
701 return P_Formal_Derived_Type_Definition
;
704 if Token
= Tok_Abstract
then
705 Error_Msg_SC
-- CODEFIX
706 ("ABSTRACT must come before LIMITED");
707 Scan
; -- past improper ABSTRACT
709 if Token
= Tok_New
then
710 Restore_Scan_State
(Scan_State
); -- to LIMITED
711 return P_Formal_Derived_Type_Definition
;
714 Restore_Scan_State
(Scan_State
);
715 return P_Formal_Private_Type_Definition
;
719 Restore_Scan_State
(Scan_State
);
720 return P_Formal_Private_Type_Definition
;
724 return P_Formal_Modular_Type_Definition
;
727 return P_Formal_Derived_Type_Definition
;
730 if P_Null_Exclusion
then
731 Typedef_Node
:= P_Access_Type_Definition
;
732 Set_Null_Exclusion_Present
(Typedef_Node
);
736 Error_Msg_SC
("expect valid formal access definition!");
737 Resync_Past_Semicolon
;
742 -- Ada_2022: incomplete type with default
744 New_Node
(N_Formal_Incomplete_Type_Definition
, Token_Ptr
);
747 return P_Formal_Private_Type_Definition
;
750 if Next_Token_Is
(Tok_Semicolon
)
751 or else Next_Token_Is
(Tok_Or
)
754 New_Node
(N_Formal_Incomplete_Type_Definition
, Token_Ptr
);
755 Set_Tagged_Present
(Typedef_Node
);
761 return P_Formal_Private_Type_Definition
;
765 return P_Formal_Signed_Integer_Type_Definition
;
768 Error_Msg_SC
("record not allowed in generic type definition!");
769 Discard_Junk_Node
(P_Record_Definition
);
772 -- Ada 2005 (AI-345): Task, Protected or Synchronized interface or
773 -- (AI-443): Synchronized formal derived type declaration.
780 Saved_Token
: constant Token_Type
:= Token
;
783 Scan
; -- past TASK, PROTECTED or SYNCHRONIZED
785 -- Synchronized derived type
787 if Token
= Tok_New
then
788 Typedef_Node
:= P_Formal_Derived_Type_Definition
;
790 if Saved_Token
= Tok_Synchronized
then
791 Set_Synchronized_Present
(Typedef_Node
);
793 Error_Msg_SC
("invalid kind of formal derived type");
800 P_Interface_Type_Definition
(Abstract_Present
=> False);
804 Set_Task_Present
(Typedef_Node
);
806 when Tok_Protected
=>
807 Set_Protected_Present
(Typedef_Node
);
809 when Tok_Synchronized
=>
810 Set_Synchronized_Present
(Typedef_Node
);
821 Error_Msg_BC
("expecting generic type definition here");
822 Resync_Past_Semicolon
;
825 end P_Formal_Type_Definition
;
827 --------------------------------------------
828 -- 12.5.1 Formal Private Type Definition --
829 --------------------------------------------
831 -- FORMAL_PRIVATE_TYPE_DEFINITION ::=
832 -- [[abstract] tagged] [limited] private
834 -- The caller has checked the initial token is PRIVATE, ABSTRACT,
837 -- Error recovery: cannot raise Error_Resync
839 function P_Formal_Private_Type_Definition
return Node_Id
is
843 Def_Node
:= New_Node
(N_Formal_Private_Type_Definition
, Token_Ptr
);
845 if Token
= Tok_Abstract
then
846 Scan
; -- past ABSTRACT
848 if Token_Name
= Name_Tagged
then
849 Check_95_Keyword
(Tok_Tagged
, Tok_Private
);
850 Check_95_Keyword
(Tok_Tagged
, Tok_Limited
);
853 if Token
/= Tok_Tagged
then
854 Error_Msg_SP
("ABSTRACT must be followed by TAGGED");
856 Set_Abstract_Present
(Def_Node
, True);
860 if Token
= Tok_Tagged
then
861 Set_Tagged_Present
(Def_Node
, True);
865 if Token
= Tok_Limited
then
866 Set_Limited_Present
(Def_Node
, True);
867 Scan
; -- past LIMITED
870 if Token
= Tok_Abstract
then
871 if Prev_Token
= Tok_Tagged
then
872 Error_Msg_SC
-- CODEFIX
873 ("ABSTRACT must come before TAGGED");
874 elsif Prev_Token
= Tok_Limited
then
875 Error_Msg_SC
-- CODEFIX
876 ("ABSTRACT must come before LIMITED");
879 Resync_Past_Semicolon
;
881 elsif Token
= Tok_Tagged
then
882 Error_Msg_SC
-- CODEFIX
883 ("TAGGED must come before LIMITED");
884 Resync_Past_Semicolon
;
887 Set_Sloc
(Def_Node
, Token_Ptr
);
890 if Token
= Tok_Tagged
then -- CODEFIX
891 Error_Msg_SC
("TAGGED must come before PRIVATE");
894 elsif Token
= Tok_Abstract
then -- CODEFIX
895 Error_Msg_SC
("`ABSTRACT TAGGED` must come before PRIVATE");
896 Scan
; -- past ABSTRACT
898 if Token
= Tok_Tagged
then
904 end P_Formal_Private_Type_Definition
;
906 --------------------------------------------
907 -- 12.5.1 Formal Derived Type Definition --
908 --------------------------------------------
910 -- FORMAL_DERIVED_TYPE_DEFINITION ::=
911 -- [abstract] [limited | synchronized]
912 -- new SUBTYPE_MARK [[and INTERFACE_LIST] with private]
914 -- The caller has checked the initial token(s) is/are NEW, ABSTRACT NEW,
915 -- or LIMITED NEW, ABSTRACT LIMITED NEW, SYNCHRONIZED NEW or ABSTRACT
918 -- Error recovery: cannot raise Error_Resync
920 function P_Formal_Derived_Type_Definition
return Node_Id
is
924 Def_Node
:= New_Node
(N_Formal_Derived_Type_Definition
, Token_Ptr
);
926 if Token
= Tok_Abstract
then
927 Set_Abstract_Present
(Def_Node
);
928 Scan
; -- past ABSTRACT
931 if Token
= Tok_Limited
then
932 Set_Limited_Present
(Def_Node
);
933 Scan
; -- past LIMITED
935 Error_Msg_Ada_2005_Extension
("LIMITED in derived type");
937 elsif Token
= Tok_Synchronized
then
938 Set_Synchronized_Present
(Def_Node
);
939 Scan
; -- past SYNCHRONIZED
941 Error_Msg_Ada_2005_Extension
("SYNCHRONIZED in derived type");
944 if Token
= Tok_Abstract
then
945 Scan
; -- past ABSTRACT, diagnosed already in caller.
949 Set_Subtype_Mark
(Def_Node
, P_Subtype_Mark
);
952 -- Ada 2005 (AI-251): Deal with interfaces
954 if Token
= Tok_And
then
957 Error_Msg_Ada_2005_Extension
("abstract interface");
959 Set_Interface_List
(Def_Node
, New_List
);
962 Append
(P_Qualified_Simple_Name
, Interface_List
(Def_Node
));
963 exit when Token
/= Tok_And
;
968 if Token
= Tok_With
then
970 if Next_Token_Is
(Tok_Private
) then
972 Set_Private_Present
(Def_Node
, True);
975 -- Formal type has aspect specifications, parsed later.
976 -- Otherwise this is a formal derived type. Note that it may
977 -- also include later aspect specifications, as in:
979 -- type DT is new T with private with Atomic;
981 Error_Msg_Ada_2022_Feature
982 ("formal type with aspect specification", Token_Ptr
);
987 elsif Token
= Tok_Tagged
then
990 if Token
= Tok_Private
then
991 Error_Msg_SC
-- CODEFIX
992 ("TAGGED should be WITH");
993 Set_Private_Present
(Def_Node
, True);
1001 end P_Formal_Derived_Type_Definition
;
1003 ---------------------------------------------
1004 -- 12.5.2 Formal Discrete Type Definition --
1005 ---------------------------------------------
1007 -- FORMAL_DISCRETE_TYPE_DEFINITION ::= (<>)
1009 -- The caller has checked the initial token is left paren
1011 -- Error recovery: cannot raise Error_Resync
1013 function P_Formal_Discrete_Type_Definition
return Node_Id
is
1017 Def_Node
:= New_Node
(N_Formal_Discrete_Type_Definition
, Token_Ptr
);
1018 Scan
; -- past left paren
1022 end P_Formal_Discrete_Type_Definition
;
1024 ---------------------------------------------------
1025 -- 12.5.2 Formal Signed Integer Type Definition --
1026 ---------------------------------------------------
1028 -- FORMAL_SIGNED_INTEGER_TYPE_DEFINITION ::= range <>
1030 -- The caller has checked the initial token is RANGE
1032 -- Error recovery: cannot raise Error_Resync
1034 function P_Formal_Signed_Integer_Type_Definition
return Node_Id
is
1039 New_Node
(N_Formal_Signed_Integer_Type_Definition
, Token_Ptr
);
1043 end P_Formal_Signed_Integer_Type_Definition
;
1045 --------------------------------------------
1046 -- 12.5.2 Formal Modular Type Definition --
1047 --------------------------------------------
1049 -- FORMAL_MODULAR_TYPE_DEFINITION ::= mod <>
1051 -- The caller has checked the initial token is MOD
1053 -- Error recovery: cannot raise Error_Resync
1055 function P_Formal_Modular_Type_Definition
return Node_Id
is
1060 New_Node
(N_Formal_Modular_Type_Definition
, Token_Ptr
);
1064 end P_Formal_Modular_Type_Definition
;
1066 ----------------------------------------------
1067 -- 12.5.2 Formal Floating Point Definition --
1068 ----------------------------------------------
1070 -- FORMAL_FLOATING_POINT_DEFINITION ::= digits <>
1072 -- The caller has checked the initial token is DIGITS
1074 -- Error recovery: cannot raise Error_Resync
1076 function P_Formal_Floating_Point_Definition
return Node_Id
is
1081 New_Node
(N_Formal_Floating_Point_Definition
, Token_Ptr
);
1082 Scan
; -- past DIGITS
1085 end P_Formal_Floating_Point_Definition
;
1087 -------------------------------------------
1088 -- 12.5.2 Formal Fixed Point Definition --
1089 -------------------------------------------
1091 -- This routine parses either a formal ordinary fixed point definition
1092 -- or a formal decimal fixed point definition:
1094 -- FORMAL_ORDINARY_FIXED_POINT_DEFINITION ::= delta <>
1096 -- FORMAL_DECIMAL_FIXED_POINT_DEFINITION ::= delta <> digits <>
1098 -- The caller has checked the initial token is DELTA
1100 -- Error recovery: cannot raise Error_Resync
1102 function P_Formal_Fixed_Point_Definition
return Node_Id
is
1104 Delta_Sloc
: Source_Ptr
;
1107 Delta_Sloc
:= Token_Ptr
;
1111 if Token
= Tok_Digits
then
1113 New_Node
(N_Formal_Decimal_Fixed_Point_Definition
, Delta_Sloc
);
1114 Scan
; -- past DIGITS
1118 New_Node
(N_Formal_Ordinary_Fixed_Point_Definition
, Delta_Sloc
);
1122 end P_Formal_Fixed_Point_Definition
;
1124 ----------------------------------------------------
1125 -- 12.5.2 Formal Ordinary Fixed Point Definition --
1126 ----------------------------------------------------
1128 -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2)
1130 ---------------------------------------------------
1131 -- 12.5.2 Formal Decimal Fixed Point Definition --
1132 ---------------------------------------------------
1134 -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2)
1136 ------------------------------------------
1137 -- 12.5.3 Formal Array Type Definition --
1138 ------------------------------------------
1140 -- Parsed by P_Formal_Type_Definition (12.5)
1142 -------------------------------------------
1143 -- 12.5.4 Formal Access Type Definition --
1144 -------------------------------------------
1146 -- Parsed by P_Formal_Type_Definition (12.5)
1148 -----------------------------------------
1149 -- 12.6 Formal Subprogram Declaration --
1150 -----------------------------------------
1152 -- FORMAL_SUBPROGRAM_DECLARATION ::=
1153 -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION
1154 -- | FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION
1156 -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION ::=
1157 -- with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT]
1158 -- [ASPECT_SPECIFICATIONS];
1160 -- FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION ::=
1161 -- with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT]
1162 -- [ASPECT_SPECIFICATIONS];
1164 -- SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <>
1165 -- | ( EXPRESSION ) -- Allowed as extension (-gnatX)
1167 -- DEFAULT_NAME ::= NAME | null
1169 -- The caller has checked that the initial tokens are WITH FUNCTION or
1170 -- WITH PROCEDURE, and the initial WITH has been scanned out.
1172 -- A null default is an Ada 2005 feature
1174 -- Error recovery: cannot raise Error_Resync
1176 function P_Formal_Subprogram_Declaration
return Node_Id
is
1177 Prev_Sloc
: constant Source_Ptr
:= Prev_Token_Ptr
;
1178 Spec_Node
: constant Node_Id
:= P_Subprogram_Specification
;
1182 if Token
= Tok_Is
then
1183 T_Is
; -- past IS, skip extra IS or ";"
1185 if Token
= Tok_Abstract
then
1187 New_Node
(N_Formal_Abstract_Subprogram_Declaration
, Prev_Sloc
);
1188 Scan
; -- past ABSTRACT
1190 Error_Msg_Ada_2005_Extension
("formal abstract subprogram");
1194 New_Node
(N_Formal_Concrete_Subprogram_Declaration
, Prev_Sloc
);
1197 Set_Specification
(Def_Node
, Spec_Node
);
1199 if Token
= Tok_Semicolon
then
1202 elsif Aspect_Specifications_Present
then
1205 elsif Token
= Tok_Box
then
1206 Set_Box_Present
(Def_Node
, True);
1209 elsif Token
= Tok_Null
then
1210 Error_Msg_Ada_2005_Extension
("null default subprogram");
1212 if Nkind
(Spec_Node
) = N_Procedure_Specification
then
1213 Set_Null_Present
(Spec_Node
);
1215 Error_Msg_SP
("only procedures can be null");
1220 -- When extensions are enabled, a formal function can have a default
1221 -- given by a parenthesized expression (expression function syntax).
1223 elsif Token
= Tok_Left_Paren
then
1224 Error_Msg_GNAT_Extension
1225 ("expression default for formal subprograms", Token_Ptr
);
1227 if Nkind
(Spec_Node
) = N_Function_Specification
then
1230 Set_Expression
(Def_Node
, P_Expression
);
1232 if Token
/= Tok_Right_Paren
then
1233 Error_Msg_SC
("missing "")"" at end of expression default");
1240 ("only functions can specify a default expression");
1244 Set_Default_Name
(Def_Node
, P_Name
);
1249 New_Node
(N_Formal_Concrete_Subprogram_Declaration
, Prev_Sloc
);
1250 Set_Specification
(Def_Node
, Spec_Node
);
1253 P_Aspect_Specifications
(Def_Node
);
1255 end P_Formal_Subprogram_Declaration
;
1257 ------------------------------
1258 -- 12.6 Subprogram Default --
1259 ------------------------------
1261 -- Parsed by P_Formal_Procedure_Declaration (12.6)
1263 ------------------------
1264 -- 12.6 Default Name --
1265 ------------------------
1267 -- Parsed by P_Formal_Procedure_Declaration (12.6)
1269 --------------------------------------
1270 -- 12.7 Formal Package Declaration --
1271 --------------------------------------
1273 -- FORMAL_PACKAGE_DECLARATION ::=
1274 -- with package DEFINING_IDENTIFIER
1275 -- is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART
1276 -- [ASPECT_SPECIFICATIONS];
1278 -- FORMAL_PACKAGE_ACTUAL_PART ::=
1279 -- ([OTHERS =>] <>) |
1280 -- [GENERIC_ACTUAL_PART]
1281 -- (FORMAL_PACKAGE_ASSOCIATION {, FORMAL_PACKAGE_ASSOCIATION}
1284 -- FORMAL_PACKAGE_ASSOCIATION ::=
1285 -- GENERIC_ASSOCIATION
1286 -- | GENERIC_FORMAL_PARAMETER_SELECTOR_NAME => <>
1288 -- The caller has checked that the initial tokens are WITH PACKAGE,
1289 -- and the initial WITH has been scanned out (so Token = Tok_Package).
1291 -- Error recovery: cannot raise Error_Resync
1293 function P_Formal_Package_Declaration
return Node_Id
is
1295 Scan_State
: Saved_Scan_State
;
1298 Def_Node
:= New_Node
(N_Formal_Package_Declaration
, Prev_Token_Ptr
);
1299 Scan
; -- past PACKAGE
1300 Set_Defining_Identifier
(Def_Node
, P_Defining_Identifier
(C_Is
));
1303 Set_Name
(Def_Node
, P_Qualified_Simple_Name
);
1305 if Token
= Tok_Left_Paren
then
1306 Save_Scan_State
(Scan_State
); -- at the left paren
1307 Scan
; -- past the left paren
1309 if Token
= Tok_Box
then
1310 Set_Box_Present
(Def_Node
, True);
1315 Restore_Scan_State
(Scan_State
); -- to the left paren
1316 Set_Generic_Associations
(Def_Node
, P_Generic_Actual_Part_Opt
);
1320 P_Aspect_Specifications
(Def_Node
);
1322 end P_Formal_Package_Declaration
;
1324 --------------------------------------
1325 -- 12.7 Formal Package Actual Part --
1326 --------------------------------------
1328 -- Parsed by P_Formal_Package_Declaration (12.7)