gcc/ada/
[official-gcc.git] / gcc / ada / par-ch13.adb
blob5f448f67543d4d9ab209a722b591843027d689d3
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 function Possible_Misspelled_Aspect return Boolean;
49 -- Returns True, if Token_Name is a misspelling of some aspect name
51 --------------------------------
52 -- Possible_Misspelled_Aspect --
53 --------------------------------
55 function Possible_Misspelled_Aspect return Boolean is
56 begin
57 for J in Aspect_Id_Exclude_No_Aspect loop
58 if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
59 return True;
60 end if;
61 end loop;
63 return False;
64 end Possible_Misspelled_Aspect;
66 -- Start of processing for Aspect_Specifications_Present
68 begin
69 -- Definitely must have WITH to consider aspect specs to be present
71 -- Note that this means that if we have a semicolon, we immediately
72 -- return False. There is a case in which this is not optimal, namely
73 -- something like
75 -- type R is new Integer;
76 -- with bla bla;
78 -- where the semicolon is redundant, but scanning forward for it would
79 -- be too expensive. Instead we pick up the aspect specifications later
80 -- as a bogus declaration, and diagnose the semicolon at that point.
82 if Token /= Tok_With then
83 return False;
84 end if;
86 -- Have a WITH, see if it looks like an aspect specification
88 Save_Scan_State (Scan_State);
89 Scan; -- past WITH
91 -- If no identifier, then consider that we definitely do not have an
92 -- aspect specification.
94 if Token /= Tok_Identifier then
95 Result := False;
97 -- This is where we pay attention to the Strict mode. Normally when
98 -- we are in Ada 2012 mode, Strict is False, and we consider that we
99 -- have an aspect specification if the identifier is an aspect name
100 -- or a likely misspelling of one (even if not followed by =>) or
101 -- the identifier is not an aspect name but is followed by =>, by
102 -- a comma, or by a semicolon. The last two cases correspond to
103 -- (misspelled) Boolean aspects with a defaulted value of True.
104 -- P_Aspect_Specifications will generate messages if the aspect
105 -- specification is ill-formed.
107 elsif not Strict then
108 if Get_Aspect_Id (Token_Name) /= No_Aspect
109 or else Possible_Misspelled_Aspect
110 then
111 Result := True;
112 else
113 Scan; -- past identifier
114 Result := Token = Tok_Arrow or else
115 Token = Tok_Comma or else
116 Token = Tok_Semicolon;
117 end if;
119 -- If earlier than Ada 2012, check for valid aspect identifier (possibly
120 -- completed with 'CLASS) followed by an arrow, and consider that this
121 -- is still an aspect specification so we give an appropriate message.
123 else
124 if Get_Aspect_Id (Token_Name) = No_Aspect then
125 Result := False;
127 else
128 Scan; -- past aspect name
130 Result := False;
132 if Token = Tok_Arrow then
133 Result := True;
135 -- The identifier may be the name of a boolean aspect with a
136 -- defaulted True value. Further checks when analyzing aspect
137 -- specification, which may include further aspects.
139 elsif Token = Tok_Comma or else Token = Tok_Semicolon then
140 Result := True;
142 elsif Token = Tok_Apostrophe then
143 Scan; -- past apostrophe
145 if Token = Tok_Identifier
146 and then Token_Name = Name_Class
147 then
148 Scan; -- past CLASS
150 if Token = Tok_Arrow then
151 Result := True;
152 end if;
153 end if;
154 end if;
156 if Result then
157 Restore_Scan_State (Scan_State);
158 Error_Msg_Ada_2012_Feature ("|aspect specification", Token_Ptr);
159 return True;
160 end if;
161 end if;
162 end if;
164 Restore_Scan_State (Scan_State);
165 return Result;
166 end Aspect_Specifications_Present;
168 -------------------------------
169 -- Get_Aspect_Specifications --
170 -------------------------------
172 function Get_Aspect_Specifications
173 (Semicolon : Boolean := True) return List_Id
175 A_Id : Aspect_Id;
176 Aspect : Node_Id;
177 Aspects : List_Id;
178 OK : Boolean;
180 Opt : Boolean;
181 -- True if current aspect takes an optional argument
183 begin
184 Aspects := Empty_List;
186 -- Check if aspect specification present
188 if not Aspect_Specifications_Present then
189 if Semicolon then
190 TF_Semicolon;
191 end if;
193 return Aspects;
194 end if;
196 Scan; -- past WITH
197 Aspects := Empty_List;
199 -- Loop to scan aspects
201 loop
202 OK := True;
204 -- The aspect mark is not an identifier
206 if Token /= Tok_Identifier then
207 Error_Msg_SC ("aspect identifier expected");
209 -- Skip the whole aspect specification list
211 if Semicolon then
212 Resync_Past_Semicolon;
213 end if;
215 return Aspects;
216 end if;
218 A_Id := Get_Aspect_Id (Token_Name);
219 Aspect :=
220 Make_Aspect_Specification (Token_Ptr,
221 Identifier => Token_Node);
223 -- The aspect mark is not recognized
225 if A_Id = No_Aspect then
226 Error_Msg_N ("& is not a valid aspect identifier", Token_Node);
227 OK := False;
229 -- Check bad spelling
231 for J in Aspect_Id_Exclude_No_Aspect loop
232 if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
233 Error_Msg_Name_1 := Aspect_Names (J);
234 Error_Msg_N -- CODEFIX
235 ("\possible misspelling of%", Token_Node);
236 exit;
237 end if;
238 end loop;
240 Scan; -- past incorrect identifier
242 if Token = Tok_Apostrophe then
243 Scan; -- past apostrophe
244 Scan; -- past presumably CLASS
245 end if;
247 -- Attempt to parse the aspect definition by assuming it is an
248 -- expression.
250 if Token = Tok_Arrow then
251 Scan; -- past arrow
252 Set_Expression (Aspect, P_Expression);
254 -- If we have a correct terminator (comma or semicolon, or a
255 -- reasonable likely missing comma), then just proceed.
257 elsif Token = Tok_Comma or else
258 Token = Tok_Semicolon or else
259 Token = Tok_Identifier
260 then
261 null;
263 -- Otherwise the aspect contains a junk definition
265 else
266 if Semicolon then
267 Resync_Past_Semicolon;
268 end if;
270 return Aspects;
271 end if;
273 -- Aspect mark is OK
275 else
276 Scan; -- past identifier
277 Opt := Aspect_Argument (A_Id) = Optional_Expression
278 or else
279 Aspect_Argument (A_Id) = Optional_Name;
281 -- Check for 'Class present
283 if Token = Tok_Apostrophe then
284 if Class_Aspect_OK (A_Id) then
285 Scan; -- past apostrophe
287 if Token = Tok_Identifier
288 and then Token_Name = Name_Class
289 then
290 Scan; -- past CLASS
291 Set_Class_Present (Aspect);
292 else
293 Error_Msg_SC ("Class attribute expected here");
294 OK := False;
296 if Token = Tok_Identifier then
297 Scan; -- past identifier not CLASS
298 end if;
299 end if;
301 -- The aspect does not allow 'Class
303 else
304 Error_Msg_Node_1 := Identifier (Aspect);
305 Error_Msg_SC ("aspect& does not permit attribute here");
306 OK := False;
308 Scan; -- past apostrophe
309 Scan; -- past presumably CLASS
310 end if;
311 end if;
313 -- Check for a missing aspect definition. Aspects with optional
314 -- definitions are not considered.
316 if Token = Tok_Comma or else Token = Tok_Semicolon then
317 if not Opt then
318 Error_Msg_Node_1 := Identifier (Aspect);
319 Error_Msg_AP ("aspect& requires an aspect definition");
320 OK := False;
321 end if;
323 -- Here we do not have a comma or a semicolon, we are done if we
324 -- do not have an arrow and the aspect does not need an argument
326 elsif Opt and then Token /= Tok_Arrow then
327 null;
329 -- Here we have either an arrow, or an aspect that definitely
330 -- needs an aspect definition, and we will look for one even if
331 -- no arrow is preseant.
333 -- Otherwise we have an aspect definition
335 else
336 if Token = Tok_Arrow then
337 Scan; -- past arrow
338 else
339 T_Arrow;
340 OK := False;
341 end if;
343 -- Detect a common error where the non-null definition of
344 -- aspect Depends, Global, Refined_Depends, Refined_Global
345 -- or Refined_State lacks enclosing parentheses.
347 if Token /= Tok_Left_Paren and then Token /= Tok_Null then
349 -- [Refined_]Depends
351 if A_Id = Aspect_Depends
352 or else
353 A_Id = Aspect_Refined_Depends
354 then
355 Error_Msg_SC -- CODEFIX
356 ("missing ""(""");
357 Resync_Past_Malformed_Aspect;
359 -- Return when the current aspect is the last in the list
360 -- of specifications and the list applies to a body.
362 if Token = Tok_Is then
363 return Aspects;
364 end if;
366 -- [Refined_]Global
368 elsif A_Id = Aspect_Global
369 or else
370 A_Id = Aspect_Refined_Global
371 then
372 declare
373 Scan_State : Saved_Scan_State;
375 begin
376 Save_Scan_State (Scan_State);
377 Scan; -- past item or mode_selector
379 -- Emit an error when the aspect has a mode_selector
380 -- as the moded_global_list must be parenthesized:
381 -- with Global => Output => Item
383 if Token = Tok_Arrow then
384 Restore_Scan_State (Scan_State);
385 Error_Msg_SC -- CODEFIX
386 ("missing ""(""");
387 Resync_Past_Malformed_Aspect;
389 -- Return when the current aspect is the last in
390 -- the list of specifications and the list applies
391 -- to a body.
393 if Token = Tok_Is then
394 return Aspects;
395 end if;
397 elsif Token = Tok_Comma then
398 Scan; -- past comma
400 -- An item followed by a comma does not need to
401 -- be parenthesized if the next token is a valid
402 -- aspect name:
403 -- with Global => Item,
404 -- Aspect => ...
406 if Token = Tok_Identifier
407 and then Get_Aspect_Id (Token_Name) /= No_Aspect
408 then
409 Restore_Scan_State (Scan_State);
411 -- Otherwise this is a list of items in which case
412 -- the list must be parenthesized.
414 else
415 Restore_Scan_State (Scan_State);
416 Error_Msg_SC -- CODEFIX
417 ("missing ""(""");
418 Resync_Past_Malformed_Aspect;
420 -- Return when the current aspect is the last
421 -- in the list of specifications and the list
422 -- applies to a body.
424 if Token = Tok_Is then
425 return Aspects;
426 end if;
427 end if;
429 -- The definition of [Refined_]Global does not need to
430 -- be parenthesized.
432 else
433 Restore_Scan_State (Scan_State);
434 end if;
435 end;
437 -- Refined_State
439 elsif A_Id = Aspect_Refined_State then
440 if Token = Tok_Identifier then
441 declare
442 Scan_State : Saved_Scan_State;
444 begin
445 Save_Scan_State (Scan_State);
446 Scan; -- past state
448 -- The refinement contains a constituent, the whole
449 -- argument of Refined_State must be parenthesized.
451 -- with Refined_State => State => Constit
453 if Token = Tok_Arrow then
454 Restore_Scan_State (Scan_State);
455 Error_Msg_SC -- CODEFIX
456 ("missing ""(""");
457 Resync_Past_Malformed_Aspect;
459 -- Return when the current aspect is the last
460 -- in the list of specifications and the list
461 -- applies to a body.
463 if Token = Tok_Is then
464 return Aspects;
465 end if;
467 -- The refinement lacks constituents. Do not flag
468 -- this case as the error would be misleading. The
469 -- diagnostic is left to the analysis.
471 -- with Refined_State => State
473 else
474 Restore_Scan_State (Scan_State);
475 end if;
476 end;
477 end if;
478 end if;
479 end if;
481 -- Note if inside Depends aspect
483 if A_Id = Aspect_Depends then
484 Inside_Depends := True;
485 end if;
487 -- Parse the aspect definition depening on the expected
488 -- argument kind.
490 if Aspect_Argument (A_Id) = Name
491 or else Aspect_Argument (A_Id) = Optional_Name
492 then
493 Set_Expression (Aspect, P_Name);
495 else
496 pragma Assert
497 (Aspect_Argument (A_Id) = Expression
498 or else
499 Aspect_Argument (A_Id) = Optional_Expression);
500 Set_Expression (Aspect, P_Expression);
501 end if;
503 -- Unconditionally reset flag for Inside_Depends
505 Inside_Depends := False;
506 end if;
508 -- Add the aspect to the resulting list only when it was properly
509 -- parsed.
511 if OK then
512 Append (Aspect, Aspects);
513 end if;
514 end if;
516 -- Merge here after good or bad aspect (we should be at a comma
517 -- or a semicolon, but there might be other possible errors).
519 -- The aspect specification list contains more than one aspect
521 if Token = Tok_Comma then
522 Scan; -- past comma
523 goto Continue;
525 -- Check for a missing comma between two aspects. Emit an error
526 -- and proceed to the next aspect.
528 elsif Token = Tok_Identifier
529 and then Get_Aspect_Id (Token_Name) /= No_Aspect
530 then
531 declare
532 Scan_State : Saved_Scan_State;
534 begin
535 Save_Scan_State (Scan_State);
536 Scan; -- past identifier
538 -- Attempt to detect ' or => following a potential aspect
539 -- mark.
541 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
542 Restore_Scan_State (Scan_State);
543 Error_Msg_AP -- CODEFIX
544 ("|missing "",""");
545 goto Continue;
547 -- The construct following the current aspect is not an
548 -- aspect.
550 else
551 Restore_Scan_State (Scan_State);
552 end if;
553 end;
555 -- Check for a mistyped semicolon in place of a comma between two
556 -- aspects. Emit an error and proceed to the next aspect.
558 elsif Token = Tok_Semicolon then
559 declare
560 Scan_State : Saved_Scan_State;
562 begin
563 Save_Scan_State (Scan_State);
564 Scan; -- past semicolon
566 if Token = Tok_Identifier
567 and then Get_Aspect_Id (Token_Name) /= No_Aspect
568 then
569 Scan; -- past identifier
571 -- Attempt to detect ' or => following a potential aspect
572 -- mark.
574 if Token = Tok_Apostrophe or else Token = Tok_Arrow then
575 Restore_Scan_State (Scan_State);
576 Error_Msg_SC -- CODEFIX
577 ("|"";"" should be "",""");
578 Scan; -- past semicolon
579 goto Continue;
580 end if;
581 end if;
583 -- The construct following the current aspect is not an
584 -- aspect.
586 Restore_Scan_State (Scan_State);
587 end;
588 end if;
590 -- Must be terminator character
592 if Semicolon then
593 T_Semicolon;
594 end if;
596 exit;
598 <<Continue>>
599 null;
600 end loop;
602 return Aspects;
603 end Get_Aspect_Specifications;
605 --------------------------------------------
606 -- 13.1 Representation Clause (also I.7) --
607 --------------------------------------------
609 -- REPRESENTATION_CLAUSE ::=
610 -- ATTRIBUTE_DEFINITION_CLAUSE
611 -- | ENUMERATION_REPRESENTATION_CLAUSE
612 -- | RECORD_REPRESENTATION_CLAUSE
613 -- | AT_CLAUSE
615 -- ATTRIBUTE_DEFINITION_CLAUSE ::=
616 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
617 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
619 -- Note: in Ada 83, the expression must be a simple expression
621 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
623 -- Note: in Ada 83, the expression must be a simple expression
625 -- ENUMERATION_REPRESENTATION_CLAUSE ::=
626 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
628 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
630 -- RECORD_REPRESENTATION_CLAUSE ::=
631 -- for first_subtype_LOCAL_NAME use
632 -- record [MOD_CLAUSE]
633 -- {COMPONENT_CLAUSE}
634 -- end record;
636 -- Note: for now we allow only a direct name as the local name in the
637 -- above constructs. This probably needs changing later on ???
639 -- The caller has checked that the initial token is FOR
641 -- Error recovery: cannot raise Error_Resync, if an error occurs,
642 -- the scan is repositioned past the next semicolon.
644 function P_Representation_Clause return Node_Id is
645 For_Loc : Source_Ptr;
646 Name_Node : Node_Id;
647 Prefix_Node : Node_Id;
648 Attr_Name : Name_Id;
649 Identifier_Node : Node_Id;
650 Rep_Clause_Node : Node_Id;
651 Expr_Node : Node_Id;
652 Record_Items : List_Id;
654 begin
655 For_Loc := Token_Ptr;
656 Scan; -- past FOR
658 -- Note that the name in a representation clause is always a simple
659 -- name, even in the attribute case, see AI-300 which made this so.
661 Identifier_Node := P_Identifier (C_Use);
663 -- Check case of qualified name to give good error message
665 if Token = Tok_Dot then
666 Error_Msg_SC
667 ("representation clause requires simple name!");
669 loop
670 exit when Token /= Tok_Dot;
671 Scan; -- past dot
672 Discard_Junk_Node (P_Identifier);
673 end loop;
674 end if;
676 -- Attribute Definition Clause
678 if Token = Tok_Apostrophe then
680 -- Allow local names of the form a'b'.... This enables
681 -- us to parse class-wide streams attributes correctly.
683 Name_Node := Identifier_Node;
684 while Token = Tok_Apostrophe loop
686 Scan; -- past apostrophe
688 Identifier_Node := Token_Node;
689 Attr_Name := No_Name;
691 if Token = Tok_Identifier then
692 Attr_Name := Token_Name;
694 -- Note that the parser must complain in case of an internal
695 -- attribute name that comes from source since internal names
696 -- are meant to be used only by the compiler.
698 if not Is_Attribute_Name (Attr_Name)
699 and then (not Is_Internal_Attribute_Name (Attr_Name)
700 or else Comes_From_Source (Token_Node))
701 then
702 Signal_Bad_Attribute;
703 end if;
705 if Style_Check then
706 Style.Check_Attribute_Name (False);
707 end if;
709 -- Here for case of attribute designator is not an identifier
711 else
712 if Token = Tok_Delta then
713 Attr_Name := Name_Delta;
715 elsif Token = Tok_Digits then
716 Attr_Name := Name_Digits;
718 elsif Token = Tok_Access then
719 Attr_Name := Name_Access;
721 else
722 Error_Msg_AP ("attribute designator expected");
723 raise Error_Resync;
724 end if;
726 if Style_Check then
727 Style.Check_Attribute_Name (True);
728 end if;
729 end if;
731 -- We come here with an OK attribute scanned, and the
732 -- corresponding Attribute identifier node stored in Ident_Node.
734 Prefix_Node := Name_Node;
735 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
736 Set_Prefix (Name_Node, Prefix_Node);
737 Set_Attribute_Name (Name_Node, Attr_Name);
738 Scan;
739 end loop;
741 Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
742 Set_Name (Rep_Clause_Node, Prefix_Node);
743 Set_Chars (Rep_Clause_Node, Attr_Name);
744 T_Use;
746 Expr_Node := P_Expression_No_Right_Paren;
747 Check_Simple_Expression_In_Ada_83 (Expr_Node);
748 Set_Expression (Rep_Clause_Node, Expr_Node);
750 else
751 TF_Use;
752 Rep_Clause_Node := Empty;
754 -- AT follows USE (At Clause)
756 if Token = Tok_At then
757 Scan; -- past AT
758 Rep_Clause_Node := New_Node (N_At_Clause, For_Loc);
759 Set_Identifier (Rep_Clause_Node, Identifier_Node);
760 Expr_Node := P_Expression_No_Right_Paren;
761 Check_Simple_Expression_In_Ada_83 (Expr_Node);
762 Set_Expression (Rep_Clause_Node, Expr_Node);
764 -- RECORD follows USE (Record Representation Clause)
766 elsif Token = Tok_Record then
767 Record_Items := P_Pragmas_Opt;
768 Rep_Clause_Node :=
769 New_Node (N_Record_Representation_Clause, For_Loc);
770 Set_Identifier (Rep_Clause_Node, Identifier_Node);
772 Push_Scope_Stack;
773 Scope.Table (Scope.Last).Etyp := E_Record;
774 Scope.Table (Scope.Last).Ecol := Start_Column;
775 Scope.Table (Scope.Last).Sloc := Token_Ptr;
776 Scan; -- past RECORD
777 Record_Items := P_Pragmas_Opt;
779 -- Possible Mod Clause
781 if Token = Tok_At then
782 Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause);
783 Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items);
784 Record_Items := P_Pragmas_Opt;
785 end if;
787 if No (Record_Items) then
788 Record_Items := New_List;
789 end if;
791 Set_Component_Clauses (Rep_Clause_Node, Record_Items);
793 -- Loop through component clauses
795 loop
796 if Token not in Token_Class_Name then
797 exit when Check_End;
798 end if;
800 Append (P_Component_Clause, Record_Items);
801 P_Pragmas_Opt (Record_Items);
802 end loop;
804 -- Left paren follows USE (Enumeration Representation Clause)
806 elsif Token = Tok_Left_Paren then
807 Rep_Clause_Node :=
808 New_Node (N_Enumeration_Representation_Clause, For_Loc);
809 Set_Identifier (Rep_Clause_Node, Identifier_Node);
810 Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate);
812 -- Some other token follows FOR (invalid representation clause)
814 else
815 Error_Msg_SC ("invalid representation clause");
816 raise Error_Resync;
817 end if;
818 end if;
820 TF_Semicolon;
821 return Rep_Clause_Node;
823 exception
824 when Error_Resync =>
825 Resync_Past_Semicolon;
826 return Error;
828 end P_Representation_Clause;
830 ----------------------
831 -- 13.1 Local Name --
832 ----------------------
834 -- Local name is always parsed by its parent. In the case of its use in
835 -- pragmas, the check for a local name is handled in Par.Prag and allows
836 -- all the possible forms of local name. For the uses in chapter 13, we
837 -- currently only allow a direct name, but this should probably change???
839 ---------------------------
840 -- 13.1 At Clause (I.7) --
841 ---------------------------
843 -- Parsed by P_Representation_Clause (13.1)
845 ---------------------------------------
846 -- 13.3 Attribute Definition Clause --
847 ---------------------------------------
849 -- Parsed by P_Representation_Clause (13.1)
851 --------------------------------
852 -- 13.1 Aspect Specification --
853 --------------------------------
855 -- ASPECT_SPECIFICATION ::=
856 -- with ASPECT_MARK [=> ASPECT_DEFINITION] {,
857 -- ASPECT_MARK [=> ASPECT_DEFINITION] }
859 -- ASPECT_MARK ::= aspect_IDENTIFIER['Class]
861 -- ASPECT_DEFINITION ::= NAME | EXPRESSION
863 -- Error recovery: cannot raise Error_Resync
865 procedure P_Aspect_Specifications
866 (Decl : Node_Id;
867 Semicolon : Boolean := True)
869 Aspects : List_Id;
870 Ptr : Source_Ptr;
872 begin
873 -- Aspect Specification is present
875 Ptr := Token_Ptr;
877 -- Here we have an aspect specification to scan, note that we don't
878 -- set the flag till later, because it may turn out that we have no
879 -- valid aspects in the list.
881 Aspects := Get_Aspect_Specifications (Semicolon);
883 -- Here if aspects present
885 if Is_Non_Empty_List (Aspects) then
887 -- If Decl is Empty, we just ignore the aspects (the caller in this
888 -- case has always issued an appropriate error message).
890 if Decl = Empty then
891 null;
893 -- If Decl is Error, we ignore the aspects, and issue a message
895 elsif Decl = Error then
896 Error_Msg ("aspect specifications not allowed here", Ptr);
898 -- Here aspects are allowed, and we store them
900 else
901 Set_Parent (Aspects, Decl);
902 Set_Aspect_Specifications (Decl, Aspects);
903 end if;
904 end if;
905 end P_Aspect_Specifications;
907 ---------------------------------------------
908 -- 13.4 Enumeration Representation Clause --
909 ---------------------------------------------
911 -- Parsed by P_Representation_Clause (13.1)
913 ---------------------------------
914 -- 13.4 Enumeration Aggregate --
915 ---------------------------------
917 -- Parsed by P_Representation_Clause (13.1)
919 ------------------------------------------
920 -- 13.5.1 Record Representation Clause --
921 ------------------------------------------
923 -- Parsed by P_Representation_Clause (13.1)
925 ------------------------------
926 -- 13.5.1 Mod Clause (I.8) --
927 ------------------------------
929 -- MOD_CLAUSE ::= at mod static_EXPRESSION;
931 -- Note: in Ada 83, the expression must be a simple expression
933 -- The caller has checked that the initial Token is AT
935 -- Error recovery: cannot raise Error_Resync
937 -- Note: the caller is responsible for setting the Pragmas_Before field
939 function P_Mod_Clause return Node_Id is
940 Mod_Node : Node_Id;
941 Expr_Node : Node_Id;
943 begin
944 Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
945 Scan; -- past AT
946 T_Mod;
947 Expr_Node := P_Expression_No_Right_Paren;
948 Check_Simple_Expression_In_Ada_83 (Expr_Node);
949 Set_Expression (Mod_Node, Expr_Node);
950 TF_Semicolon;
951 return Mod_Node;
952 end P_Mod_Clause;
954 ------------------------------
955 -- 13.5.1 Component Clause --
956 ------------------------------
958 -- COMPONENT_CLAUSE ::=
959 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
960 -- range FIRST_BIT .. LAST_BIT;
962 -- COMPONENT_CLAUSE_COMPONENT_NAME ::=
963 -- component_DIRECT_NAME
964 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
965 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
967 -- POSITION ::= static_EXPRESSION
969 -- Note: in Ada 83, the expression must be a simple expression
971 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION
972 -- LAST_BIT ::= static_SIMPLE_EXPRESSION
974 -- Note: the AARM V2.0 grammar has an error at this point, it uses
975 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
977 -- Error recovery: cannot raise Error_Resync
979 function P_Component_Clause return Node_Id is
980 Component_Node : Node_Id;
981 Comp_Name : Node_Id;
982 Expr_Node : Node_Id;
984 begin
985 Component_Node := New_Node (N_Component_Clause, Token_Ptr);
986 Comp_Name := P_Name;
988 if Nkind (Comp_Name) = N_Identifier
989 or else Nkind (Comp_Name) = N_Attribute_Reference
990 then
991 Set_Component_Name (Component_Node, Comp_Name);
992 else
993 Error_Msg_N
994 ("component name must be direct name or attribute", Comp_Name);
995 Set_Component_Name (Component_Node, Error);
996 end if;
998 Set_Sloc (Component_Node, Token_Ptr);
999 T_At;
1000 Expr_Node := P_Expression_No_Right_Paren;
1001 Check_Simple_Expression_In_Ada_83 (Expr_Node);
1002 Set_Position (Component_Node, Expr_Node);
1003 T_Range;
1004 Expr_Node := P_Expression_No_Right_Paren;
1005 Check_Simple_Expression_In_Ada_83 (Expr_Node);
1006 Set_First_Bit (Component_Node, Expr_Node);
1007 T_Dot_Dot;
1008 Expr_Node := P_Expression_No_Right_Paren;
1009 Check_Simple_Expression_In_Ada_83 (Expr_Node);
1010 Set_Last_Bit (Component_Node, Expr_Node);
1011 TF_Semicolon;
1012 return Component_Node;
1013 end P_Component_Clause;
1015 ----------------------
1016 -- 13.5.1 Position --
1017 ----------------------
1019 -- Parsed by P_Component_Clause (13.5.1)
1021 -----------------------
1022 -- 13.5.1 First Bit --
1023 -----------------------
1025 -- Parsed by P_Component_Clause (13.5.1)
1027 ----------------------
1028 -- 13.5.1 Last Bit --
1029 ----------------------
1031 -- Parsed by P_Component_Clause (13.5.1)
1033 --------------------------
1034 -- 13.8 Code Statement --
1035 --------------------------
1037 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
1039 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
1040 -- single argument, and the scan points to the apostrophe.
1042 -- Error recovery: can raise Error_Resync
1044 function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
1045 Node1 : Node_Id;
1047 begin
1048 Scan; -- past apostrophe
1050 -- If left paren, then we have a possible code statement
1052 if Token = Tok_Left_Paren then
1053 Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark));
1054 Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark));
1055 TF_Semicolon;
1056 return Node1;
1058 -- Otherwise we have an illegal range attribute. Note that P_Name
1059 -- ensures that Token = Tok_Range is the only possibility left here.
1061 else
1062 Error_Msg_SC ("RANGE attribute illegal here!");
1063 raise Error_Resync;
1064 end if;
1065 end P_Code_Statement;
1067 end Ch13;