PR tree-optimization/82929
[official-gcc.git] / gcc / ada / par-ch13.adb
bloba238d66d9cbe0964972b490fd65a057c94028774
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-2017, 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 ------------------------------------------------------------------------------
26 pragma Style_Checks (All_Checks);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
30 separate (Par)
31 package body Ch13 is
33 -- Local functions, used only in this chapter
35 function P_Component_Clause return Node_Id;
36 function P_Mod_Clause return Node_Id;
38 -----------------------------------
39 -- Aspect_Specifications_Present --
40 -----------------------------------
42 function Aspect_Specifications_Present
43 (Strict : Boolean := Ada_Version < Ada_2012) return Boolean
45 Scan_State : Saved_Scan_State;
46 Result : Boolean;
48 function Possible_Misspelled_Aspect return Boolean;
49 -- Returns True, if Token_Name is a misspelling of some aspect name
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.
55 --------------------------------
56 -- Possible_Misspelled_Aspect --
57 --------------------------------
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;
67 return False;
68 end Possible_Misspelled_Aspect;
70 ------------------
71 -- With_Present --
72 ------------------
74 function With_Present return Boolean is
75 begin
76 if Token = Tok_With then
77 return True;
79 -- Check for WHEN used in place of WITH
81 elsif Token = Tok_When then
82 declare
83 Scan_State : Saved_Scan_State;
85 begin
86 Save_Scan_State (Scan_State);
87 Scan; -- past WHEN
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;
96 else
97 Restore_Scan_State (Scan_State);
98 return False;
99 end if;
100 end;
102 else
103 return False;
104 end if;
105 end With_Present;
107 -- Start of processing for Aspect_Specifications_Present
109 begin
110 -- Definitely must have WITH to consider aspect specs to be present
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
116 -- type R is new Integer;
117 -- with bla bla;
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.
123 if not With_Present then
124 return False;
125 end if;
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
130 Save_Scan_State (Scan_State);
131 Scan; -- past WITH (or WHEN or other bad keyword)
133 -- If no identifier, then consider that we definitely do not have an
134 -- aspect specification.
136 if Token /= Tok_Identifier then
137 Result := False;
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
147 -- specification is ill-formed.
149 elsif not Strict then
150 if Get_Aspect_Id (Token_Name) /= No_Aspect
151 or else Possible_Misspelled_Aspect
152 then
153 Result := True;
154 else
155 Scan; -- past identifier
156 Result := Token = Tok_Arrow or else
157 Token = Tok_Comma or else
158 Token = Tok_Semicolon;
159 end if;
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.
165 else
166 if Get_Aspect_Id (Token_Name) = No_Aspect then
167 Result := False;
169 else
170 Scan; -- past aspect name
172 Result := False;
174 if Token = Tok_Arrow then
175 Result := True;
177 -- The identifier may be the name of a boolean aspect with a
178 -- defaulted True value. Further checks when analyzing aspect
179 -- specification, which may include further aspects.
181 elsif Token = Tok_Comma or else Token = Tok_Semicolon then
182 Result := True;
184 elsif Token = Tok_Apostrophe then
185 Scan; -- past apostrophe
187 if Token = Tok_Identifier
188 and then Token_Name = Name_Class
189 then
190 Scan; -- past CLASS
192 if Token = Tok_Arrow then
193 Result := True;
194 end if;
195 end if;
196 end if;
198 if Result then
199 Restore_Scan_State (Scan_State);
200 Error_Msg_Ada_2012_Feature ("|aspect specification", Token_Ptr);
201 return True;
202 end if;
203 end if;
204 end if;
206 Restore_Scan_State (Scan_State);
207 return Result;
208 end Aspect_Specifications_Present;
210 -------------------------------
211 -- Get_Aspect_Specifications --
212 -------------------------------
214 function Get_Aspect_Specifications
215 (Semicolon : Boolean := True) return List_Id
217 A_Id : Aspect_Id;
218 Aspect : Node_Id;
219 Aspects : List_Id;
220 OK : Boolean;
222 Opt : Boolean;
223 -- True if current aspect takes an optional argument
225 begin
226 Aspects := Empty_List;
228 -- Check if aspect specification present
230 if not Aspect_Specifications_Present then
231 if Semicolon then
232 TF_Semicolon;
233 end if;
235 return Aspects;
236 end if;
238 Scan; -- past WITH (or possible WHEN after error)
239 Aspects := Empty_List;
241 -- Loop to scan aspects
243 loop
244 OK := True;
246 -- The aspect mark is not an identifier
248 if Token /= Tok_Identifier then
249 Error_Msg_SC ("aspect identifier expected");
251 -- Skip the whole aspect specification list
253 if Semicolon then
254 Resync_Past_Semicolon;
255 end if;
257 return Aspects;
258 end if;
260 A_Id := Get_Aspect_Id (Token_Name);
261 Aspect :=
262 Make_Aspect_Specification (Token_Ptr,
263 Identifier => Token_Node);
265 -- The aspect mark is not recognized
267 if A_Id = No_Aspect then
268 Error_Msg_N ("& is not a valid aspect identifier", Token_Node);
269 OK := False;
271 -- Check bad spelling
273 for J in Aspect_Id_Exclude_No_Aspect loop
274 if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
275 Error_Msg_Name_1 := Aspect_Names (J);
276 Error_Msg_N -- CODEFIX
277 ("\possible misspelling of%", Token_Node);
278 exit;
279 end if;
280 end loop;
282 Scan; -- past incorrect identifier
284 if Token = Tok_Apostrophe then
285 Scan; -- past apostrophe
286 Scan; -- past presumably CLASS
287 end if;
289 -- Attempt to parse the aspect definition by assuming it is an
290 -- expression.
292 if Token = Tok_Arrow then
293 Scan; -- past arrow
294 Set_Expression (Aspect, P_Expression);
296 -- If we have a correct terminator (comma or semicolon, or a
297 -- reasonable likely missing comma), then just proceed.
299 elsif Token = Tok_Comma or else
300 Token = Tok_Semicolon or else
301 Token = Tok_Identifier
302 then
303 null;
305 -- Otherwise the aspect contains a junk definition
307 else
308 if Semicolon then
309 Resync_Past_Semicolon;
310 end if;
312 return Aspects;
313 end if;
315 -- Aspect mark is OK
317 else
318 Scan; -- past identifier
319 Opt := Aspect_Argument (A_Id) = Optional_Expression
320 or else
321 Aspect_Argument (A_Id) = Optional_Name;
323 -- Check for 'Class present
325 if Token = Tok_Apostrophe then
326 if Class_Aspect_OK (A_Id) then
327 Scan; -- past apostrophe
329 if Token = Tok_Identifier
330 and then Token_Name = Name_Class
331 then
332 Scan; -- past CLASS
333 Set_Class_Present (Aspect);
334 else
335 Error_Msg_SC ("Class attribute expected here");
336 OK := False;
338 if Token = Tok_Identifier then
339 Scan; -- past identifier not CLASS
340 end if;
341 end if;
343 -- The aspect does not allow 'Class
345 else
346 Error_Msg_Node_1 := Identifier (Aspect);
347 Error_Msg_SC ("aspect& does not permit attribute here");
348 OK := False;
350 Scan; -- past apostrophe
351 Scan; -- past presumably CLASS
352 end if;
353 end if;
355 -- Check for a missing aspect definition. Aspects with optional
356 -- definitions are not considered.
358 if Token = Tok_Comma or else Token = Tok_Semicolon then
359 if not Opt then
360 Error_Msg_Node_1 := Identifier (Aspect);
361 Error_Msg_AP ("aspect& requires an aspect definition");
362 OK := False;
363 end if;
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
368 elsif Opt and then Token /= Tok_Arrow then
369 null;
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.
375 -- Otherwise we have an aspect definition
377 else
378 if Token = Tok_Arrow then
379 Scan; -- past arrow
380 else
381 T_Arrow;
382 OK := False;
383 end if;
385 -- Detect a common error where the non-null definition of
386 -- aspect Depends, Global, Refined_Depends, Refined_Global
387 -- or Refined_State lacks enclosing parentheses.
389 if Token /= Tok_Left_Paren and then Token /= Tok_Null then
391 -- [Refined_]Depends
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;
401 -- Return when the current aspect is the last in the list
402 -- of specifications and the list applies to a body.
404 if Token = Tok_Is then
405 return Aspects;
406 end if;
408 -- [Refined_]Global
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;
417 begin
418 Save_Scan_State (Scan_State);
419 Scan; -- past item or mode_selector
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
425 if Token = Tok_Arrow then
426 Restore_Scan_State (Scan_State);
427 Error_Msg_SC -- CODEFIX
428 ("missing ""(""");
429 Resync_Past_Malformed_Aspect;
431 -- Return when the current aspect is the last in
432 -- the list of specifications and the list applies
433 -- to a body.
435 if Token = Tok_Is then
436 return Aspects;
437 end if;
439 elsif Token = Tok_Comma then
440 Scan; -- past comma
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 => ...
448 if Token = Tok_Identifier
449 and then Get_Aspect_Id (Token_Name) /= No_Aspect
450 then
451 Restore_Scan_State (Scan_State);
453 -- Otherwise this is a list of items in which case
454 -- the list must be parenthesized.
456 else
457 Restore_Scan_State (Scan_State);
458 Error_Msg_SC -- CODEFIX
459 ("missing ""(""");
460 Resync_Past_Malformed_Aspect;
462 -- Return when the current aspect is the last
463 -- in the list of specifications and the list
464 -- applies to a body.
466 if Token = Tok_Is then
467 return Aspects;
468 end if;
469 end if;
471 -- The definition of [Refined_]Global does not need to
472 -- be parenthesized.
474 else
475 Restore_Scan_State (Scan_State);
476 end if;
477 end;
479 -- Refined_State
481 elsif A_Id = Aspect_Refined_State then
482 if Token = Tok_Identifier then
483 declare
484 Scan_State : Saved_Scan_State;
486 begin
487 Save_Scan_State (Scan_State);
488 Scan; -- past state
490 -- The refinement contains a constituent, the whole
491 -- argument of Refined_State must be parenthesized.
493 -- with Refined_State => State => Constit
495 if Token = Tok_Arrow then
496 Restore_Scan_State (Scan_State);
497 Error_Msg_SC -- CODEFIX
498 ("missing ""(""");
499 Resync_Past_Malformed_Aspect;
501 -- Return when the current aspect is the last
502 -- in the list of specifications and the list
503 -- applies to a body.
505 if Token = Tok_Is then
506 return Aspects;
507 end if;
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.
513 -- with Refined_State => State
515 else
516 Restore_Scan_State (Scan_State);
517 end if;
518 end;
519 end if;
520 end if;
521 end if;
523 -- Note if inside Depends or Refined_Depends aspect
525 if A_Id = Aspect_Depends
526 or else A_Id = Aspect_Refined_Depends
527 then
528 Inside_Depends := True;
529 end if;
531 -- Parse the aspect definition depening on the expected
532 -- argument kind.
534 if Aspect_Argument (A_Id) = Name
535 or else Aspect_Argument (A_Id) = Optional_Name
536 then
537 Set_Expression (Aspect, P_Name);
539 else
540 pragma Assert
541 (Aspect_Argument (A_Id) = Expression
542 or else
543 Aspect_Argument (A_Id) = Optional_Expression);
544 Set_Expression (Aspect, P_Expression);
545 end if;
547 -- Unconditionally reset flag for Inside_Depends
549 Inside_Depends := False;
550 end if;
552 -- Add the aspect to the resulting list only when it was properly
553 -- parsed.
555 if OK then
556 Append (Aspect, Aspects);
557 end if;
558 end if;
560 -- Merge here after good or bad aspect (we should be at a comma
561 -- or a semicolon, but there might be other possible errors).
563 -- The aspect specification list contains more than one aspect
565 if Token = Tok_Comma then
566 Scan; -- past comma
567 goto Continue;
569 -- Check for a missing comma between two aspects. Emit an error
570 -- and proceed to the next aspect.
572 elsif Token = Tok_Identifier
573 and then Get_Aspect_Id (Token_Name) /= No_Aspect
574 then
575 declare
576 Scan_State : Saved_Scan_State;
578 begin
579 Save_Scan_State (Scan_State);
580 Scan; -- past identifier
582 -- Attempt to detect ' or => following a potential aspect
583 -- mark.
585 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
586 Restore_Scan_State (Scan_State);
587 Error_Msg_AP -- CODEFIX
588 ("|missing "",""");
589 goto Continue;
591 -- The construct following the current aspect is not an
592 -- aspect.
594 else
595 Restore_Scan_State (Scan_State);
596 end if;
597 end;
599 -- Check for a mistyped semicolon in place of a comma between two
600 -- aspects. Emit an error and proceed to the next aspect.
602 elsif Token = Tok_Semicolon then
603 declare
604 Scan_State : Saved_Scan_State;
606 begin
607 Save_Scan_State (Scan_State);
608 Scan; -- past semicolon
610 if Token = Tok_Identifier
611 and then Get_Aspect_Id (Token_Name) /= No_Aspect
612 then
613 Scan; -- past identifier
615 -- Attempt to detect ' or => following potential aspect mark
617 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
618 Restore_Scan_State (Scan_State);
619 Error_Msg_SC -- CODEFIX
620 ("|"";"" should be "",""");
621 Scan; -- past semicolon
622 goto Continue;
623 end if;
624 end if;
626 -- Construct following the current aspect is not an aspect
628 Restore_Scan_State (Scan_State);
629 end;
630 end if;
632 -- Require semicolon if caller expects to scan this out
634 if Semicolon then
635 T_Semicolon;
636 end if;
638 exit;
640 <<Continue>>
641 null;
642 end loop;
644 return Aspects;
645 end Get_Aspect_Specifications;
647 --------------------------------------------
648 -- 13.1 Representation Clause (also I.7) --
649 --------------------------------------------
651 -- REPRESENTATION_CLAUSE ::=
652 -- ATTRIBUTE_DEFINITION_CLAUSE
653 -- | ENUMERATION_REPRESENTATION_CLAUSE
654 -- | RECORD_REPRESENTATION_CLAUSE
655 -- | AT_CLAUSE
657 -- ATTRIBUTE_DEFINITION_CLAUSE ::=
658 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
659 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
661 -- Note: in Ada 83, the expression must be a simple expression
663 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
665 -- Note: in Ada 83, the expression must be a simple expression
667 -- ENUMERATION_REPRESENTATION_CLAUSE ::=
668 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
670 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
672 -- RECORD_REPRESENTATION_CLAUSE ::=
673 -- for first_subtype_LOCAL_NAME use
674 -- record [MOD_CLAUSE]
675 -- {COMPONENT_CLAUSE}
676 -- end record;
678 -- Note: for now we allow only a direct name as the local name in the
679 -- above constructs. This probably needs changing later on ???
681 -- The caller has checked that the initial token is FOR
683 -- Error recovery: cannot raise Error_Resync, if an error occurs,
684 -- the scan is repositioned past the next semicolon.
686 function P_Representation_Clause return Node_Id is
687 For_Loc : Source_Ptr;
688 Name_Node : Node_Id;
689 Prefix_Node : Node_Id;
690 Attr_Name : Name_Id;
691 Identifier_Node : Node_Id;
692 Rep_Clause_Node : Node_Id;
693 Expr_Node : Node_Id;
694 Record_Items : List_Id;
696 begin
697 For_Loc := Token_Ptr;
698 Scan; -- past FOR
700 -- Note that the name in a representation clause is always a simple
701 -- name, even in the attribute case, see AI-300 which made this so.
703 Identifier_Node := P_Identifier (C_Use);
705 -- Check case of qualified name to give good error message
707 if Token = Tok_Dot then
708 Error_Msg_SC
709 ("representation clause requires simple name!");
711 loop
712 exit when Token /= Tok_Dot;
713 Scan; -- past dot
714 Discard_Junk_Node (P_Identifier);
715 end loop;
716 end if;
718 -- Attribute Definition Clause
720 if Token = Tok_Apostrophe then
722 -- Allow local names of the form a'b'.... This enables
723 -- us to parse class-wide streams attributes correctly.
725 Name_Node := Identifier_Node;
726 while Token = Tok_Apostrophe loop
728 Scan; -- past apostrophe
730 Identifier_Node := Token_Node;
731 Attr_Name := No_Name;
733 if Token = Tok_Identifier then
734 Attr_Name := Token_Name;
736 -- Note that the parser must complain in case of an internal
737 -- attribute name that comes from source since internal names
738 -- are meant to be used only by the compiler.
740 if not Is_Attribute_Name (Attr_Name)
741 and then (not Is_Internal_Attribute_Name (Attr_Name)
742 or else Comes_From_Source (Token_Node))
743 then
744 Signal_Bad_Attribute;
745 end if;
747 if Style_Check then
748 Style.Check_Attribute_Name (False);
749 end if;
751 -- Here for case of attribute designator is not an identifier
753 else
754 if Token = Tok_Delta then
755 Attr_Name := Name_Delta;
757 elsif Token = Tok_Digits then
758 Attr_Name := Name_Digits;
760 elsif Token = Tok_Access then
761 Attr_Name := Name_Access;
763 else
764 Error_Msg_AP ("attribute designator expected");
765 raise Error_Resync;
766 end if;
768 if Style_Check then
769 Style.Check_Attribute_Name (True);
770 end if;
771 end if;
773 -- Here we have an OK attribute scanned, and the corresponding
774 -- Attribute identifier node is stored in Ident_Node.
776 Prefix_Node := Name_Node;
777 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
778 Set_Prefix (Name_Node, Prefix_Node);
779 Set_Attribute_Name (Name_Node, Attr_Name);
780 Scan;
782 -- Check for Address clause which needs to be marked for use in
783 -- optimizing performance of Exp_Util.Following_Address_Clause.
785 if Attr_Name = Name_Address
786 and then Nkind (Prefix_Node) = N_Identifier
787 then
788 Set_Name_Table_Boolean1 (Chars (Prefix_Node), True);
789 end if;
790 end loop;
792 Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
793 Set_Name (Rep_Clause_Node, Prefix_Node);
794 Set_Chars (Rep_Clause_Node, Attr_Name);
795 T_Use;
797 Expr_Node := P_Expression_No_Right_Paren;
798 Check_Simple_Expression_In_Ada_83 (Expr_Node);
799 Set_Expression (Rep_Clause_Node, Expr_Node);
801 else
802 TF_Use;
803 Rep_Clause_Node := Empty;
805 -- AT follows USE (At Clause)
807 if Token = Tok_At then
808 Scan; -- past AT
809 Rep_Clause_Node := New_Node (N_At_Clause, For_Loc);
810 Set_Identifier (Rep_Clause_Node, Identifier_Node);
811 Expr_Node := P_Expression_No_Right_Paren;
812 Check_Simple_Expression_In_Ada_83 (Expr_Node);
813 Set_Expression (Rep_Clause_Node, Expr_Node);
815 -- Mark occurrence of address clause (used to optimize performance
816 -- of Exp_Util.Following_Address_Clause).
818 Set_Name_Table_Boolean1 (Chars (Identifier_Node), True);
820 -- RECORD follows USE (Record Representation Clause)
822 elsif Token = Tok_Record then
823 Record_Items := P_Pragmas_Opt;
824 Rep_Clause_Node :=
825 New_Node (N_Record_Representation_Clause, For_Loc);
826 Set_Identifier (Rep_Clause_Node, Identifier_Node);
828 Push_Scope_Stack;
829 Scope.Table (Scope.Last).Etyp := E_Record;
830 Scope.Table (Scope.Last).Ecol := Start_Column;
831 Scope.Table (Scope.Last).Sloc := Token_Ptr;
832 Scan; -- past RECORD
833 Record_Items := P_Pragmas_Opt;
835 -- Possible Mod Clause
837 if Token = Tok_At then
838 Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause);
839 Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items);
840 Record_Items := P_Pragmas_Opt;
841 end if;
843 if No (Record_Items) then
844 Record_Items := New_List;
845 end if;
847 Set_Component_Clauses (Rep_Clause_Node, Record_Items);
849 -- Loop through component clauses
851 loop
852 if Token not in Token_Class_Name then
853 exit when Check_End;
854 end if;
856 Append (P_Component_Clause, Record_Items);
857 P_Pragmas_Opt (Record_Items);
858 end loop;
860 -- Left paren follows USE (Enumeration Representation Clause)
862 elsif Token = Tok_Left_Paren then
863 Rep_Clause_Node :=
864 New_Node (N_Enumeration_Representation_Clause, For_Loc);
865 Set_Identifier (Rep_Clause_Node, Identifier_Node);
866 Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate);
868 -- Some other token follows FOR (invalid representation clause)
870 else
871 Error_Msg_SC ("invalid representation clause");
872 raise Error_Resync;
873 end if;
874 end if;
876 TF_Semicolon;
877 return Rep_Clause_Node;
879 exception
880 when Error_Resync =>
881 Resync_Past_Semicolon;
882 return Error;
884 end P_Representation_Clause;
886 ----------------------
887 -- 13.1 Local Name --
888 ----------------------
890 -- Local name is always parsed by its parent. In the case of its use in
891 -- pragmas, the check for a local name is handled in Par.Prag and allows
892 -- all the possible forms of local name. For the uses in chapter 13, we
893 -- currently only allow a direct name, but this should probably change???
895 ---------------------------
896 -- 13.1 At Clause (I.7) --
897 ---------------------------
899 -- Parsed by P_Representation_Clause (13.1)
901 ---------------------------------------
902 -- 13.3 Attribute Definition Clause --
903 ---------------------------------------
905 -- Parsed by P_Representation_Clause (13.1)
907 --------------------------------
908 -- 13.1 Aspect Specification --
909 --------------------------------
911 -- ASPECT_SPECIFICATION ::=
912 -- with ASPECT_MARK [=> ASPECT_DEFINITION] {,
913 -- ASPECT_MARK [=> ASPECT_DEFINITION] }
915 -- ASPECT_MARK ::= aspect_IDENTIFIER['Class]
917 -- ASPECT_DEFINITION ::= NAME | EXPRESSION
919 -- Error recovery: cannot raise Error_Resync
921 procedure P_Aspect_Specifications
922 (Decl : Node_Id;
923 Semicolon : Boolean := True)
925 Aspects : List_Id;
926 Ptr : Source_Ptr;
928 begin
929 -- Aspect Specification is present
931 Ptr := Token_Ptr;
933 -- Here we have an aspect specification to scan, note that we don't
934 -- set the flag till later, because it may turn out that we have no
935 -- valid aspects in the list.
937 Aspects := Get_Aspect_Specifications (Semicolon);
939 -- Here if aspects present
941 if Is_Non_Empty_List (Aspects) then
943 -- If Decl is Empty, we just ignore the aspects (the caller in this
944 -- case has always issued an appropriate error message).
946 if Decl = Empty then
947 null;
949 -- If Decl is Error, we ignore the aspects, and issue a message
951 elsif Decl = Error then
952 Error_Msg ("aspect specifications not allowed here", Ptr);
954 -- Here aspects are allowed, and we store them
956 else
957 Set_Parent (Aspects, Decl);
958 Set_Aspect_Specifications (Decl, Aspects);
959 end if;
960 end if;
961 end P_Aspect_Specifications;
963 ---------------------------------------------
964 -- 13.4 Enumeration Representation Clause --
965 ---------------------------------------------
967 -- Parsed by P_Representation_Clause (13.1)
969 ---------------------------------
970 -- 13.4 Enumeration Aggregate --
971 ---------------------------------
973 -- Parsed by P_Representation_Clause (13.1)
975 ------------------------------------------
976 -- 13.5.1 Record Representation Clause --
977 ------------------------------------------
979 -- Parsed by P_Representation_Clause (13.1)
981 ------------------------------
982 -- 13.5.1 Mod Clause (I.8) --
983 ------------------------------
985 -- MOD_CLAUSE ::= at mod static_EXPRESSION;
987 -- Note: in Ada 83, the expression must be a simple expression
989 -- The caller has checked that the initial Token is AT
991 -- Error recovery: cannot raise Error_Resync
993 -- Note: the caller is responsible for setting the Pragmas_Before field
995 function P_Mod_Clause return Node_Id is
996 Mod_Node : Node_Id;
997 Expr_Node : Node_Id;
999 begin
1000 Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
1001 Scan; -- past AT
1002 T_Mod;
1003 Expr_Node := P_Expression_No_Right_Paren;
1004 Check_Simple_Expression_In_Ada_83 (Expr_Node);
1005 Set_Expression (Mod_Node, Expr_Node);
1006 TF_Semicolon;
1007 return Mod_Node;
1008 end P_Mod_Clause;
1010 ------------------------------
1011 -- 13.5.1 Component Clause --
1012 ------------------------------
1014 -- COMPONENT_CLAUSE ::=
1015 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
1016 -- range FIRST_BIT .. LAST_BIT;
1018 -- COMPONENT_CLAUSE_COMPONENT_NAME ::=
1019 -- component_DIRECT_NAME
1020 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
1021 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
1023 -- POSITION ::= static_EXPRESSION
1025 -- Note: in Ada 83, the expression must be a simple expression
1027 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION
1028 -- LAST_BIT ::= static_SIMPLE_EXPRESSION
1030 -- Note: the AARM V2.0 grammar has an error at this point, it uses
1031 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
1033 -- Error recovery: cannot raise Error_Resync
1035 function P_Component_Clause return Node_Id is
1036 Component_Node : Node_Id;
1037 Comp_Name : Node_Id;
1038 Expr_Node : Node_Id;
1040 begin
1041 Component_Node := New_Node (N_Component_Clause, Token_Ptr);
1042 Comp_Name := P_Name;
1044 if Nkind (Comp_Name) = N_Identifier
1045 or else Nkind (Comp_Name) = N_Attribute_Reference
1046 then
1047 Set_Component_Name (Component_Node, Comp_Name);
1048 else
1049 Error_Msg_N
1050 ("component name must be direct name or attribute", Comp_Name);
1051 Set_Component_Name (Component_Node, Error);
1052 end if;
1054 Set_Sloc (Component_Node, Token_Ptr);
1055 T_At;
1056 Expr_Node := P_Expression_No_Right_Paren;
1057 Check_Simple_Expression_In_Ada_83 (Expr_Node);
1058 Set_Position (Component_Node, Expr_Node);
1059 T_Range;
1060 Expr_Node := P_Expression_No_Right_Paren;
1061 Check_Simple_Expression_In_Ada_83 (Expr_Node);
1062 Set_First_Bit (Component_Node, Expr_Node);
1063 T_Dot_Dot;
1064 Expr_Node := P_Expression_No_Right_Paren;
1065 Check_Simple_Expression_In_Ada_83 (Expr_Node);
1066 Set_Last_Bit (Component_Node, Expr_Node);
1067 TF_Semicolon;
1068 return Component_Node;
1069 end P_Component_Clause;
1071 ----------------------
1072 -- 13.5.1 Position --
1073 ----------------------
1075 -- Parsed by P_Component_Clause (13.5.1)
1077 -----------------------
1078 -- 13.5.1 First Bit --
1079 -----------------------
1081 -- Parsed by P_Component_Clause (13.5.1)
1083 ----------------------
1084 -- 13.5.1 Last Bit --
1085 ----------------------
1087 -- Parsed by P_Component_Clause (13.5.1)
1089 --------------------------
1090 -- 13.8 Code Statement --
1091 --------------------------
1093 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
1095 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
1096 -- single argument, and the scan points to the apostrophe.
1098 -- Error recovery: can raise Error_Resync
1100 function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
1101 Node1 : Node_Id;
1103 begin
1104 Scan; -- past apostrophe
1106 -- If left paren, then we have a possible code statement
1108 if Token = Tok_Left_Paren then
1109 Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark));
1110 Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark));
1111 TF_Semicolon;
1112 return Node1;
1114 -- Otherwise we have an illegal range attribute. Note that P_Name
1115 -- ensures that Token = Tok_Range is the only possibility left here.
1117 else
1118 Error_Msg_SC ("RANGE attribute illegal here!");
1119 raise Error_Resync;
1120 end if;
1121 end P_Code_Statement;
1123 end Ch13;