PR middle-end/61455
[official-gcc.git] / gcc / ada / par-ch13.adb
blob44193d68428dec53c695cd4f3a62db4ceac780de
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-2014, 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 begin
49 -- Definitely must have WITH to consider aspect specs to be present
51 -- Note that this means that if we have a semicolon, we immediately
52 -- return False. There is a case in which this is not optimal, namely
53 -- something like
55 -- type R is new Integer;
56 -- with bla bla;
58 -- where the semicolon is redundant, but scanning forward for it would
59 -- be too expensive. Instead we pick up the aspect specifications later
60 -- as a bogus declaration, and diagnose the semicolon at that point.
62 if Token /= Tok_With then
63 return False;
64 end if;
66 -- Have a WITH, see if it looks like an aspect specification
68 Save_Scan_State (Scan_State);
69 Scan; -- past WITH
71 -- If no identifier, then consider that we definitely do not have an
72 -- aspect specification.
74 if Token /= Tok_Identifier then
75 Result := False;
77 -- This is where we pay attention to the Strict mode. Normally when we
78 -- are in Ada 2012 mode, Strict is False, and we consider that we have
79 -- an aspect specification if the identifier is an aspect name (even if
80 -- not followed by =>) or the identifier is not an aspect name but is
81 -- followed by =>, by a comma, or by a semicolon. The last two cases
82 -- correspond to (misspelled) Boolean aspects with a defaulted value of
83 -- True. P_Aspect_Specifications will generate messages if the aspect
84 -- specification is ill-formed.
86 elsif not Strict then
87 if Get_Aspect_Id (Token_Name) /= No_Aspect then
88 Result := True;
89 else
90 Scan; -- past identifier
91 Result := Token = Tok_Arrow or else
92 Token = Tok_Comma or else
93 Token = Tok_Semicolon;
94 end if;
96 -- If earlier than Ada 2012, check for valid aspect identifier (possibly
97 -- completed with 'CLASS) followed by an arrow, and consider that this
98 -- is still an aspect specification so we give an appropriate message.
100 else
101 if Get_Aspect_Id (Token_Name) = No_Aspect then
102 Result := False;
104 else
105 Scan; -- past aspect name
107 Result := False;
109 if Token = Tok_Arrow then
110 Result := True;
112 -- The identifier may be the name of a boolean aspect with a
113 -- defaulted True value. Further checks when analyzing aspect
114 -- specification, which may include further aspects.
116 elsif Token = Tok_Comma or else Token = Tok_Semicolon then
117 Result := True;
119 elsif Token = Tok_Apostrophe then
120 Scan; -- past apostrophe
122 if Token = Tok_Identifier
123 and then Token_Name = Name_Class
124 then
125 Scan; -- past CLASS
127 if Token = Tok_Arrow then
128 Result := True;
129 end if;
130 end if;
131 end if;
133 if Result then
134 Restore_Scan_State (Scan_State);
135 Error_Msg_Ada_2012_Feature ("|aspect specification", Token_Ptr);
136 return True;
137 end if;
138 end if;
139 end if;
141 Restore_Scan_State (Scan_State);
142 return Result;
143 end Aspect_Specifications_Present;
145 -------------------------------
146 -- Get_Aspect_Specifications --
147 -------------------------------
149 function Get_Aspect_Specifications
150 (Semicolon : Boolean := True) return List_Id
152 A_Id : Aspect_Id;
153 Aspect : Node_Id;
154 Aspects : List_Id;
155 OK : Boolean;
157 begin
158 Aspects := Empty_List;
160 -- Check if aspect specification present
162 if not Aspect_Specifications_Present then
163 if Semicolon then
164 TF_Semicolon;
165 end if;
167 return Aspects;
168 end if;
170 Scan; -- past WITH
171 Aspects := Empty_List;
173 -- Loop to scan aspects
175 loop
176 OK := True;
178 -- The aspect mark is not an identifier
180 if Token /= Tok_Identifier then
181 Error_Msg_SC ("aspect identifier expected");
183 -- Skip the whole aspect specification list
185 if Semicolon then
186 Resync_Past_Semicolon;
187 end if;
189 return Aspects;
190 end if;
192 A_Id := Get_Aspect_Id (Token_Name);
193 Aspect :=
194 Make_Aspect_Specification (Token_Ptr,
195 Identifier => Token_Node);
197 -- The aspect mark is not recognized
199 if A_Id = No_Aspect then
200 Error_Msg_N ("& is not a valid aspect identifier", Token_Node);
201 OK := False;
203 -- Check bad spelling
205 for J in Aspect_Id_Exclude_No_Aspect loop
206 if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
207 Error_Msg_Name_1 := Aspect_Names (J);
208 Error_Msg_N -- CODEFIX
209 ("\possible misspelling of%", Token_Node);
210 exit;
211 end if;
212 end loop;
214 Scan; -- past incorrect identifier
216 if Token = Tok_Apostrophe then
217 Scan; -- past apostrophe
218 Scan; -- past presumably CLASS
219 end if;
221 -- Attempt to parse the aspect definition by assuming it is an
222 -- expression.
224 if Token = Tok_Arrow then
225 Scan; -- past arrow
226 Set_Expression (Aspect, P_Expression);
228 -- If we have a correct terminator (comma or semicolon, or a
229 -- reasonable likely missing comma), then just proceed.
231 elsif Token = Tok_Comma or else
232 Token = Tok_Semicolon or else
233 Token = Tok_Identifier
234 then
235 null;
237 -- Otherwise the aspect contains a junk definition
239 else
240 if Semicolon then
241 Resync_Past_Semicolon;
242 end if;
244 return Aspects;
245 end if;
247 -- Aspect mark is OK
249 else
250 Scan; -- past identifier
252 -- Check for 'Class present
254 if Token = Tok_Apostrophe then
255 if Class_Aspect_OK (A_Id) then
256 Scan; -- past apostrophe
258 if Token = Tok_Identifier
259 and then Token_Name = Name_Class
260 then
261 Scan; -- past CLASS
262 Set_Class_Present (Aspect);
263 else
264 Error_Msg_SC ("Class attribute expected here");
265 OK := False;
267 if Token = Tok_Identifier then
268 Scan; -- past identifier not CLASS
269 end if;
270 end if;
272 -- The aspect does not allow 'Class
274 else
275 Error_Msg_Node_1 := Identifier (Aspect);
276 Error_Msg_SC ("aspect& does not permit attribute here");
277 OK := False;
279 Scan; -- past apostrophe
280 Scan; -- past presumably CLASS
281 end if;
282 end if;
284 -- Check for a missing aspect definition. Aspects with optional
285 -- definitions are not considered.
287 if Token = Tok_Comma or else Token = Tok_Semicolon then
288 if Aspect_Argument (A_Id) /= Optional_Expression
289 and then Aspect_Argument (A_Id) /= Optional_Name
290 then
291 Error_Msg_Node_1 := Identifier (Aspect);
292 Error_Msg_AP ("aspect& requires an aspect definition");
293 OK := False;
294 end if;
296 -- Check for a missing arrow when the aspect has a definition
298 elsif not Semicolon and then Token /= Tok_Arrow then
299 if Aspect_Argument (A_Id) /= Optional_Expression
300 and then Aspect_Argument (A_Id) /= Optional_Name
301 then
302 T_Arrow;
303 Resync_To_Semicolon;
304 end if;
306 -- Otherwise we have an aspect definition
308 else
309 if Token = Tok_Arrow then
310 Scan; -- past arrow
311 else
312 T_Arrow;
313 OK := False;
314 end if;
316 -- Detect a common error where the non-null definition of
317 -- aspect Depends, Global, Refined_Depends, Refined_Global
318 -- or Refined_State lacks enclosing parentheses.
320 if Token /= Tok_Left_Paren and then Token /= Tok_Null then
322 -- [Refined_]Depends
324 if A_Id = Aspect_Depends
325 or else
326 A_Id = Aspect_Refined_Depends
327 then
328 Error_Msg_SC -- CODEFIX
329 ("missing ""(""");
330 Resync_Past_Malformed_Aspect;
332 -- Return when the current aspect is the last in the list
333 -- of specifications and the list applies to a body.
335 if Token = Tok_Is then
336 return Aspects;
337 end if;
339 -- [Refined_]Global
341 elsif A_Id = Aspect_Global
342 or else
343 A_Id = Aspect_Refined_Global
344 then
345 declare
346 Scan_State : Saved_Scan_State;
348 begin
349 Save_Scan_State (Scan_State);
350 Scan; -- past item or mode_selector
352 -- Emit an error when the aspect has a mode_selector
353 -- as the moded_global_list must be parenthesized:
354 -- with Global => Output => Item
356 if Token = Tok_Arrow then
357 Restore_Scan_State (Scan_State);
358 Error_Msg_SC -- CODEFIX
359 ("missing ""(""");
360 Resync_Past_Malformed_Aspect;
362 -- Return when the current aspect is the last in
363 -- the list of specifications and the list applies
364 -- to a body.
366 if Token = Tok_Is then
367 return Aspects;
368 end if;
370 elsif Token = Tok_Comma then
371 Scan; -- past comma
373 -- An item followed by a comma does not need to
374 -- be parenthesized if the next token is a valid
375 -- aspect name:
376 -- with Global => Item,
377 -- Aspect => ...
379 if Token = Tok_Identifier
380 and then Get_Aspect_Id (Token_Name) /= No_Aspect
381 then
382 Restore_Scan_State (Scan_State);
384 -- Otherwise this is a list of items in which case
385 -- the list must be parenthesized.
387 else
388 Restore_Scan_State (Scan_State);
389 Error_Msg_SC -- CODEFIX
390 ("missing ""(""");
391 Resync_Past_Malformed_Aspect;
393 -- Return when the current aspect is the last
394 -- in the list of specifications and the list
395 -- applies to a body.
397 if Token = Tok_Is then
398 return Aspects;
399 end if;
400 end if;
402 -- The definition of [Refined_]Global does not need to
403 -- be parenthesized.
405 else
406 Restore_Scan_State (Scan_State);
407 end if;
408 end;
410 -- Refined_State
412 elsif A_Id = Aspect_Refined_State then
413 if Token = Tok_Identifier then
414 declare
415 Scan_State : Saved_Scan_State;
417 begin
418 Save_Scan_State (Scan_State);
419 Scan; -- past state
421 -- The refinement contains a constituent, the whole
422 -- argument of Refined_State must be parenthesized.
424 -- with Refined_State => State => Constit
426 if Token = Tok_Arrow then
427 Restore_Scan_State (Scan_State);
428 Error_Msg_SC -- CODEFIX
429 ("missing ""(""");
430 Resync_Past_Malformed_Aspect;
432 -- Return when the current aspect is the last
433 -- in the list of specifications and the list
434 -- applies to a body.
436 if Token = Tok_Is then
437 return Aspects;
438 end if;
440 -- The refinement lacks constituents. Do not flag
441 -- this case as the error would be misleading. The
442 -- diagnostic is left to the analysis.
444 -- with Refined_State => State
446 else
447 Restore_Scan_State (Scan_State);
448 end if;
449 end;
450 end if;
451 end if;
452 end if;
454 -- Note if inside Depends aspect
456 if A_Id = Aspect_Depends then
457 Inside_Depends := True;
458 end if;
460 -- Parse the aspect definition depening on the expected
461 -- argument kind.
463 if Aspect_Argument (A_Id) = Name
464 or else Aspect_Argument (A_Id) = Optional_Name
465 then
466 Set_Expression (Aspect, P_Name);
468 else
469 pragma Assert
470 (Aspect_Argument (A_Id) = Expression
471 or else
472 Aspect_Argument (A_Id) = Optional_Expression);
473 Set_Expression (Aspect, P_Expression);
474 end if;
476 -- Unconditionally reset flag for Inside_Depends
478 Inside_Depends := False;
479 end if;
481 -- Add the aspect to the resulting list only when it was properly
482 -- parsed.
484 if OK then
485 Append (Aspect, Aspects);
486 end if;
487 end if;
489 -- Merge here after good or bad aspect (we should be at a comma
490 -- or a semicolon, but there might be other possible errors).
492 -- The aspect specification list contains more than one aspect
494 if Token = Tok_Comma then
495 Scan; -- past comma
496 goto Continue;
498 -- Check for a missing comma between two aspects. Emit an error
499 -- and proceed to the next aspect.
501 elsif Token = Tok_Identifier
502 and then Get_Aspect_Id (Token_Name) /= No_Aspect
503 then
504 declare
505 Scan_State : Saved_Scan_State;
507 begin
508 Save_Scan_State (Scan_State);
509 Scan; -- past identifier
511 -- Attempt to detect ' or => following a potential aspect
512 -- mark.
514 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
515 Restore_Scan_State (Scan_State);
516 Error_Msg_AP -- CODEFIX
517 ("|missing "",""");
518 goto Continue;
520 -- The construct following the current aspect is not an
521 -- aspect.
523 else
524 Restore_Scan_State (Scan_State);
525 end if;
526 end;
528 -- Check for a mistyped semicolon in place of a comma between two
529 -- aspects. Emit an error and proceed to the next aspect.
531 elsif Token = Tok_Semicolon then
532 declare
533 Scan_State : Saved_Scan_State;
535 begin
536 Save_Scan_State (Scan_State);
537 Scan; -- past semicolon
539 if Token = Tok_Identifier
540 and then Get_Aspect_Id (Token_Name) /= No_Aspect
541 then
542 Scan; -- past identifier
544 -- Attempt to detect ' or => following a potential aspect
545 -- mark.
547 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
548 Restore_Scan_State (Scan_State);
549 Error_Msg_SC -- CODEFIX
550 ("|"";"" should be "",""");
551 Scan; -- past semicolon
552 goto Continue;
553 end if;
554 end if;
556 -- The construct following the current aspect is not an
557 -- aspect.
559 Restore_Scan_State (Scan_State);
560 end;
561 end if;
563 -- Must be terminator character
565 if Semicolon then
566 T_Semicolon;
567 end if;
569 exit;
571 <<Continue>>
572 null;
573 end loop;
575 return Aspects;
576 end Get_Aspect_Specifications;
578 --------------------------------------------
579 -- 13.1 Representation Clause (also I.7) --
580 --------------------------------------------
582 -- REPRESENTATION_CLAUSE ::=
583 -- ATTRIBUTE_DEFINITION_CLAUSE
584 -- | ENUMERATION_REPRESENTATION_CLAUSE
585 -- | RECORD_REPRESENTATION_CLAUSE
586 -- | AT_CLAUSE
588 -- ATTRIBUTE_DEFINITION_CLAUSE ::=
589 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
590 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
592 -- Note: in Ada 83, the expression must be a simple expression
594 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
596 -- Note: in Ada 83, the expression must be a simple expression
598 -- ENUMERATION_REPRESENTATION_CLAUSE ::=
599 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
601 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
603 -- RECORD_REPRESENTATION_CLAUSE ::=
604 -- for first_subtype_LOCAL_NAME use
605 -- record [MOD_CLAUSE]
606 -- {COMPONENT_CLAUSE}
607 -- end record;
609 -- Note: for now we allow only a direct name as the local name in the
610 -- above constructs. This probably needs changing later on ???
612 -- The caller has checked that the initial token is FOR
614 -- Error recovery: cannot raise Error_Resync, if an error occurs,
615 -- the scan is repositioned past the next semicolon.
617 function P_Representation_Clause return Node_Id is
618 For_Loc : Source_Ptr;
619 Name_Node : Node_Id;
620 Prefix_Node : Node_Id;
621 Attr_Name : Name_Id;
622 Identifier_Node : Node_Id;
623 Rep_Clause_Node : Node_Id;
624 Expr_Node : Node_Id;
625 Record_Items : List_Id;
627 begin
628 For_Loc := Token_Ptr;
629 Scan; -- past FOR
631 -- Note that the name in a representation clause is always a simple
632 -- name, even in the attribute case, see AI-300 which made this so.
634 Identifier_Node := P_Identifier (C_Use);
636 -- Check case of qualified name to give good error message
638 if Token = Tok_Dot then
639 Error_Msg_SC
640 ("representation clause requires simple name!");
642 loop
643 exit when Token /= Tok_Dot;
644 Scan; -- past dot
645 Discard_Junk_Node (P_Identifier);
646 end loop;
647 end if;
649 -- Attribute Definition Clause
651 if Token = Tok_Apostrophe then
653 -- Allow local names of the form a'b'.... This enables
654 -- us to parse class-wide streams attributes correctly.
656 Name_Node := Identifier_Node;
657 while Token = Tok_Apostrophe loop
659 Scan; -- past apostrophe
661 Identifier_Node := Token_Node;
662 Attr_Name := No_Name;
664 if Token = Tok_Identifier then
665 Attr_Name := Token_Name;
667 -- Note that the parser must complain in case of an internal
668 -- attribute name that comes from source since internal names
669 -- are meant to be used only by the compiler.
671 if not Is_Attribute_Name (Attr_Name)
672 and then (not Is_Internal_Attribute_Name (Attr_Name)
673 or else Comes_From_Source (Token_Node))
674 then
675 Signal_Bad_Attribute;
676 end if;
678 if Style_Check then
679 Style.Check_Attribute_Name (False);
680 end if;
682 -- Here for case of attribute designator is not an identifier
684 else
685 if Token = Tok_Delta then
686 Attr_Name := Name_Delta;
688 elsif Token = Tok_Digits then
689 Attr_Name := Name_Digits;
691 elsif Token = Tok_Access then
692 Attr_Name := Name_Access;
694 else
695 Error_Msg_AP ("attribute designator expected");
696 raise Error_Resync;
697 end if;
699 if Style_Check then
700 Style.Check_Attribute_Name (True);
701 end if;
702 end if;
704 -- We come here with an OK attribute scanned, and the
705 -- corresponding Attribute identifier node stored in Ident_Node.
707 Prefix_Node := Name_Node;
708 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
709 Set_Prefix (Name_Node, Prefix_Node);
710 Set_Attribute_Name (Name_Node, Attr_Name);
711 Scan;
712 end loop;
714 Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
715 Set_Name (Rep_Clause_Node, Prefix_Node);
716 Set_Chars (Rep_Clause_Node, Attr_Name);
717 T_Use;
719 Expr_Node := P_Expression_No_Right_Paren;
720 Check_Simple_Expression_In_Ada_83 (Expr_Node);
721 Set_Expression (Rep_Clause_Node, Expr_Node);
723 else
724 TF_Use;
725 Rep_Clause_Node := Empty;
727 -- AT follows USE (At Clause)
729 if Token = Tok_At then
730 Scan; -- past AT
731 Rep_Clause_Node := New_Node (N_At_Clause, For_Loc);
732 Set_Identifier (Rep_Clause_Node, Identifier_Node);
733 Expr_Node := P_Expression_No_Right_Paren;
734 Check_Simple_Expression_In_Ada_83 (Expr_Node);
735 Set_Expression (Rep_Clause_Node, Expr_Node);
737 -- RECORD follows USE (Record Representation Clause)
739 elsif Token = Tok_Record then
740 Record_Items := P_Pragmas_Opt;
741 Rep_Clause_Node :=
742 New_Node (N_Record_Representation_Clause, For_Loc);
743 Set_Identifier (Rep_Clause_Node, Identifier_Node);
745 Push_Scope_Stack;
746 Scope.Table (Scope.Last).Etyp := E_Record;
747 Scope.Table (Scope.Last).Ecol := Start_Column;
748 Scope.Table (Scope.Last).Sloc := Token_Ptr;
749 Scan; -- past RECORD
750 Record_Items := P_Pragmas_Opt;
752 -- Possible Mod Clause
754 if Token = Tok_At then
755 Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause);
756 Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items);
757 Record_Items := P_Pragmas_Opt;
758 end if;
760 if No (Record_Items) then
761 Record_Items := New_List;
762 end if;
764 Set_Component_Clauses (Rep_Clause_Node, Record_Items);
766 -- Loop through component clauses
768 loop
769 if Token not in Token_Class_Name then
770 exit when Check_End;
771 end if;
773 Append (P_Component_Clause, Record_Items);
774 P_Pragmas_Opt (Record_Items);
775 end loop;
777 -- Left paren follows USE (Enumeration Representation Clause)
779 elsif Token = Tok_Left_Paren then
780 Rep_Clause_Node :=
781 New_Node (N_Enumeration_Representation_Clause, For_Loc);
782 Set_Identifier (Rep_Clause_Node, Identifier_Node);
783 Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate);
785 -- Some other token follows FOR (invalid representation clause)
787 else
788 Error_Msg_SC ("invalid representation clause");
789 raise Error_Resync;
790 end if;
791 end if;
793 TF_Semicolon;
794 return Rep_Clause_Node;
796 exception
797 when Error_Resync =>
798 Resync_Past_Semicolon;
799 return Error;
801 end P_Representation_Clause;
803 ----------------------
804 -- 13.1 Local Name --
805 ----------------------
807 -- Local name is always parsed by its parent. In the case of its use in
808 -- pragmas, the check for a local name is handled in Par.Prag and allows
809 -- all the possible forms of local name. For the uses in chapter 13, we
810 -- currently only allow a direct name, but this should probably change???
812 ---------------------------
813 -- 13.1 At Clause (I.7) --
814 ---------------------------
816 -- Parsed by P_Representation_Clause (13.1)
818 ---------------------------------------
819 -- 13.3 Attribute Definition Clause --
820 ---------------------------------------
822 -- Parsed by P_Representation_Clause (13.1)
824 --------------------------------
825 -- 13.1 Aspect Specification --
826 --------------------------------
828 -- ASPECT_SPECIFICATION ::=
829 -- with ASPECT_MARK [=> ASPECT_DEFINITION] {,
830 -- ASPECT_MARK [=> ASPECT_DEFINITION] }
832 -- ASPECT_MARK ::= aspect_IDENTIFIER['Class]
834 -- ASPECT_DEFINITION ::= NAME | EXPRESSION
836 -- Error recovery: cannot raise Error_Resync
838 procedure P_Aspect_Specifications
839 (Decl : Node_Id;
840 Semicolon : Boolean := True)
842 Aspects : List_Id;
843 Ptr : Source_Ptr;
845 begin
846 -- Aspect Specification is present
848 Ptr := Token_Ptr;
850 -- Here we have an aspect specification to scan, note that we don't
851 -- set the flag till later, because it may turn out that we have no
852 -- valid aspects in the list.
854 Aspects := Get_Aspect_Specifications (Semicolon);
856 -- Here if aspects present
858 if Is_Non_Empty_List (Aspects) then
860 -- If Decl is Empty, we just ignore the aspects (the caller in this
861 -- case has always issued an appropriate error message).
863 if Decl = Empty then
864 null;
866 -- If Decl is Error, we ignore the aspects, and issue a message
868 elsif Decl = Error then
869 Error_Msg ("aspect specifications not allowed here", Ptr);
871 -- Here aspects are allowed, and we store them
873 else
874 Set_Parent (Aspects, Decl);
875 Set_Aspect_Specifications (Decl, Aspects);
876 end if;
877 end if;
878 end P_Aspect_Specifications;
880 ---------------------------------------------
881 -- 13.4 Enumeration Representation Clause --
882 ---------------------------------------------
884 -- Parsed by P_Representation_Clause (13.1)
886 ---------------------------------
887 -- 13.4 Enumeration Aggregate --
888 ---------------------------------
890 -- Parsed by P_Representation_Clause (13.1)
892 ------------------------------------------
893 -- 13.5.1 Record Representation Clause --
894 ------------------------------------------
896 -- Parsed by P_Representation_Clause (13.1)
898 ------------------------------
899 -- 13.5.1 Mod Clause (I.8) --
900 ------------------------------
902 -- MOD_CLAUSE ::= at mod static_EXPRESSION;
904 -- Note: in Ada 83, the expression must be a simple expression
906 -- The caller has checked that the initial Token is AT
908 -- Error recovery: cannot raise Error_Resync
910 -- Note: the caller is responsible for setting the Pragmas_Before field
912 function P_Mod_Clause return Node_Id is
913 Mod_Node : Node_Id;
914 Expr_Node : Node_Id;
916 begin
917 Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
918 Scan; -- past AT
919 T_Mod;
920 Expr_Node := P_Expression_No_Right_Paren;
921 Check_Simple_Expression_In_Ada_83 (Expr_Node);
922 Set_Expression (Mod_Node, Expr_Node);
923 TF_Semicolon;
924 return Mod_Node;
925 end P_Mod_Clause;
927 ------------------------------
928 -- 13.5.1 Component Clause --
929 ------------------------------
931 -- COMPONENT_CLAUSE ::=
932 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
933 -- range FIRST_BIT .. LAST_BIT;
935 -- COMPONENT_CLAUSE_COMPONENT_NAME ::=
936 -- component_DIRECT_NAME
937 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
938 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
940 -- POSITION ::= static_EXPRESSION
942 -- Note: in Ada 83, the expression must be a simple expression
944 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION
945 -- LAST_BIT ::= static_SIMPLE_EXPRESSION
947 -- Note: the AARM V2.0 grammar has an error at this point, it uses
948 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
950 -- Error recovery: cannot raise Error_Resync
952 function P_Component_Clause return Node_Id is
953 Component_Node : Node_Id;
954 Comp_Name : Node_Id;
955 Expr_Node : Node_Id;
957 begin
958 Component_Node := New_Node (N_Component_Clause, Token_Ptr);
959 Comp_Name := P_Name;
961 if Nkind (Comp_Name) = N_Identifier
962 or else Nkind (Comp_Name) = N_Attribute_Reference
963 then
964 Set_Component_Name (Component_Node, Comp_Name);
965 else
966 Error_Msg_N
967 ("component name must be direct name or attribute", Comp_Name);
968 Set_Component_Name (Component_Node, Error);
969 end if;
971 Set_Sloc (Component_Node, Token_Ptr);
972 T_At;
973 Expr_Node := P_Expression_No_Right_Paren;
974 Check_Simple_Expression_In_Ada_83 (Expr_Node);
975 Set_Position (Component_Node, Expr_Node);
976 T_Range;
977 Expr_Node := P_Expression_No_Right_Paren;
978 Check_Simple_Expression_In_Ada_83 (Expr_Node);
979 Set_First_Bit (Component_Node, Expr_Node);
980 T_Dot_Dot;
981 Expr_Node := P_Expression_No_Right_Paren;
982 Check_Simple_Expression_In_Ada_83 (Expr_Node);
983 Set_Last_Bit (Component_Node, Expr_Node);
984 TF_Semicolon;
985 return Component_Node;
986 end P_Component_Clause;
988 ----------------------
989 -- 13.5.1 Position --
990 ----------------------
992 -- Parsed by P_Component_Clause (13.5.1)
994 -----------------------
995 -- 13.5.1 First Bit --
996 -----------------------
998 -- Parsed by P_Component_Clause (13.5.1)
1000 ----------------------
1001 -- 13.5.1 Last Bit --
1002 ----------------------
1004 -- Parsed by P_Component_Clause (13.5.1)
1006 --------------------------
1007 -- 13.8 Code Statement --
1008 --------------------------
1010 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
1012 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
1013 -- single argument, and the scan points to the apostrophe.
1015 -- Error recovery: can raise Error_Resync
1017 function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
1018 Node1 : Node_Id;
1020 begin
1021 Scan; -- past apostrophe
1023 -- If left paren, then we have a possible code statement
1025 if Token = Tok_Left_Paren then
1026 Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark));
1027 Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark));
1028 TF_Semicolon;
1029 return Node1;
1031 -- Otherwise we have an illegal range attribute. Note that P_Name
1032 -- ensures that Token = Tok_Range is the only possibility left here.
1034 else
1035 Error_Msg_SC ("RANGE attribute illegal here!");
1036 raise Error_Resync;
1037 end if;
1038 end P_Code_Statement;
1040 end Ch13;