2014-09-15 Andreas Krebbel <Andreas.Krebbel@de.ibm.com>
[official-gcc.git] / gcc / ada / par-ch13.adb
blob2265bbf796d01b7a7b3f309b03f7057a210f9ea8
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 Opt : Boolean;
158 -- True if current aspect takes an optional argument
160 begin
161 Aspects := Empty_List;
163 -- Check if aspect specification present
165 if not Aspect_Specifications_Present then
166 if Semicolon then
167 TF_Semicolon;
168 end if;
170 return Aspects;
171 end if;
173 Scan; -- past WITH
174 Aspects := Empty_List;
176 -- Loop to scan aspects
178 loop
179 OK := True;
181 -- The aspect mark is not an identifier
183 if Token /= Tok_Identifier then
184 Error_Msg_SC ("aspect identifier expected");
186 -- Skip the whole aspect specification list
188 if Semicolon then
189 Resync_Past_Semicolon;
190 end if;
192 return Aspects;
193 end if;
195 A_Id := Get_Aspect_Id (Token_Name);
196 Aspect :=
197 Make_Aspect_Specification (Token_Ptr,
198 Identifier => Token_Node);
200 -- The aspect mark is not recognized
202 if A_Id = No_Aspect then
203 Error_Msg_N ("& is not a valid aspect identifier", Token_Node);
204 OK := False;
206 -- Check bad spelling
208 for J in Aspect_Id_Exclude_No_Aspect loop
209 if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
210 Error_Msg_Name_1 := Aspect_Names (J);
211 Error_Msg_N -- CODEFIX
212 ("\possible misspelling of%", Token_Node);
213 exit;
214 end if;
215 end loop;
217 Scan; -- past incorrect identifier
219 if Token = Tok_Apostrophe then
220 Scan; -- past apostrophe
221 Scan; -- past presumably CLASS
222 end if;
224 -- Attempt to parse the aspect definition by assuming it is an
225 -- expression.
227 if Token = Tok_Arrow then
228 Scan; -- past arrow
229 Set_Expression (Aspect, P_Expression);
231 -- If we have a correct terminator (comma or semicolon, or a
232 -- reasonable likely missing comma), then just proceed.
234 elsif Token = Tok_Comma or else
235 Token = Tok_Semicolon or else
236 Token = Tok_Identifier
237 then
238 null;
240 -- Otherwise the aspect contains a junk definition
242 else
243 if Semicolon then
244 Resync_Past_Semicolon;
245 end if;
247 return Aspects;
248 end if;
250 -- Aspect mark is OK
252 else
253 Scan; -- past identifier
254 Opt := Aspect_Argument (A_Id) = Optional_Expression
255 or else
256 Aspect_Argument (A_Id) = Optional_Name;
258 -- Check for 'Class present
260 if Token = Tok_Apostrophe then
261 if Class_Aspect_OK (A_Id) then
262 Scan; -- past apostrophe
264 if Token = Tok_Identifier
265 and then Token_Name = Name_Class
266 then
267 Scan; -- past CLASS
268 Set_Class_Present (Aspect);
269 else
270 Error_Msg_SC ("Class attribute expected here");
271 OK := False;
273 if Token = Tok_Identifier then
274 Scan; -- past identifier not CLASS
275 end if;
276 end if;
278 -- The aspect does not allow 'Class
280 else
281 Error_Msg_Node_1 := Identifier (Aspect);
282 Error_Msg_SC ("aspect& does not permit attribute here");
283 OK := False;
285 Scan; -- past apostrophe
286 Scan; -- past presumably CLASS
287 end if;
288 end if;
290 -- Check for a missing aspect definition. Aspects with optional
291 -- definitions are not considered.
293 if Token = Tok_Comma or else Token = Tok_Semicolon then
294 if not Opt then
295 Error_Msg_Node_1 := Identifier (Aspect);
296 Error_Msg_AP ("aspect& requires an aspect definition");
297 OK := False;
298 end if;
300 -- Here we do not have a comma or a semicolon, we are done if we
301 -- do not have an arrow and the aspect does not need an argument
303 elsif Opt and then Token /= Tok_Arrow then
304 null;
306 -- Here we have either an arrow, or an aspect that definitely
307 -- needs an aspect definition, and we will look for one even if
308 -- no arrow is preseant.
310 -- Otherwise we have an aspect definition
312 else
313 if Token = Tok_Arrow then
314 Scan; -- past arrow
315 else
316 T_Arrow;
317 OK := False;
318 end if;
320 -- Detect a common error where the non-null definition of
321 -- aspect Depends, Global, Refined_Depends, Refined_Global
322 -- or Refined_State lacks enclosing parentheses.
324 if Token /= Tok_Left_Paren and then Token /= Tok_Null then
326 -- [Refined_]Depends
328 if A_Id = Aspect_Depends
329 or else
330 A_Id = Aspect_Refined_Depends
331 then
332 Error_Msg_SC -- CODEFIX
333 ("missing ""(""");
334 Resync_Past_Malformed_Aspect;
336 -- Return when the current aspect is the last in the list
337 -- of specifications and the list applies to a body.
339 if Token = Tok_Is then
340 return Aspects;
341 end if;
343 -- [Refined_]Global
345 elsif A_Id = Aspect_Global
346 or else
347 A_Id = Aspect_Refined_Global
348 then
349 declare
350 Scan_State : Saved_Scan_State;
352 begin
353 Save_Scan_State (Scan_State);
354 Scan; -- past item or mode_selector
356 -- Emit an error when the aspect has a mode_selector
357 -- as the moded_global_list must be parenthesized:
358 -- with Global => Output => Item
360 if Token = Tok_Arrow then
361 Restore_Scan_State (Scan_State);
362 Error_Msg_SC -- CODEFIX
363 ("missing ""(""");
364 Resync_Past_Malformed_Aspect;
366 -- Return when the current aspect is the last in
367 -- the list of specifications and the list applies
368 -- to a body.
370 if Token = Tok_Is then
371 return Aspects;
372 end if;
374 elsif Token = Tok_Comma then
375 Scan; -- past comma
377 -- An item followed by a comma does not need to
378 -- be parenthesized if the next token is a valid
379 -- aspect name:
380 -- with Global => Item,
381 -- Aspect => ...
383 if Token = Tok_Identifier
384 and then Get_Aspect_Id (Token_Name) /= No_Aspect
385 then
386 Restore_Scan_State (Scan_State);
388 -- Otherwise this is a list of items in which case
389 -- the list must be parenthesized.
391 else
392 Restore_Scan_State (Scan_State);
393 Error_Msg_SC -- CODEFIX
394 ("missing ""(""");
395 Resync_Past_Malformed_Aspect;
397 -- Return when the current aspect is the last
398 -- in the list of specifications and the list
399 -- applies to a body.
401 if Token = Tok_Is then
402 return Aspects;
403 end if;
404 end if;
406 -- The definition of [Refined_]Global does not need to
407 -- be parenthesized.
409 else
410 Restore_Scan_State (Scan_State);
411 end if;
412 end;
414 -- Refined_State
416 elsif A_Id = Aspect_Refined_State then
417 if Token = Tok_Identifier then
418 declare
419 Scan_State : Saved_Scan_State;
421 begin
422 Save_Scan_State (Scan_State);
423 Scan; -- past state
425 -- The refinement contains a constituent, the whole
426 -- argument of Refined_State must be parenthesized.
428 -- with Refined_State => State => Constit
430 if Token = Tok_Arrow then
431 Restore_Scan_State (Scan_State);
432 Error_Msg_SC -- CODEFIX
433 ("missing ""(""");
434 Resync_Past_Malformed_Aspect;
436 -- Return when the current aspect is the last
437 -- in the list of specifications and the list
438 -- applies to a body.
440 if Token = Tok_Is then
441 return Aspects;
442 end if;
444 -- The refinement lacks constituents. Do not flag
445 -- this case as the error would be misleading. The
446 -- diagnostic is left to the analysis.
448 -- with Refined_State => State
450 else
451 Restore_Scan_State (Scan_State);
452 end if;
453 end;
454 end if;
455 end if;
456 end if;
458 -- Note if inside Depends aspect
460 if A_Id = Aspect_Depends then
461 Inside_Depends := True;
462 end if;
464 -- Parse the aspect definition depening on the expected
465 -- argument kind.
467 if Aspect_Argument (A_Id) = Name
468 or else Aspect_Argument (A_Id) = Optional_Name
469 then
470 Set_Expression (Aspect, P_Name);
472 else
473 pragma Assert
474 (Aspect_Argument (A_Id) = Expression
475 or else
476 Aspect_Argument (A_Id) = Optional_Expression);
477 Set_Expression (Aspect, P_Expression);
478 end if;
480 -- Unconditionally reset flag for Inside_Depends
482 Inside_Depends := False;
483 end if;
485 -- Add the aspect to the resulting list only when it was properly
486 -- parsed.
488 if OK then
489 Append (Aspect, Aspects);
490 end if;
491 end if;
493 -- Merge here after good or bad aspect (we should be at a comma
494 -- or a semicolon, but there might be other possible errors).
496 -- The aspect specification list contains more than one aspect
498 if Token = Tok_Comma then
499 Scan; -- past comma
500 goto Continue;
502 -- Check for a missing comma between two aspects. Emit an error
503 -- and proceed to the next aspect.
505 elsif Token = Tok_Identifier
506 and then Get_Aspect_Id (Token_Name) /= No_Aspect
507 then
508 declare
509 Scan_State : Saved_Scan_State;
511 begin
512 Save_Scan_State (Scan_State);
513 Scan; -- past identifier
515 -- Attempt to detect ' or => following a potential aspect
516 -- mark.
518 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
519 Restore_Scan_State (Scan_State);
520 Error_Msg_AP -- CODEFIX
521 ("|missing "",""");
522 goto Continue;
524 -- The construct following the current aspect is not an
525 -- aspect.
527 else
528 Restore_Scan_State (Scan_State);
529 end if;
530 end;
532 -- Check for a mistyped semicolon in place of a comma between two
533 -- aspects. Emit an error and proceed to the next aspect.
535 elsif Token = Tok_Semicolon then
536 declare
537 Scan_State : Saved_Scan_State;
539 begin
540 Save_Scan_State (Scan_State);
541 Scan; -- past semicolon
543 if Token = Tok_Identifier
544 and then Get_Aspect_Id (Token_Name) /= No_Aspect
545 then
546 Scan; -- past identifier
548 -- Attempt to detect ' or => following a potential aspect
549 -- mark.
551 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
552 Restore_Scan_State (Scan_State);
553 Error_Msg_SC -- CODEFIX
554 ("|"";"" should be "",""");
555 Scan; -- past semicolon
556 goto Continue;
557 end if;
558 end if;
560 -- The construct following the current aspect is not an
561 -- aspect.
563 Restore_Scan_State (Scan_State);
564 end;
565 end if;
567 -- Must be terminator character
569 if Semicolon then
570 T_Semicolon;
571 end if;
573 exit;
575 <<Continue>>
576 null;
577 end loop;
579 return Aspects;
580 end Get_Aspect_Specifications;
582 --------------------------------------------
583 -- 13.1 Representation Clause (also I.7) --
584 --------------------------------------------
586 -- REPRESENTATION_CLAUSE ::=
587 -- ATTRIBUTE_DEFINITION_CLAUSE
588 -- | ENUMERATION_REPRESENTATION_CLAUSE
589 -- | RECORD_REPRESENTATION_CLAUSE
590 -- | AT_CLAUSE
592 -- ATTRIBUTE_DEFINITION_CLAUSE ::=
593 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
594 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
596 -- Note: in Ada 83, the expression must be a simple expression
598 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
600 -- Note: in Ada 83, the expression must be a simple expression
602 -- ENUMERATION_REPRESENTATION_CLAUSE ::=
603 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
605 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
607 -- RECORD_REPRESENTATION_CLAUSE ::=
608 -- for first_subtype_LOCAL_NAME use
609 -- record [MOD_CLAUSE]
610 -- {COMPONENT_CLAUSE}
611 -- end record;
613 -- Note: for now we allow only a direct name as the local name in the
614 -- above constructs. This probably needs changing later on ???
616 -- The caller has checked that the initial token is FOR
618 -- Error recovery: cannot raise Error_Resync, if an error occurs,
619 -- the scan is repositioned past the next semicolon.
621 function P_Representation_Clause return Node_Id is
622 For_Loc : Source_Ptr;
623 Name_Node : Node_Id;
624 Prefix_Node : Node_Id;
625 Attr_Name : Name_Id;
626 Identifier_Node : Node_Id;
627 Rep_Clause_Node : Node_Id;
628 Expr_Node : Node_Id;
629 Record_Items : List_Id;
631 begin
632 For_Loc := Token_Ptr;
633 Scan; -- past FOR
635 -- Note that the name in a representation clause is always a simple
636 -- name, even in the attribute case, see AI-300 which made this so.
638 Identifier_Node := P_Identifier (C_Use);
640 -- Check case of qualified name to give good error message
642 if Token = Tok_Dot then
643 Error_Msg_SC
644 ("representation clause requires simple name!");
646 loop
647 exit when Token /= Tok_Dot;
648 Scan; -- past dot
649 Discard_Junk_Node (P_Identifier);
650 end loop;
651 end if;
653 -- Attribute Definition Clause
655 if Token = Tok_Apostrophe then
657 -- Allow local names of the form a'b'.... This enables
658 -- us to parse class-wide streams attributes correctly.
660 Name_Node := Identifier_Node;
661 while Token = Tok_Apostrophe loop
663 Scan; -- past apostrophe
665 Identifier_Node := Token_Node;
666 Attr_Name := No_Name;
668 if Token = Tok_Identifier then
669 Attr_Name := Token_Name;
671 -- Note that the parser must complain in case of an internal
672 -- attribute name that comes from source since internal names
673 -- are meant to be used only by the compiler.
675 if not Is_Attribute_Name (Attr_Name)
676 and then (not Is_Internal_Attribute_Name (Attr_Name)
677 or else Comes_From_Source (Token_Node))
678 then
679 Signal_Bad_Attribute;
680 end if;
682 if Style_Check then
683 Style.Check_Attribute_Name (False);
684 end if;
686 -- Here for case of attribute designator is not an identifier
688 else
689 if Token = Tok_Delta then
690 Attr_Name := Name_Delta;
692 elsif Token = Tok_Digits then
693 Attr_Name := Name_Digits;
695 elsif Token = Tok_Access then
696 Attr_Name := Name_Access;
698 else
699 Error_Msg_AP ("attribute designator expected");
700 raise Error_Resync;
701 end if;
703 if Style_Check then
704 Style.Check_Attribute_Name (True);
705 end if;
706 end if;
708 -- We come here with an OK attribute scanned, and the
709 -- corresponding Attribute identifier node stored in Ident_Node.
711 Prefix_Node := Name_Node;
712 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
713 Set_Prefix (Name_Node, Prefix_Node);
714 Set_Attribute_Name (Name_Node, Attr_Name);
715 Scan;
716 end loop;
718 Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
719 Set_Name (Rep_Clause_Node, Prefix_Node);
720 Set_Chars (Rep_Clause_Node, Attr_Name);
721 T_Use;
723 Expr_Node := P_Expression_No_Right_Paren;
724 Check_Simple_Expression_In_Ada_83 (Expr_Node);
725 Set_Expression (Rep_Clause_Node, Expr_Node);
727 else
728 TF_Use;
729 Rep_Clause_Node := Empty;
731 -- AT follows USE (At Clause)
733 if Token = Tok_At then
734 Scan; -- past AT
735 Rep_Clause_Node := New_Node (N_At_Clause, For_Loc);
736 Set_Identifier (Rep_Clause_Node, Identifier_Node);
737 Expr_Node := P_Expression_No_Right_Paren;
738 Check_Simple_Expression_In_Ada_83 (Expr_Node);
739 Set_Expression (Rep_Clause_Node, Expr_Node);
741 -- RECORD follows USE (Record Representation Clause)
743 elsif Token = Tok_Record then
744 Record_Items := P_Pragmas_Opt;
745 Rep_Clause_Node :=
746 New_Node (N_Record_Representation_Clause, For_Loc);
747 Set_Identifier (Rep_Clause_Node, Identifier_Node);
749 Push_Scope_Stack;
750 Scope.Table (Scope.Last).Etyp := E_Record;
751 Scope.Table (Scope.Last).Ecol := Start_Column;
752 Scope.Table (Scope.Last).Sloc := Token_Ptr;
753 Scan; -- past RECORD
754 Record_Items := P_Pragmas_Opt;
756 -- Possible Mod Clause
758 if Token = Tok_At then
759 Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause);
760 Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items);
761 Record_Items := P_Pragmas_Opt;
762 end if;
764 if No (Record_Items) then
765 Record_Items := New_List;
766 end if;
768 Set_Component_Clauses (Rep_Clause_Node, Record_Items);
770 -- Loop through component clauses
772 loop
773 if Token not in Token_Class_Name then
774 exit when Check_End;
775 end if;
777 Append (P_Component_Clause, Record_Items);
778 P_Pragmas_Opt (Record_Items);
779 end loop;
781 -- Left paren follows USE (Enumeration Representation Clause)
783 elsif Token = Tok_Left_Paren then
784 Rep_Clause_Node :=
785 New_Node (N_Enumeration_Representation_Clause, For_Loc);
786 Set_Identifier (Rep_Clause_Node, Identifier_Node);
787 Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate);
789 -- Some other token follows FOR (invalid representation clause)
791 else
792 Error_Msg_SC ("invalid representation clause");
793 raise Error_Resync;
794 end if;
795 end if;
797 TF_Semicolon;
798 return Rep_Clause_Node;
800 exception
801 when Error_Resync =>
802 Resync_Past_Semicolon;
803 return Error;
805 end P_Representation_Clause;
807 ----------------------
808 -- 13.1 Local Name --
809 ----------------------
811 -- Local name is always parsed by its parent. In the case of its use in
812 -- pragmas, the check for a local name is handled in Par.Prag and allows
813 -- all the possible forms of local name. For the uses in chapter 13, we
814 -- currently only allow a direct name, but this should probably change???
816 ---------------------------
817 -- 13.1 At Clause (I.7) --
818 ---------------------------
820 -- Parsed by P_Representation_Clause (13.1)
822 ---------------------------------------
823 -- 13.3 Attribute Definition Clause --
824 ---------------------------------------
826 -- Parsed by P_Representation_Clause (13.1)
828 --------------------------------
829 -- 13.1 Aspect Specification --
830 --------------------------------
832 -- ASPECT_SPECIFICATION ::=
833 -- with ASPECT_MARK [=> ASPECT_DEFINITION] {,
834 -- ASPECT_MARK [=> ASPECT_DEFINITION] }
836 -- ASPECT_MARK ::= aspect_IDENTIFIER['Class]
838 -- ASPECT_DEFINITION ::= NAME | EXPRESSION
840 -- Error recovery: cannot raise Error_Resync
842 procedure P_Aspect_Specifications
843 (Decl : Node_Id;
844 Semicolon : Boolean := True)
846 Aspects : List_Id;
847 Ptr : Source_Ptr;
849 begin
850 -- Aspect Specification is present
852 Ptr := Token_Ptr;
854 -- Here we have an aspect specification to scan, note that we don't
855 -- set the flag till later, because it may turn out that we have no
856 -- valid aspects in the list.
858 Aspects := Get_Aspect_Specifications (Semicolon);
860 -- Here if aspects present
862 if Is_Non_Empty_List (Aspects) then
864 -- If Decl is Empty, we just ignore the aspects (the caller in this
865 -- case has always issued an appropriate error message).
867 if Decl = Empty then
868 null;
870 -- If Decl is Error, we ignore the aspects, and issue a message
872 elsif Decl = Error then
873 Error_Msg ("aspect specifications not allowed here", Ptr);
875 -- Here aspects are allowed, and we store them
877 else
878 Set_Parent (Aspects, Decl);
879 Set_Aspect_Specifications (Decl, Aspects);
880 end if;
881 end if;
882 end P_Aspect_Specifications;
884 ---------------------------------------------
885 -- 13.4 Enumeration Representation Clause --
886 ---------------------------------------------
888 -- Parsed by P_Representation_Clause (13.1)
890 ---------------------------------
891 -- 13.4 Enumeration Aggregate --
892 ---------------------------------
894 -- Parsed by P_Representation_Clause (13.1)
896 ------------------------------------------
897 -- 13.5.1 Record Representation Clause --
898 ------------------------------------------
900 -- Parsed by P_Representation_Clause (13.1)
902 ------------------------------
903 -- 13.5.1 Mod Clause (I.8) --
904 ------------------------------
906 -- MOD_CLAUSE ::= at mod static_EXPRESSION;
908 -- Note: in Ada 83, the expression must be a simple expression
910 -- The caller has checked that the initial Token is AT
912 -- Error recovery: cannot raise Error_Resync
914 -- Note: the caller is responsible for setting the Pragmas_Before field
916 function P_Mod_Clause return Node_Id is
917 Mod_Node : Node_Id;
918 Expr_Node : Node_Id;
920 begin
921 Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
922 Scan; -- past AT
923 T_Mod;
924 Expr_Node := P_Expression_No_Right_Paren;
925 Check_Simple_Expression_In_Ada_83 (Expr_Node);
926 Set_Expression (Mod_Node, Expr_Node);
927 TF_Semicolon;
928 return Mod_Node;
929 end P_Mod_Clause;
931 ------------------------------
932 -- 13.5.1 Component Clause --
933 ------------------------------
935 -- COMPONENT_CLAUSE ::=
936 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
937 -- range FIRST_BIT .. LAST_BIT;
939 -- COMPONENT_CLAUSE_COMPONENT_NAME ::=
940 -- component_DIRECT_NAME
941 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
942 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
944 -- POSITION ::= static_EXPRESSION
946 -- Note: in Ada 83, the expression must be a simple expression
948 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION
949 -- LAST_BIT ::= static_SIMPLE_EXPRESSION
951 -- Note: the AARM V2.0 grammar has an error at this point, it uses
952 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
954 -- Error recovery: cannot raise Error_Resync
956 function P_Component_Clause return Node_Id is
957 Component_Node : Node_Id;
958 Comp_Name : Node_Id;
959 Expr_Node : Node_Id;
961 begin
962 Component_Node := New_Node (N_Component_Clause, Token_Ptr);
963 Comp_Name := P_Name;
965 if Nkind (Comp_Name) = N_Identifier
966 or else Nkind (Comp_Name) = N_Attribute_Reference
967 then
968 Set_Component_Name (Component_Node, Comp_Name);
969 else
970 Error_Msg_N
971 ("component name must be direct name or attribute", Comp_Name);
972 Set_Component_Name (Component_Node, Error);
973 end if;
975 Set_Sloc (Component_Node, Token_Ptr);
976 T_At;
977 Expr_Node := P_Expression_No_Right_Paren;
978 Check_Simple_Expression_In_Ada_83 (Expr_Node);
979 Set_Position (Component_Node, Expr_Node);
980 T_Range;
981 Expr_Node := P_Expression_No_Right_Paren;
982 Check_Simple_Expression_In_Ada_83 (Expr_Node);
983 Set_First_Bit (Component_Node, Expr_Node);
984 T_Dot_Dot;
985 Expr_Node := P_Expression_No_Right_Paren;
986 Check_Simple_Expression_In_Ada_83 (Expr_Node);
987 Set_Last_Bit (Component_Node, Expr_Node);
988 TF_Semicolon;
989 return Component_Node;
990 end P_Component_Clause;
992 ----------------------
993 -- 13.5.1 Position --
994 ----------------------
996 -- Parsed by P_Component_Clause (13.5.1)
998 -----------------------
999 -- 13.5.1 First Bit --
1000 -----------------------
1002 -- Parsed by P_Component_Clause (13.5.1)
1004 ----------------------
1005 -- 13.5.1 Last Bit --
1006 ----------------------
1008 -- Parsed by P_Component_Clause (13.5.1)
1010 --------------------------
1011 -- 13.8 Code Statement --
1012 --------------------------
1014 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
1016 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
1017 -- single argument, and the scan points to the apostrophe.
1019 -- Error recovery: can raise Error_Resync
1021 function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
1022 Node1 : Node_Id;
1024 begin
1025 Scan; -- past apostrophe
1027 -- If left paren, then we have a possible code statement
1029 if Token = Tok_Left_Paren then
1030 Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark));
1031 Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark));
1032 TF_Semicolon;
1033 return Node1;
1035 -- Otherwise we have an illegal range attribute. Note that P_Name
1036 -- ensures that Token = Tok_Range is the only possibility left here.
1038 else
1039 Error_Msg_SC ("RANGE attribute illegal here!");
1040 raise Error_Resync;
1041 end if;
1042 end P_Code_Statement;
1044 end Ch13;