OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [par-ch12.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.