[gcc/]
[official-gcc.git] / gcc / ada / par-ch13.adb
blob387c83ef83913d71987bd3c04dde520223985550
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
174 OK := True;
176 -- The aspect mark is not an identifier
178 if Token /= Tok_Identifier then
179 Error_Msg_SC ("aspect identifier expected");
181 -- Skip the whole aspect specification list
183 if Semicolon then
184 Resync_Past_Semicolon;
185 end if;
187 return Aspects;
188 end if;
190 A_Id := Get_Aspect_Id (Token_Name);
191 Aspect :=
192 Make_Aspect_Specification (Token_Ptr,
193 Identifier => Token_Node);
195 -- The aspect mark is not recognized
197 if A_Id = No_Aspect then
198 Error_Msg_SC ("aspect identifier expected");
199 OK := False;
201 -- Check bad spelling
203 for J in Aspect_Id_Exclude_No_Aspect loop
204 if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
205 Error_Msg_Name_1 := Aspect_Names (J);
206 Error_Msg_SC -- CODEFIX
207 ("\possible misspelling of%");
208 exit;
209 end if;
210 end loop;
212 Scan; -- past incorrect identifier
214 if Token = Tok_Apostrophe then
215 Scan; -- past apostrophe
216 Scan; -- past presumably CLASS
217 end if;
219 -- Attempt to parse the aspect definition by assuming it is an
220 -- expression.
222 if Token = Tok_Arrow then
223 Scan; -- past arrow
224 Set_Expression (Aspect, P_Expression);
226 -- The aspect may behave as a boolean aspect
228 elsif Token = Tok_Comma then
229 null;
231 -- Otherwise the aspect contains a junk definition
233 else
234 if Semicolon then
235 Resync_Past_Semicolon;
236 end if;
238 return Aspects;
239 end if;
241 -- Aspect mark is OK
243 else
244 Scan; -- past identifier
246 -- Check for 'Class present
248 if Token = Tok_Apostrophe then
249 if Class_Aspect_OK (A_Id) then
250 Scan; -- past apostrophe
252 if Token = Tok_Identifier
253 and then Token_Name = Name_Class
254 then
255 Scan; -- past CLASS
256 Set_Class_Present (Aspect);
257 else
258 Error_Msg_SC ("Class attribute expected here");
259 OK := False;
261 if Token = Tok_Identifier then
262 Scan; -- past identifier not CLASS
263 end if;
264 end if;
266 -- The aspect does not allow 'Class
268 else
269 Error_Msg_Node_1 := Identifier (Aspect);
270 Error_Msg_SC ("aspect& does not permit attribute here");
271 OK := False;
273 Scan; -- past apostrophe
274 Scan; -- past presumably CLASS
275 end if;
276 end if;
278 -- Check for a missing aspect definition. Aspects with optional
279 -- definitions are not considered.
281 if Token = Tok_Comma or else Token = Tok_Semicolon then
282 if Aspect_Argument (A_Id) /= Optional_Expression
283 and then Aspect_Argument (A_Id) /= Optional_Name
284 then
285 Error_Msg_Node_1 := Identifier (Aspect);
286 Error_Msg_AP ("aspect& requires an aspect definition");
287 OK := False;
288 end if;
290 -- Check for a missing arrow when the aspect has a definition
292 elsif not Semicolon and then Token /= Tok_Arrow then
293 if Aspect_Argument (A_Id) /= Optional_Expression
294 and then Aspect_Argument (A_Id) /= Optional_Name
295 then
296 T_Arrow;
297 Resync_To_Semicolon;
298 end if;
300 -- Otherwise we have an aspect definition
302 else
303 if Token = Tok_Arrow then
304 Scan; -- past arrow
305 else
306 T_Arrow;
307 OK := False;
308 end if;
310 -- Detect a common error where the non-null definition of
311 -- aspect Depends, Global, Refined_Depends, Refined_Global
312 -- or Refined_State lacks enclosing parentheses.
314 if Token /= Tok_Left_Paren and then Token /= Tok_Null then
316 -- [Refined_]Depends
318 if A_Id = Aspect_Depends
319 or else
320 A_Id = Aspect_Refined_Depends
321 then
322 Error_Msg_SC -- CODEFIX
323 ("missing ""(""");
324 Resync_Past_Malformed_Aspect;
326 -- Return when the current aspect is the last in the list
327 -- of specifications and the list applies to a body.
329 if Token = Tok_Is then
330 return Aspects;
331 end if;
333 -- [Refined_]Global
335 elsif A_Id = Aspect_Global
336 or else
337 A_Id = Aspect_Refined_Global
338 then
339 declare
340 Scan_State : Saved_Scan_State;
342 begin
343 Save_Scan_State (Scan_State);
344 Scan; -- past item or mode_selector
346 -- Emit an error when the aspect has a mode_selector
347 -- as the moded_global_list must be parenthesized:
348 -- with Global => Output => Item
350 if Token = Tok_Arrow then
351 Restore_Scan_State (Scan_State);
352 Error_Msg_SC -- CODEFIX
353 ("missing ""(""");
354 Resync_Past_Malformed_Aspect;
356 -- Return when the current aspect is the last in
357 -- the list of specifications and the list applies
358 -- to a body.
360 if Token = Tok_Is then
361 return Aspects;
362 end if;
364 elsif Token = Tok_Comma then
365 Scan; -- past comma
367 -- An item followed by a comma does not need to
368 -- be parenthesized if the next token is a valid
369 -- aspect name:
370 -- with Global => Item,
371 -- Aspect => ...
373 if Token = Tok_Identifier
374 and then Get_Aspect_Id (Token_Name) /= No_Aspect
375 then
376 Restore_Scan_State (Scan_State);
378 -- Otherwise this is a list of items in which case
379 -- the list must be parenthesized.
381 else
382 Restore_Scan_State (Scan_State);
383 Error_Msg_SC -- CODEFIX
384 ("missing ""(""");
385 Resync_Past_Malformed_Aspect;
387 -- Return when the current aspect is the last
388 -- in the list of specifications and the list
389 -- applies to a body.
391 if Token = Tok_Is then
392 return Aspects;
393 end if;
394 end if;
396 -- The definition of [Refined_]Global does not need to
397 -- be parenthesized.
399 else
400 Restore_Scan_State (Scan_State);
401 end if;
402 end;
404 -- Refined_State
406 elsif A_Id = Aspect_Refined_State then
407 if Token = Tok_Identifier then
408 declare
409 Scan_State : Saved_Scan_State;
411 begin
412 Save_Scan_State (Scan_State);
413 Scan; -- past state
415 -- The refinement contains a constituent, the whole
416 -- argument of Refined_State must be parenthesized.
418 -- with Refined_State => State => Constit
420 if Token = Tok_Arrow then
421 Restore_Scan_State (Scan_State);
422 Error_Msg_SC -- CODEFIX
423 ("missing ""(""");
424 Resync_Past_Malformed_Aspect;
426 -- Return when the current aspect is the last
427 -- in the list of specifications and the list
428 -- applies to a body.
430 if Token = Tok_Is then
431 return Aspects;
432 end if;
434 -- The refinement lacks constituents. Do not flag
435 -- this case as the error would be misleading. The
436 -- diagnostic is left to the analysis.
438 -- with Refined_State => State
440 else
441 Restore_Scan_State (Scan_State);
442 end if;
443 end;
444 end if;
445 end if;
446 end if;
448 -- Parse the aspect definition depening on the expected
449 -- argument kind.
451 if Aspect_Argument (A_Id) = Name
452 or else Aspect_Argument (A_Id) = Optional_Name
453 then
454 Set_Expression (Aspect, P_Name);
456 else
457 pragma Assert
458 (Aspect_Argument (A_Id) = Expression
459 or else
460 Aspect_Argument (A_Id) = Optional_Expression);
461 Set_Expression (Aspect, P_Expression);
462 end if;
463 end if;
465 -- Add the aspect to the resulting list only when it was properly
466 -- parsed.
468 if OK then
469 Append (Aspect, Aspects);
470 end if;
472 -- The aspect specification list contains more than one aspect
474 if Token = Tok_Comma then
475 Scan; -- past comma
476 goto Continue;
478 -- Check for a missing comma between two aspects. Emit an error
479 -- and proceed to the next aspect.
481 elsif Token = Tok_Identifier
482 and then Get_Aspect_Id (Token_Name) /= No_Aspect
483 then
484 declare
485 Scan_State : Saved_Scan_State;
487 begin
488 Save_Scan_State (Scan_State);
489 Scan; -- past identifier
491 -- Attempt to detect ' or => following a potential aspect
492 -- mark.
494 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
495 Restore_Scan_State (Scan_State);
496 Error_Msg_AP -- CODEFIX
497 ("|missing "",""");
498 goto Continue;
500 -- The construct following the current aspect is not an
501 -- aspect.
503 else
504 Restore_Scan_State (Scan_State);
505 end if;
506 end;
508 -- Check for a mistyped semicolon in place of a comma between two
509 -- aspects. Emit an error and proceed to the next aspect.
511 elsif Token = Tok_Semicolon then
512 declare
513 Scan_State : Saved_Scan_State;
515 begin
516 Save_Scan_State (Scan_State);
517 Scan; -- past semicolon
519 if Token = Tok_Identifier
520 and then Get_Aspect_Id (Token_Name) /= No_Aspect
521 then
522 Scan; -- past identifier
524 -- Attempt to detect ' or => following a potential aspect
525 -- mark.
527 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
528 Restore_Scan_State (Scan_State);
529 Error_Msg_SC -- CODEFIX
530 ("|"";"" should be "",""");
531 Scan; -- past semicolon
532 goto Continue;
533 end if;
534 end if;
536 -- The construct following the current aspect is not an
537 -- aspect.
539 Restore_Scan_State (Scan_State);
540 end;
541 end if;
543 -- Must be terminator character
545 if Semicolon then
546 T_Semicolon;
547 end if;
549 exit;
551 <<Continue>>
552 null;
553 end if;
554 end loop;
556 return Aspects;
557 end Get_Aspect_Specifications;
559 --------------------------------------------
560 -- 13.1 Representation Clause (also I.7) --
561 --------------------------------------------
563 -- REPRESENTATION_CLAUSE ::=
564 -- ATTRIBUTE_DEFINITION_CLAUSE
565 -- | ENUMERATION_REPRESENTATION_CLAUSE
566 -- | RECORD_REPRESENTATION_CLAUSE
567 -- | AT_CLAUSE
569 -- ATTRIBUTE_DEFINITION_CLAUSE ::=
570 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
571 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
573 -- Note: in Ada 83, the expression must be a simple expression
575 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
577 -- Note: in Ada 83, the expression must be a simple expression
579 -- ENUMERATION_REPRESENTATION_CLAUSE ::=
580 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
582 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
584 -- RECORD_REPRESENTATION_CLAUSE ::=
585 -- for first_subtype_LOCAL_NAME use
586 -- record [MOD_CLAUSE]
587 -- {COMPONENT_CLAUSE}
588 -- end record;
590 -- Note: for now we allow only a direct name as the local name in the
591 -- above constructs. This probably needs changing later on ???
593 -- The caller has checked that the initial token is FOR
595 -- Error recovery: cannot raise Error_Resync, if an error occurs,
596 -- the scan is repositioned past the next semicolon.
598 function P_Representation_Clause return Node_Id is
599 For_Loc : Source_Ptr;
600 Name_Node : Node_Id;
601 Prefix_Node : Node_Id;
602 Attr_Name : Name_Id;
603 Identifier_Node : Node_Id;
604 Rep_Clause_Node : Node_Id;
605 Expr_Node : Node_Id;
606 Record_Items : List_Id;
608 begin
609 For_Loc := Token_Ptr;
610 Scan; -- past FOR
612 -- Note that the name in a representation clause is always a simple
613 -- name, even in the attribute case, see AI-300 which made this so.
615 Identifier_Node := P_Identifier (C_Use);
617 -- Check case of qualified name to give good error message
619 if Token = Tok_Dot then
620 Error_Msg_SC
621 ("representation clause requires simple name!");
623 loop
624 exit when Token /= Tok_Dot;
625 Scan; -- past dot
626 Discard_Junk_Node (P_Identifier);
627 end loop;
628 end if;
630 -- Attribute Definition Clause
632 if Token = Tok_Apostrophe then
634 -- Allow local names of the form a'b'.... This enables
635 -- us to parse class-wide streams attributes correctly.
637 Name_Node := Identifier_Node;
638 while Token = Tok_Apostrophe loop
640 Scan; -- past apostrophe
642 Identifier_Node := Token_Node;
643 Attr_Name := No_Name;
645 if Token = Tok_Identifier then
646 Attr_Name := Token_Name;
648 -- Note that the parser must complain in case of an internal
649 -- attribute name that comes from source since internal names
650 -- are meant to be used only by the compiler.
652 if not Is_Attribute_Name (Attr_Name)
653 and then (not Is_Internal_Attribute_Name (Attr_Name)
654 or else Comes_From_Source (Token_Node))
655 then
656 Signal_Bad_Attribute;
657 end if;
659 if Style_Check then
660 Style.Check_Attribute_Name (False);
661 end if;
663 -- Here for case of attribute designator is not an identifier
665 else
666 if Token = Tok_Delta then
667 Attr_Name := Name_Delta;
669 elsif Token = Tok_Digits then
670 Attr_Name := Name_Digits;
672 elsif Token = Tok_Access then
673 Attr_Name := Name_Access;
675 else
676 Error_Msg_AP ("attribute designator expected");
677 raise Error_Resync;
678 end if;
680 if Style_Check then
681 Style.Check_Attribute_Name (True);
682 end if;
683 end if;
685 -- We come here with an OK attribute scanned, and the
686 -- corresponding Attribute identifier node stored in Ident_Node.
688 Prefix_Node := Name_Node;
689 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
690 Set_Prefix (Name_Node, Prefix_Node);
691 Set_Attribute_Name (Name_Node, Attr_Name);
692 Scan;
693 end loop;
695 Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
696 Set_Name (Rep_Clause_Node, Prefix_Node);
697 Set_Chars (Rep_Clause_Node, Attr_Name);
698 T_Use;
700 Expr_Node := P_Expression_No_Right_Paren;
701 Check_Simple_Expression_In_Ada_83 (Expr_Node);
702 Set_Expression (Rep_Clause_Node, Expr_Node);
704 else
705 TF_Use;
706 Rep_Clause_Node := Empty;
708 -- AT follows USE (At Clause)
710 if Token = Tok_At then
711 Scan; -- past AT
712 Rep_Clause_Node := New_Node (N_At_Clause, For_Loc);
713 Set_Identifier (Rep_Clause_Node, Identifier_Node);
714 Expr_Node := P_Expression_No_Right_Paren;
715 Check_Simple_Expression_In_Ada_83 (Expr_Node);
716 Set_Expression (Rep_Clause_Node, Expr_Node);
718 -- RECORD follows USE (Record Representation Clause)
720 elsif Token = Tok_Record then
721 Record_Items := P_Pragmas_Opt;
722 Rep_Clause_Node :=
723 New_Node (N_Record_Representation_Clause, For_Loc);
724 Set_Identifier (Rep_Clause_Node, Identifier_Node);
726 Push_Scope_Stack;
727 Scope.Table (Scope.Last).Etyp := E_Record;
728 Scope.Table (Scope.Last).Ecol := Start_Column;
729 Scope.Table (Scope.Last).Sloc := Token_Ptr;
730 Scan; -- past RECORD
731 Record_Items := P_Pragmas_Opt;
733 -- Possible Mod Clause
735 if Token = Tok_At then
736 Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause);
737 Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items);
738 Record_Items := P_Pragmas_Opt;
739 end if;
741 if No (Record_Items) then
742 Record_Items := New_List;
743 end if;
745 Set_Component_Clauses (Rep_Clause_Node, Record_Items);
747 -- Loop through component clauses
749 loop
750 if Token not in Token_Class_Name then
751 exit when Check_End;
752 end if;
754 Append (P_Component_Clause, Record_Items);
755 P_Pragmas_Opt (Record_Items);
756 end loop;
758 -- Left paren follows USE (Enumeration Representation Clause)
760 elsif Token = Tok_Left_Paren then
761 Rep_Clause_Node :=
762 New_Node (N_Enumeration_Representation_Clause, For_Loc);
763 Set_Identifier (Rep_Clause_Node, Identifier_Node);
764 Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate);
766 -- Some other token follows FOR (invalid representation clause)
768 else
769 Error_Msg_SC ("invalid representation clause");
770 raise Error_Resync;
771 end if;
772 end if;
774 TF_Semicolon;
775 return Rep_Clause_Node;
777 exception
778 when Error_Resync =>
779 Resync_Past_Semicolon;
780 return Error;
782 end P_Representation_Clause;
784 ----------------------
785 -- 13.1 Local Name --
786 ----------------------
788 -- Local name is always parsed by its parent. In the case of its use in
789 -- pragmas, the check for a local name is handled in Par.Prag and allows
790 -- all the possible forms of local name. For the uses in chapter 13, we
791 -- currently only allow a direct name, but this should probably change???
793 ---------------------------
794 -- 13.1 At Clause (I.7) --
795 ---------------------------
797 -- Parsed by P_Representation_Clause (13.1)
799 ---------------------------------------
800 -- 13.3 Attribute Definition Clause --
801 ---------------------------------------
803 -- Parsed by P_Representation_Clause (13.1)
805 --------------------------------
806 -- 13.1 Aspect Specification --
807 --------------------------------
809 -- ASPECT_SPECIFICATION ::=
810 -- with ASPECT_MARK [=> ASPECT_DEFINITION] {,
811 -- ASPECT_MARK [=> ASPECT_DEFINITION] }
813 -- ASPECT_MARK ::= aspect_IDENTIFIER['Class]
815 -- ASPECT_DEFINITION ::= NAME | EXPRESSION
817 -- Error recovery: cannot raise Error_Resync
819 procedure P_Aspect_Specifications
820 (Decl : Node_Id;
821 Semicolon : Boolean := True)
823 Aspects : List_Id;
824 Ptr : Source_Ptr;
826 begin
827 -- Aspect Specification is present
829 Ptr := Token_Ptr;
831 -- Here we have an aspect specification to scan, note that we don't
832 -- set the flag till later, because it may turn out that we have no
833 -- valid aspects in the list.
835 Aspects := Get_Aspect_Specifications (Semicolon);
837 -- Here if aspects present
839 if Is_Non_Empty_List (Aspects) then
841 -- If Decl is Empty, we just ignore the aspects (the caller in this
842 -- case has always issued an appropriate error message).
844 if Decl = Empty then
845 null;
847 -- If Decl is Error, we ignore the aspects, and issue a message
849 elsif Decl = Error then
850 Error_Msg ("aspect specifications not allowed here", Ptr);
852 -- Here aspects are allowed, and we store them
854 else
855 Set_Parent (Aspects, Decl);
856 Set_Aspect_Specifications (Decl, Aspects);
857 end if;
858 end if;
859 end P_Aspect_Specifications;
861 ---------------------------------------------
862 -- 13.4 Enumeration Representation Clause --
863 ---------------------------------------------
865 -- Parsed by P_Representation_Clause (13.1)
867 ---------------------------------
868 -- 13.4 Enumeration Aggregate --
869 ---------------------------------
871 -- Parsed by P_Representation_Clause (13.1)
873 ------------------------------------------
874 -- 13.5.1 Record Representation Clause --
875 ------------------------------------------
877 -- Parsed by P_Representation_Clause (13.1)
879 ------------------------------
880 -- 13.5.1 Mod Clause (I.8) --
881 ------------------------------
883 -- MOD_CLAUSE ::= at mod static_EXPRESSION;
885 -- Note: in Ada 83, the expression must be a simple expression
887 -- The caller has checked that the initial Token is AT
889 -- Error recovery: cannot raise Error_Resync
891 -- Note: the caller is responsible for setting the Pragmas_Before field
893 function P_Mod_Clause return Node_Id is
894 Mod_Node : Node_Id;
895 Expr_Node : Node_Id;
897 begin
898 Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
899 Scan; -- past AT
900 T_Mod;
901 Expr_Node := P_Expression_No_Right_Paren;
902 Check_Simple_Expression_In_Ada_83 (Expr_Node);
903 Set_Expression (Mod_Node, Expr_Node);
904 TF_Semicolon;
905 return Mod_Node;
906 end P_Mod_Clause;
908 ------------------------------
909 -- 13.5.1 Component Clause --
910 ------------------------------
912 -- COMPONENT_CLAUSE ::=
913 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
914 -- range FIRST_BIT .. LAST_BIT;
916 -- COMPONENT_CLAUSE_COMPONENT_NAME ::=
917 -- component_DIRECT_NAME
918 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
919 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
921 -- POSITION ::= static_EXPRESSION
923 -- Note: in Ada 83, the expression must be a simple expression
925 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION
926 -- LAST_BIT ::= static_SIMPLE_EXPRESSION
928 -- Note: the AARM V2.0 grammar has an error at this point, it uses
929 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
931 -- Error recovery: cannot raise Error_Resync
933 function P_Component_Clause return Node_Id is
934 Component_Node : Node_Id;
935 Comp_Name : Node_Id;
936 Expr_Node : Node_Id;
938 begin
939 Component_Node := New_Node (N_Component_Clause, Token_Ptr);
940 Comp_Name := P_Name;
942 if Nkind (Comp_Name) = N_Identifier
943 or else Nkind (Comp_Name) = N_Attribute_Reference
944 then
945 Set_Component_Name (Component_Node, Comp_Name);
946 else
947 Error_Msg_N
948 ("component name must be direct name or attribute", Comp_Name);
949 Set_Component_Name (Component_Node, Error);
950 end if;
952 Set_Sloc (Component_Node, Token_Ptr);
953 T_At;
954 Expr_Node := P_Expression_No_Right_Paren;
955 Check_Simple_Expression_In_Ada_83 (Expr_Node);
956 Set_Position (Component_Node, Expr_Node);
957 T_Range;
958 Expr_Node := P_Expression_No_Right_Paren;
959 Check_Simple_Expression_In_Ada_83 (Expr_Node);
960 Set_First_Bit (Component_Node, Expr_Node);
961 T_Dot_Dot;
962 Expr_Node := P_Expression_No_Right_Paren;
963 Check_Simple_Expression_In_Ada_83 (Expr_Node);
964 Set_Last_Bit (Component_Node, Expr_Node);
965 TF_Semicolon;
966 return Component_Node;
967 end P_Component_Clause;
969 ----------------------
970 -- 13.5.1 Position --
971 ----------------------
973 -- Parsed by P_Component_Clause (13.5.1)
975 -----------------------
976 -- 13.5.1 First Bit --
977 -----------------------
979 -- Parsed by P_Component_Clause (13.5.1)
981 ----------------------
982 -- 13.5.1 Last Bit --
983 ----------------------
985 -- Parsed by P_Component_Clause (13.5.1)
987 --------------------------
988 -- 13.8 Code Statement --
989 --------------------------
991 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
993 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
994 -- single argument, and the scan points to the apostrophe.
996 -- Error recovery: can raise Error_Resync
998 function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
999 Node1 : Node_Id;
1001 begin
1002 Scan; -- past apostrophe
1004 -- If left paren, then we have a possible code statement
1006 if Token = Tok_Left_Paren then
1007 Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark));
1008 Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark));
1009 TF_Semicolon;
1010 return Node1;
1012 -- Otherwise we have an illegal range attribute. Note that P_Name
1013 -- ensures that Token = Tok_Range is the only possibility left here.
1015 else
1016 Error_Msg_SC ("RANGE attribute illegal here!");
1017 raise Error_Resync;
1018 end if;
1019 end P_Code_Statement;
1021 end Ch13;