]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/ada/par-ch13.adb
[Ada] Bump copyright year
[thirdparty/gcc.git] / gcc / ada / par-ch13.adb
CommitLineData
19235870
RK
1------------------------------------------------------------------------------
2-- --
3-- GNAT COMPILER COMPONENTS --
4-- --
5-- P A R . C H 1 3 --
6-- --
7-- B o d y --
8-- --
4b490c1e 9-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
19235870
RK
10-- --
11-- GNAT is free software; you can redistribute it and/or modify it under --
12-- terms of the GNU General Public License as published by the Free Soft- --
b5c84c3c 13-- ware Foundation; either version 3, or (at your option) any later ver- --
19235870
RK
14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17-- for more details. You should have received a copy of the GNU General --
b5c84c3c
RD
18-- Public License distributed with GNAT; see file COPYING3. If not, go to --
19-- http://www.gnu.org/licenses for a complete copy of the license. --
19235870
RK
20-- --
21-- GNAT was originally developed by the GNAT team at New York University. --
71ff80dc 22-- Extensive contributions were provided by Ada Core Technologies Inc. --
19235870
RK
23-- --
24------------------------------------------------------------------------------
25
26pragma Style_Checks (All_Checks);
27-- Turn off subprogram body ordering check. Subprograms are in order
28-- by RM section rather than alphabetical
29
30separate (Par)
31package body Ch13 is
32
33 -- Local functions, used only in this chapter
34
35 function P_Component_Clause return Node_Id;
36 function P_Mod_Clause return Node_Id;
37
0f1a6a0b
AC
38 -----------------------------------
39 -- Aspect_Specifications_Present --
40 -----------------------------------
41
39231404
AC
42 function Aspect_Specifications_Present
43 (Strict : Boolean := Ada_Version < Ada_2012) return Boolean
44 is
0f1a6a0b
AC
45 Scan_State : Saved_Scan_State;
46 Result : Boolean;
47
a905304c
AC
48 function Possible_Misspelled_Aspect return Boolean;
49 -- Returns True, if Token_Name is a misspelling of some aspect name
50
ef2c20e7
AC
51 function With_Present return Boolean;
52 -- Returns True if WITH is present, indicating presence of aspect
53 -- specifications. Also allows incorrect use of WHEN in place of WITH.
54
a905304c
AC
55 --------------------------------
56 -- Possible_Misspelled_Aspect --
57 --------------------------------
58
59 function Possible_Misspelled_Aspect return Boolean is
60 begin
61 for J in Aspect_Id_Exclude_No_Aspect loop
62 if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
63 return True;
64 end if;
65 end loop;
66
67 return False;
68 end Possible_Misspelled_Aspect;
69
ef2c20e7
AC
70 ------------------
71 -- With_Present --
72 ------------------
73
74 function With_Present return Boolean is
75 begin
76 if Token = Tok_With then
77 return True;
78
79 -- Check for WHEN used in place of WITH
80
81 elsif Token = Tok_When then
82 declare
83 Scan_State : Saved_Scan_State;
84
85 begin
86 Save_Scan_State (Scan_State);
87 Scan; -- past WHEN
88
89 if Token = Tok_Identifier
90 and then Get_Aspect_Id (Token_Name) /= No_Aspect
91 then
92 Error_Msg_SC ("WHEN should be WITH");
93 Restore_Scan_State (Scan_State);
94 return True;
95
96 else
97 Restore_Scan_State (Scan_State);
98 return False;
99 end if;
100 end;
101
102 else
103 return False;
104 end if;
105 end With_Present;
106
a905304c
AC
107 -- Start of processing for Aspect_Specifications_Present
108
0f1a6a0b 109 begin
eaba57fb 110 -- Definitely must have WITH to consider aspect specs to be present
39231404 111
eaba57fb
RD
112 -- Note that this means that if we have a semicolon, we immediately
113 -- return False. There is a case in which this is not optimal, namely
114 -- something like
0f1a6a0b 115
eaba57fb
RD
116 -- type R is new Integer;
117 -- with bla bla;
0f1a6a0b 118
eaba57fb
RD
119 -- where the semicolon is redundant, but scanning forward for it would
120 -- be too expensive. Instead we pick up the aspect specifications later
121 -- as a bogus declaration, and diagnose the semicolon at that point.
0f1a6a0b 122
ef2c20e7 123 if not With_Present then
0f1a6a0b
AC
124 return False;
125 end if;
126
ef2c20e7
AC
127 -- Have a WITH or some token that we accept as a legitimate bad attempt
128 -- at writing WITH. See if it looks like an aspect specification
0f1a6a0b
AC
129
130 Save_Scan_State (Scan_State);
ef2c20e7 131 Scan; -- past WITH (or WHEN or other bad keyword)
0f1a6a0b
AC
132
133 -- If no identifier, then consider that we definitely do not have an
134 -- aspect specification.
135
136 if Token /= Tok_Identifier then
137 Result := False;
138
a905304c
AC
139 -- This is where we pay attention to the Strict mode. Normally when
140 -- we are in Ada 2012 mode, Strict is False, and we consider that we
141 -- have an aspect specification if the identifier is an aspect name
142 -- or a likely misspelling of one (even if not followed by =>) or
143 -- the identifier is not an aspect name but is followed by =>, by
144 -- a comma, or by a semicolon. The last two cases correspond to
145 -- (misspelled) Boolean aspects with a defaulted value of True.
146 -- P_Aspect_Specifications will generate messages if the aspect
9e92ad49 147 -- specification is ill-formed.
0f1a6a0b 148
39231404 149 elsif not Strict then
a905304c
AC
150 if Get_Aspect_Id (Token_Name) /= No_Aspect
151 or else Possible_Misspelled_Aspect
152 then
0f1a6a0b
AC
153 Result := True;
154 else
155 Scan; -- past identifier
15918371
AC
156 Result := Token = Tok_Arrow or else
157 Token = Tok_Comma or else
158 Token = Tok_Semicolon;
0f1a6a0b
AC
159 end if;
160
78efd712
AC
161 -- If earlier than Ada 2012, check for valid aspect identifier (possibly
162 -- completed with 'CLASS) followed by an arrow, and consider that this
163 -- is still an aspect specification so we give an appropriate message.
0f1a6a0b
AC
164
165 else
166 if Get_Aspect_Id (Token_Name) = No_Aspect then
167 Result := False;
168
169 else
170 Scan; -- past aspect name
171
78efd712
AC
172 Result := False;
173
174 if Token = Tok_Arrow then
175 Result := True;
176
7a1f1775
AC
177 -- The identifier may be the name of a boolean aspect with a
178 -- defaulted True value. Further checks when analyzing aspect
e28072cd 179 -- specification, which may include further aspects.
7a1f1775 180
15918371 181 elsif Token = Tok_Comma or else Token = Tok_Semicolon then
7a1f1775
AC
182 Result := True;
183
78efd712
AC
184 elsif Token = Tok_Apostrophe then
185 Scan; -- past apostrophe
186
187 if Token = Tok_Identifier
188 and then Token_Name = Name_Class
189 then
190 Scan; -- past CLASS
191
192 if Token = Tok_Arrow then
193 Result := True;
194 end if;
195 end if;
196 end if;
0f1a6a0b 197
78efd712 198 if Result then
0f1a6a0b 199 Restore_Scan_State (Scan_State);
fb620b37 200 Error_Msg_Ada_2012_Feature ("|aspect specification", Token_Ptr);
0f1a6a0b
AC
201 return True;
202 end if;
203 end if;
204 end if;
205
206 Restore_Scan_State (Scan_State);
207 return Result;
208 end Aspect_Specifications_Present;
209
473e20df
AC
210 -------------------------------
211 -- Get_Aspect_Specifications --
212 -------------------------------
213
214 function Get_Aspect_Specifications
215 (Semicolon : Boolean := True) return List_Id
216 is
473e20df 217 A_Id : Aspect_Id;
adb252d8
AC
218 Aspect : Node_Id;
219 Aspects : List_Id;
473e20df
AC
220 OK : Boolean;
221
bc3c2eca
AC
222 Opt : Boolean;
223 -- True if current aspect takes an optional argument
224
473e20df
AC
225 begin
226 Aspects := Empty_List;
227
228 -- Check if aspect specification present
229
230 if not Aspect_Specifications_Present then
231 if Semicolon then
232 TF_Semicolon;
233 end if;
234
235 return Aspects;
236 end if;
237
ef2c20e7 238 Scan; -- past WITH (or possible WHEN after error)
473e20df
AC
239 Aspects := Empty_List;
240
aa3efecd
AC
241 -- Loop to scan aspects
242
473e20df
AC
243 loop
244 OK := True;
245
adb252d8
AC
246 -- The aspect mark is not an identifier
247
473e20df
AC
248 if Token /= Tok_Identifier then
249 Error_Msg_SC ("aspect identifier expected");
250
adb252d8
AC
251 -- Skip the whole aspect specification list
252
473e20df
AC
253 if Semicolon then
254 Resync_Past_Semicolon;
255 end if;
256
257 return Aspects;
258 end if;
259
473e20df
AC
260 A_Id := Get_Aspect_Id (Token_Name);
261 Aspect :=
262 Make_Aspect_Specification (Token_Ptr,
263 Identifier => Token_Node);
264
adb252d8 265 -- The aspect mark is not recognized
473e20df
AC
266
267 if A_Id = No_Aspect then
9d2a2071 268 Error_Msg_N ("& is not a valid aspect identifier", Token_Node);
adb252d8 269 OK := False;
473e20df
AC
270
271 -- Check bad spelling
272
f2c992d9
AC
273 for J in Aspect_Id_Exclude_No_Aspect loop
274 if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
473e20df 275 Error_Msg_Name_1 := Aspect_Names (J);
9d2a2071
AC
276 Error_Msg_N -- CODEFIX
277 ("\possible misspelling of%", Token_Node);
473e20df
AC
278 exit;
279 end if;
280 end loop;
281
282 Scan; -- past incorrect identifier
283
284 if Token = Tok_Apostrophe then
adb252d8 285 Scan; -- past apostrophe
473e20df
AC
286 Scan; -- past presumably CLASS
287 end if;
288
adb252d8
AC
289 -- Attempt to parse the aspect definition by assuming it is an
290 -- expression.
291
473e20df 292 if Token = Tok_Arrow then
adb252d8 293 Scan; -- past arrow
473e20df 294 Set_Expression (Aspect, P_Expression);
adb252d8 295
9d2a2071
AC
296 -- If we have a correct terminator (comma or semicolon, or a
297 -- reasonable likely missing comma), then just proceed.
473e20df 298
9d2a2071
AC
299 elsif Token = Tok_Comma or else
300 Token = Tok_Semicolon or else
301 Token = Tok_Identifier
302 then
adb252d8
AC
303 null;
304
305 -- Otherwise the aspect contains a junk definition
473e20df
AC
306
307 else
308 if Semicolon then
309 Resync_Past_Semicolon;
310 end if;
311
312 return Aspects;
313 end if;
314
adb252d8 315 -- Aspect mark is OK
473e20df
AC
316
317 else
318 Scan; -- past identifier
bc3c2eca
AC
319 Opt := Aspect_Argument (A_Id) = Optional_Expression
320 or else
321 Aspect_Argument (A_Id) = Optional_Name;
473e20df
AC
322
323 -- Check for 'Class present
324
325 if Token = Tok_Apostrophe then
adb252d8 326 if Class_Aspect_OK (A_Id) then
473e20df
AC
327 Scan; -- past apostrophe
328
adb252d8
AC
329 if Token = Tok_Identifier
330 and then Token_Name = Name_Class
473e20df 331 then
adb252d8
AC
332 Scan; -- past CLASS
333 Set_Class_Present (Aspect);
334 else
473e20df
AC
335 Error_Msg_SC ("Class attribute expected here");
336 OK := False;
337
338 if Token = Tok_Identifier then
339 Scan; -- past identifier not CLASS
340 end if;
473e20df 341 end if;
adb252d8
AC
342
343 -- The aspect does not allow 'Class
344
345 else
346 Error_Msg_Node_1 := Identifier (Aspect);
347 Error_Msg_SC ("aspect& does not permit attribute here");
348 OK := False;
349
350 Scan; -- past apostrophe
351 Scan; -- past presumably CLASS
473e20df
AC
352 end if;
353 end if;
354
adb252d8
AC
355 -- Check for a missing aspect definition. Aspects with optional
356 -- definitions are not considered.
473e20df 357
adb252d8 358 if Token = Tok_Comma or else Token = Tok_Semicolon then
bc3c2eca 359 if not Opt then
473e20df
AC
360 Error_Msg_Node_1 := Identifier (Aspect);
361 Error_Msg_AP ("aspect& requires an aspect definition");
362 OK := False;
363 end if;
364
bc3c2eca
AC
365 -- Here we do not have a comma or a semicolon, we are done if we
366 -- do not have an arrow and the aspect does not need an argument
adb252d8 367
bc3c2eca
AC
368 elsif Opt and then Token /= Tok_Arrow then
369 null;
370
371 -- Here we have either an arrow, or an aspect that definitely
372 -- needs an aspect definition, and we will look for one even if
373 -- no arrow is preseant.
473e20df 374
adb252d8 375 -- Otherwise we have an aspect definition
473e20df
AC
376
377 else
378 if Token = Tok_Arrow then
379 Scan; -- past arrow
380 else
381 T_Arrow;
382 OK := False;
383 end if;
384
adb252d8 385 -- Detect a common error where the non-null definition of
bf561f2b
AC
386 -- aspect Depends, Global, Refined_Depends, Refined_Global
387 -- or Refined_State lacks enclosing parentheses.
adb252d8
AC
388
389 if Token /= Tok_Left_Paren and then Token /= Tok_Null then
390
391 -- [Refined_]Depends
392
393 if A_Id = Aspect_Depends
394 or else
395 A_Id = Aspect_Refined_Depends
396 then
397 Error_Msg_SC -- CODEFIX
398 ("missing ""(""");
399 Resync_Past_Malformed_Aspect;
400
401 -- Return when the current aspect is the last in the list
402 -- of specifications and the list applies to a body.
403
404 if Token = Tok_Is then
405 return Aspects;
406 end if;
407
408 -- [Refined_]Global
409
410 elsif A_Id = Aspect_Global
411 or else
412 A_Id = Aspect_Refined_Global
413 then
414 declare
415 Scan_State : Saved_Scan_State;
416
417 begin
418 Save_Scan_State (Scan_State);
419 Scan; -- past item or mode_selector
420
421 -- Emit an error when the aspect has a mode_selector
422 -- as the moded_global_list must be parenthesized:
423 -- with Global => Output => Item
424
425 if Token = Tok_Arrow then
426 Restore_Scan_State (Scan_State);
427 Error_Msg_SC -- CODEFIX
428 ("missing ""(""");
429 Resync_Past_Malformed_Aspect;
430
431 -- Return when the current aspect is the last in
432 -- the list of specifications and the list applies
433 -- to a body.
434
435 if Token = Tok_Is then
436 return Aspects;
437 end if;
438
439 elsif Token = Tok_Comma then
440 Scan; -- past comma
441
442 -- An item followed by a comma does not need to
443 -- be parenthesized if the next token is a valid
444 -- aspect name:
445 -- with Global => Item,
446 -- Aspect => ...
447
448 if Token = Tok_Identifier
449 and then Get_Aspect_Id (Token_Name) /= No_Aspect
450 then
451 Restore_Scan_State (Scan_State);
452
453 -- Otherwise this is a list of items in which case
454 -- the list must be parenthesized.
455
456 else
457 Restore_Scan_State (Scan_State);
458 Error_Msg_SC -- CODEFIX
459 ("missing ""(""");
460 Resync_Past_Malformed_Aspect;
461
462 -- Return when the current aspect is the last
463 -- in the list of specifications and the list
464 -- applies to a body.
465
466 if Token = Tok_Is then
467 return Aspects;
468 end if;
469 end if;
470
471 -- The definition of [Refined_]Global does not need to
472 -- be parenthesized.
473
474 else
475 Restore_Scan_State (Scan_State);
476 end if;
477 end;
bf561f2b
AC
478
479 -- Refined_State
480
481 elsif A_Id = Aspect_Refined_State then
482 if Token = Tok_Identifier then
483 declare
484 Scan_State : Saved_Scan_State;
485
486 begin
487 Save_Scan_State (Scan_State);
488 Scan; -- past state
489
490 -- The refinement contains a constituent, the whole
491 -- argument of Refined_State must be parenthesized.
492
493 -- with Refined_State => State => Constit
494
495 if Token = Tok_Arrow then
496 Restore_Scan_State (Scan_State);
497 Error_Msg_SC -- CODEFIX
498 ("missing ""(""");
499 Resync_Past_Malformed_Aspect;
500
501 -- Return when the current aspect is the last
502 -- in the list of specifications and the list
503 -- applies to a body.
504
505 if Token = Tok_Is then
506 return Aspects;
507 end if;
508
509 -- The refinement lacks constituents. Do not flag
510 -- this case as the error would be misleading. The
511 -- diagnostic is left to the analysis.
512
513 -- with Refined_State => State
514
515 else
516 Restore_Scan_State (Scan_State);
517 end if;
518 end;
519 end if;
adb252d8
AC
520 end if;
521 end if;
522
ed323421 523 -- Note if inside Depends or Refined_Depends aspect
aa3efecd 524
ed323421
AC
525 if A_Id = Aspect_Depends
526 or else A_Id = Aspect_Refined_Depends
527 then
aa3efecd
AC
528 Inside_Depends := True;
529 end if;
530
0bba838d
BD
531 -- Note that we have seen an Import aspect specification.
532 -- This matters only while parsing a subprogram.
533
534 if A_Id = Aspect_Import then
535 SIS_Aspect_Import_Seen := True;
536 -- Should do it only for subprograms
537 end if;
538
539 -- Parse the aspect definition depending on the expected
adb252d8
AC
540 -- argument kind.
541
80e59506 542 if Aspect_Argument (A_Id) = Name
adb252d8 543 or else Aspect_Argument (A_Id) = Optional_Name
80e59506 544 then
473e20df 545 Set_Expression (Aspect, P_Name);
80e59506 546
473e20df 547 else
80e59506
AC
548 pragma Assert
549 (Aspect_Argument (A_Id) = Expression
550 or else
551 Aspect_Argument (A_Id) = Optional_Expression);
473e20df
AC
552 Set_Expression (Aspect, P_Expression);
553 end if;
aa3efecd
AC
554
555 -- Unconditionally reset flag for Inside_Depends
556
557 Inside_Depends := False;
473e20df
AC
558 end if;
559
adb252d8
AC
560 -- Add the aspect to the resulting list only when it was properly
561 -- parsed.
473e20df
AC
562
563 if OK then
564 Append (Aspect, Aspects);
565 end if;
9d2a2071 566 end if;
473e20df 567
9d2a2071
AC
568 -- Merge here after good or bad aspect (we should be at a comma
569 -- or a semicolon, but there might be other possible errors).
adb252d8 570
9d2a2071 571 -- The aspect specification list contains more than one aspect
473e20df 572
9d2a2071
AC
573 if Token = Tok_Comma then
574 Scan; -- past comma
575 goto Continue;
473e20df 576
9d2a2071
AC
577 -- Check for a missing comma between two aspects. Emit an error
578 -- and proceed to the next aspect.
473e20df 579
9d2a2071
AC
580 elsif Token = Tok_Identifier
581 and then Get_Aspect_Id (Token_Name) /= No_Aspect
582 then
583 declare
584 Scan_State : Saved_Scan_State;
473e20df 585
9d2a2071
AC
586 begin
587 Save_Scan_State (Scan_State);
588 Scan; -- past identifier
adb252d8 589
9d2a2071
AC
590 -- Attempt to detect ' or => following a potential aspect
591 -- mark.
473e20df 592
9d2a2071
AC
593 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
594 Restore_Scan_State (Scan_State);
595 Error_Msg_AP -- CODEFIX
596 ("|missing "",""");
597 goto Continue;
adb252d8 598
9d2a2071
AC
599 -- The construct following the current aspect is not an
600 -- aspect.
601
602 else
603 Restore_Scan_State (Scan_State);
604 end if;
605 end;
473e20df 606
9d2a2071
AC
607 -- Check for a mistyped semicolon in place of a comma between two
608 -- aspects. Emit an error and proceed to the next aspect.
473e20df 609
9d2a2071
AC
610 elsif Token = Tok_Semicolon then
611 declare
612 Scan_State : Saved_Scan_State;
473e20df 613
9d2a2071
AC
614 begin
615 Save_Scan_State (Scan_State);
616 Scan; -- past semicolon
473e20df 617
9d2a2071
AC
618 if Token = Tok_Identifier
619 and then Get_Aspect_Id (Token_Name) /= No_Aspect
620 then
621 Scan; -- past identifier
473e20df 622
596f7139 623 -- Attempt to detect ' or => following potential aspect mark
adb252d8 624
9d2a2071
AC
625 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
626 Restore_Scan_State (Scan_State);
627 Error_Msg_SC -- CODEFIX
628 ("|"";"" should be "",""");
629 Scan; -- past semicolon
630 goto Continue;
473e20df 631 end if;
9d2a2071 632 end if;
adb252d8 633
596f7139 634 -- Construct following the current aspect is not an aspect
adb252d8 635
9d2a2071
AC
636 Restore_Scan_State (Scan_State);
637 end;
638 end if;
473e20df 639
596f7139 640 -- Require semicolon if caller expects to scan this out
473e20df 641
9d2a2071
AC
642 if Semicolon then
643 T_Semicolon;
644 end if;
473e20df 645
9d2a2071 646 exit;
473e20df 647
9d2a2071
AC
648 <<Continue>>
649 null;
473e20df
AC
650 end loop;
651
652 return Aspects;
473e20df
AC
653 end Get_Aspect_Specifications;
654
19235870
RK
655 --------------------------------------------
656 -- 13.1 Representation Clause (also I.7) --
657 --------------------------------------------
658
659 -- REPRESENTATION_CLAUSE ::=
660 -- ATTRIBUTE_DEFINITION_CLAUSE
661 -- | ENUMERATION_REPRESENTATION_CLAUSE
662 -- | RECORD_REPRESENTATION_CLAUSE
663 -- | AT_CLAUSE
664
665 -- ATTRIBUTE_DEFINITION_CLAUSE ::=
666 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
667 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
668
669 -- Note: in Ada 83, the expression must be a simple expression
670
671 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
672
673 -- Note: in Ada 83, the expression must be a simple expression
674
675 -- ENUMERATION_REPRESENTATION_CLAUSE ::=
676 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
677
678 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
679
680 -- RECORD_REPRESENTATION_CLAUSE ::=
681 -- for first_subtype_LOCAL_NAME use
682 -- record [MOD_CLAUSE]
683 -- {COMPONENT_CLAUSE}
684 -- end record;
685
686 -- Note: for now we allow only a direct name as the local name in the
687 -- above constructs. This probably needs changing later on ???
688
689 -- The caller has checked that the initial token is FOR
690
691 -- Error recovery: cannot raise Error_Resync, if an error occurs,
692 -- the scan is repositioned past the next semicolon.
693
694 function P_Representation_Clause return Node_Id is
695 For_Loc : Source_Ptr;
696 Name_Node : Node_Id;
697 Prefix_Node : Node_Id;
698 Attr_Name : Name_Id;
699 Identifier_Node : Node_Id;
700 Rep_Clause_Node : Node_Id;
701 Expr_Node : Node_Id;
702 Record_Items : List_Id;
703
704 begin
705 For_Loc := Token_Ptr;
706 Scan; -- past FOR
707
708 -- Note that the name in a representation clause is always a simple
a90bd866 709 -- name, even in the attribute case, see AI-300 which made this so.
19235870 710
bde58e32 711 Identifier_Node := P_Identifier (C_Use);
19235870
RK
712
713 -- Check case of qualified name to give good error message
714
715 if Token = Tok_Dot then
716 Error_Msg_SC
717 ("representation clause requires simple name!");
718
719 loop
720 exit when Token /= Tok_Dot;
721 Scan; -- past dot
722 Discard_Junk_Node (P_Identifier);
723 end loop;
724 end if;
725
726 -- Attribute Definition Clause
727
728 if Token = Tok_Apostrophe then
729
730 -- Allow local names of the form a'b'.... This enables
731 -- us to parse class-wide streams attributes correctly.
732
733 Name_Node := Identifier_Node;
734 while Token = Tok_Apostrophe loop
735
736 Scan; -- past apostrophe
737
738 Identifier_Node := Token_Node;
739 Attr_Name := No_Name;
740
741 if Token = Tok_Identifier then
742 Attr_Name := Token_Name;
743
d48f3dca 744 -- Note that the parser must complain in case of an internal
cc6c4d62 745 -- attribute name that comes from source since internal names
d48f3dca
AC
746 -- are meant to be used only by the compiler.
747
748 if not Is_Attribute_Name (Attr_Name)
c1107fa3
AC
749 and then (not Is_Internal_Attribute_Name (Attr_Name)
750 or else Comes_From_Source (Token_Node))
d48f3dca 751 then
19235870
RK
752 Signal_Bad_Attribute;
753 end if;
754
755 if Style_Check then
756 Style.Check_Attribute_Name (False);
757 end if;
758
759 -- Here for case of attribute designator is not an identifier
760
761 else
762 if Token = Tok_Delta then
763 Attr_Name := Name_Delta;
764
765 elsif Token = Tok_Digits then
766 Attr_Name := Name_Digits;
767
768 elsif Token = Tok_Access then
769 Attr_Name := Name_Access;
770
771 else
772 Error_Msg_AP ("attribute designator expected");
773 raise Error_Resync;
774 end if;
775
776 if Style_Check then
777 Style.Check_Attribute_Name (True);
778 end if;
779 end if;
780
572f38e4
AC
781 -- Here we have an OK attribute scanned, and the corresponding
782 -- Attribute identifier node is stored in Ident_Node.
19235870
RK
783
784 Prefix_Node := Name_Node;
785 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
786 Set_Prefix (Name_Node, Prefix_Node);
787 Set_Attribute_Name (Name_Node, Attr_Name);
788 Scan;
572f38e4
AC
789
790 -- Check for Address clause which needs to be marked for use in
791 -- optimizing performance of Exp_Util.Following_Address_Clause.
792
793 if Attr_Name = Name_Address
794 and then Nkind (Prefix_Node) = N_Identifier
795 then
a921e83c 796 Set_Name_Table_Boolean1 (Chars (Prefix_Node), True);
572f38e4 797 end if;
19235870
RK
798 end loop;
799
800 Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
801 Set_Name (Rep_Clause_Node, Prefix_Node);
802 Set_Chars (Rep_Clause_Node, Attr_Name);
803 T_Use;
804
805 Expr_Node := P_Expression_No_Right_Paren;
806 Check_Simple_Expression_In_Ada_83 (Expr_Node);
807 Set_Expression (Rep_Clause_Node, Expr_Node);
808
809 else
810 TF_Use;
811 Rep_Clause_Node := Empty;
812
813 -- AT follows USE (At Clause)
814
815 if Token = Tok_At then
816 Scan; -- past AT
817 Rep_Clause_Node := New_Node (N_At_Clause, For_Loc);
818 Set_Identifier (Rep_Clause_Node, Identifier_Node);
819 Expr_Node := P_Expression_No_Right_Paren;
820 Check_Simple_Expression_In_Ada_83 (Expr_Node);
821 Set_Expression (Rep_Clause_Node, Expr_Node);
822
572f38e4
AC
823 -- Mark occurrence of address clause (used to optimize performance
824 -- of Exp_Util.Following_Address_Clause).
825
a921e83c 826 Set_Name_Table_Boolean1 (Chars (Identifier_Node), True);
572f38e4 827
19235870
RK
828 -- RECORD follows USE (Record Representation Clause)
829
830 elsif Token = Tok_Record then
831 Record_Items := P_Pragmas_Opt;
832 Rep_Clause_Node :=
833 New_Node (N_Record_Representation_Clause, For_Loc);
834 Set_Identifier (Rep_Clause_Node, Identifier_Node);
835
836 Push_Scope_Stack;
0bba838d
BD
837 Scopes (Scope.Last).Etyp := E_Record;
838 Scopes (Scope.Last).Ecol := Start_Column;
839 Scopes (Scope.Last).Sloc := Token_Ptr;
19235870
RK
840 Scan; -- past RECORD
841 Record_Items := P_Pragmas_Opt;
842
843 -- Possible Mod Clause
844
845 if Token = Tok_At then
846 Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause);
847 Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items);
848 Record_Items := P_Pragmas_Opt;
849 end if;
850
851 if No (Record_Items) then
852 Record_Items := New_List;
853 end if;
854
855 Set_Component_Clauses (Rep_Clause_Node, Record_Items);
856
857 -- Loop through component clauses
858
859 loop
860 if Token not in Token_Class_Name then
861 exit when Check_End;
862 end if;
863
864 Append (P_Component_Clause, Record_Items);
865 P_Pragmas_Opt (Record_Items);
866 end loop;
867
868 -- Left paren follows USE (Enumeration Representation Clause)
869
870 elsif Token = Tok_Left_Paren then
871 Rep_Clause_Node :=
872 New_Node (N_Enumeration_Representation_Clause, For_Loc);
873 Set_Identifier (Rep_Clause_Node, Identifier_Node);
874 Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate);
875
876 -- Some other token follows FOR (invalid representation clause)
877
878 else
879 Error_Msg_SC ("invalid representation clause");
880 raise Error_Resync;
881 end if;
882 end if;
883
884 TF_Semicolon;
885 return Rep_Clause_Node;
886
887 exception
888 when Error_Resync =>
889 Resync_Past_Semicolon;
890 return Error;
891
892 end P_Representation_Clause;
893
894 ----------------------
895 -- 13.1 Local Name --
896 ----------------------
897
898 -- Local name is always parsed by its parent. In the case of its use in
899 -- pragmas, the check for a local name is handled in Par.Prag and allows
900 -- all the possible forms of local name. For the uses in chapter 13, we
901 -- currently only allow a direct name, but this should probably change???
902
903 ---------------------------
904 -- 13.1 At Clause (I.7) --
905 ---------------------------
906
907 -- Parsed by P_Representation_Clause (13.1)
908
909 ---------------------------------------
910 -- 13.3 Attribute Definition Clause --
911 ---------------------------------------
912
913 -- Parsed by P_Representation_Clause (13.1)
914
308e6f3a
RW
915 --------------------------------
916 -- 13.1 Aspect Specification --
917 --------------------------------
0f1a6a0b
AC
918
919 -- ASPECT_SPECIFICATION ::=
1c163178 920 -- with ASPECT_MARK [=> ASPECT_DEFINITION] {,
0f1a6a0b
AC
921 -- ASPECT_MARK [=> ASPECT_DEFINITION] }
922
923 -- ASPECT_MARK ::= aspect_IDENTIFIER['Class]
924
925 -- ASPECT_DEFINITION ::= NAME | EXPRESSION
926
927 -- Error recovery: cannot raise Error_Resync
928
1c54829e
AC
929 procedure P_Aspect_Specifications
930 (Decl : Node_Id;
931 Semicolon : Boolean := True)
932 is
0f1a6a0b 933 Aspects : List_Id;
718deaf1 934 Ptr : Source_Ptr;
0f1a6a0b
AC
935
936 begin
0f1a6a0b
AC
937 -- Aspect Specification is present
938
718deaf1 939 Ptr := Token_Ptr;
0f1a6a0b 940
1c163178 941 -- Here we have an aspect specification to scan, note that we don't
0f1a6a0b
AC
942 -- set the flag till later, because it may turn out that we have no
943 -- valid aspects in the list.
944
473e20df 945 Aspects := Get_Aspect_Specifications (Semicolon);
0f1a6a0b 946
9f90d123 947 -- Here if aspects present
0f1a6a0b
AC
948
949 if Is_Non_Empty_List (Aspects) then
9f90d123
AC
950
951 -- If Decl is Empty, we just ignore the aspects (the caller in this
952 -- case has always issued an appropriate error message).
953
954 if Decl = Empty then
955 null;
956
957 -- If Decl is Error, we ignore the aspects, and issue a message
958
fa1072e7
GL
959 elsif Decl = Error
960 or else not Permits_Aspect_Specifications (Decl)
961 then
718deaf1 962 Error_Msg ("aspect specifications not allowed here", Ptr);
9f90d123
AC
963
964 -- Here aspects are allowed, and we store them
965
718deaf1
AC
966 else
967 Set_Parent (Aspects, Decl);
968 Set_Aspect_Specifications (Decl, Aspects);
969 end if;
0f1a6a0b
AC
970 end if;
971 end P_Aspect_Specifications;
972
19235870
RK
973 ---------------------------------------------
974 -- 13.4 Enumeration Representation Clause --
975 ---------------------------------------------
976
977 -- Parsed by P_Representation_Clause (13.1)
978
979 ---------------------------------
980 -- 13.4 Enumeration Aggregate --
981 ---------------------------------
982
983 -- Parsed by P_Representation_Clause (13.1)
984
985 ------------------------------------------
986 -- 13.5.1 Record Representation Clause --
987 ------------------------------------------
988
989 -- Parsed by P_Representation_Clause (13.1)
990
991 ------------------------------
992 -- 13.5.1 Mod Clause (I.8) --
993 ------------------------------
994
995 -- MOD_CLAUSE ::= at mod static_EXPRESSION;
996
997 -- Note: in Ada 83, the expression must be a simple expression
998
999 -- The caller has checked that the initial Token is AT
1000
1001 -- Error recovery: cannot raise Error_Resync
1002
1003 -- Note: the caller is responsible for setting the Pragmas_Before field
1004
1005 function P_Mod_Clause return Node_Id is
1006 Mod_Node : Node_Id;
1007 Expr_Node : Node_Id;
1008
1009 begin
1010 Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
1011 Scan; -- past AT
1012 T_Mod;
1013 Expr_Node := P_Expression_No_Right_Paren;
1014 Check_Simple_Expression_In_Ada_83 (Expr_Node);
1015 Set_Expression (Mod_Node, Expr_Node);
1016 TF_Semicolon;
1017 return Mod_Node;
1018 end P_Mod_Clause;
1019
1020 ------------------------------
1021 -- 13.5.1 Component Clause --
1022 ------------------------------
1023
1024 -- COMPONENT_CLAUSE ::=
1025 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
1026 -- range FIRST_BIT .. LAST_BIT;
1027
1028 -- COMPONENT_CLAUSE_COMPONENT_NAME ::=
1029 -- component_DIRECT_NAME
1030 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
1031 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
1032
1033 -- POSITION ::= static_EXPRESSION
1034
1035 -- Note: in Ada 83, the expression must be a simple expression
1036
1037 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION
1038 -- LAST_BIT ::= static_SIMPLE_EXPRESSION
1039
1040 -- Note: the AARM V2.0 grammar has an error at this point, it uses
1041 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
1042
1043 -- Error recovery: cannot raise Error_Resync
1044
1045 function P_Component_Clause return Node_Id is
1046 Component_Node : Node_Id;
1047 Comp_Name : Node_Id;
1048 Expr_Node : Node_Id;
1049
1050 begin
1051 Component_Node := New_Node (N_Component_Clause, Token_Ptr);
1052 Comp_Name := P_Name;
1053
1054 if Nkind (Comp_Name) = N_Identifier
1055 or else Nkind (Comp_Name) = N_Attribute_Reference
1056 then
1057 Set_Component_Name (Component_Node, Comp_Name);
1058 else
1059 Error_Msg_N
1060 ("component name must be direct name or attribute", Comp_Name);
1061 Set_Component_Name (Component_Node, Error);
1062 end if;
1063
1064 Set_Sloc (Component_Node, Token_Ptr);
1065 T_At;
1066 Expr_Node := P_Expression_No_Right_Paren;
1067 Check_Simple_Expression_In_Ada_83 (Expr_Node);
1068 Set_Position (Component_Node, Expr_Node);
1069 T_Range;
1070 Expr_Node := P_Expression_No_Right_Paren;
1071 Check_Simple_Expression_In_Ada_83 (Expr_Node);
1072 Set_First_Bit (Component_Node, Expr_Node);
1073 T_Dot_Dot;
1074 Expr_Node := P_Expression_No_Right_Paren;
1075 Check_Simple_Expression_In_Ada_83 (Expr_Node);
1076 Set_Last_Bit (Component_Node, Expr_Node);
1077 TF_Semicolon;
1078 return Component_Node;
1079 end P_Component_Clause;
1080
1081 ----------------------
1082 -- 13.5.1 Position --
1083 ----------------------
1084
1085 -- Parsed by P_Component_Clause (13.5.1)
1086
1087 -----------------------
1088 -- 13.5.1 First Bit --
1089 -----------------------
1090
1091 -- Parsed by P_Component_Clause (13.5.1)
1092
1093 ----------------------
1094 -- 13.5.1 Last Bit --
1095 ----------------------
1096
1097 -- Parsed by P_Component_Clause (13.5.1)
1098
1099 --------------------------
1100 -- 13.8 Code Statement --
1101 --------------------------
1102
1103 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
1104
1105 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
1106 -- single argument, and the scan points to the apostrophe.
1107
1108 -- Error recovery: can raise Error_Resync
1109
1110 function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
1111 Node1 : Node_Id;
1112
1113 begin
1114 Scan; -- past apostrophe
1115
1116 -- If left paren, then we have a possible code statement
1117
1118 if Token = Tok_Left_Paren then
1119 Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark));
1120 Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark));
1121 TF_Semicolon;
1122 return Node1;
1123
1124 -- Otherwise we have an illegal range attribute. Note that P_Name
1125 -- ensures that Token = Tok_Range is the only possibility left here.
1126
29ba9f52 1127 else
19235870
RK
1128 Error_Msg_SC ("RANGE attribute illegal here!");
1129 raise Error_Resync;
1130 end if;
19235870
RK
1131 end P_Code_Statement;
1132
1133end Ch13;