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