1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
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
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
;
48 function Possible_Misspelled_Aspect
return Boolean;
49 -- Returns True, if Token_Name is a misspelling of some aspect name
51 function With_Present
return Boolean;
52 -- Returns True if WITH is present, indicating presence of aspect
53 -- specifications. Also allows incorrect use of WHEN in place of WITH.
55 --------------------------------
56 -- Possible_Misspelled_Aspect --
57 --------------------------------
59 function Possible_Misspelled_Aspect
return Boolean is
61 for J
in Aspect_Id_Exclude_No_Aspect
loop
62 if Is_Bad_Spelling_Of
(Token_Name
, Aspect_Names
(J
)) then
68 end Possible_Misspelled_Aspect
;
74 function With_Present
return Boolean is
76 if Token
= Tok_With
then
79 -- Check for WHEN used in place of WITH
81 elsif Token
= Tok_When
then
83 Scan_State
: Saved_Scan_State
;
86 Save_Scan_State
(Scan_State
);
89 if Token
= Tok_Identifier
90 and then Get_Aspect_Id
(Token_Name
) /= No_Aspect
92 Error_Msg_SC
("WHEN should be WITH");
93 Restore_Scan_State
(Scan_State
);
97 Restore_Scan_State
(Scan_State
);
107 -- Start of processing for Aspect_Specifications_Present
110 -- Definitely must have WITH to consider aspect specs to be present
112 -- Note that this means that if we have a semicolon, we immediately
113 -- return False. There is a case in which this is not optimal, namely
116 -- type R is new Integer;
119 -- where the semicolon is redundant, but scanning forward for it would
120 -- be too expensive. Instead we pick up the aspect specifications later
121 -- as a bogus declaration, and diagnose the semicolon at that point.
123 if not With_Present
then
127 -- Have a WITH or some token that we accept as a legitimate bad attempt
128 -- at writing WITH. See if it looks like an aspect specification
130 Save_Scan_State
(Scan_State
);
131 Scan
; -- past WITH (or WHEN or other bad keyword)
133 -- If no identifier, then consider that we definitely do not have an
134 -- aspect specification.
136 if Token
/= Tok_Identifier
then
139 -- This is where we pay attention to the Strict mode. Normally when
140 -- we are in Ada 2012 mode, Strict is False, and we consider that we
141 -- have an aspect specification if the identifier is an aspect name
142 -- or a likely misspelling of one (even if not followed by =>) or
143 -- the identifier is not an aspect name but is followed by =>, by
144 -- a comma, or by a semicolon. The last two cases correspond to
145 -- (misspelled) Boolean aspects with a defaulted value of True.
146 -- P_Aspect_Specifications will generate messages if the aspect
147 -- specification is ill-formed.
149 elsif not Strict
then
150 if Get_Aspect_Id
(Token_Name
) /= No_Aspect
151 or else Possible_Misspelled_Aspect
155 Scan
; -- past identifier
156 Result
:= Token
= Tok_Arrow
or else
157 Token
= Tok_Comma
or else
158 Token
= Tok_Semicolon
;
161 -- If earlier than Ada 2012, check for valid aspect identifier (possibly
162 -- completed with 'CLASS) followed by an arrow, and consider that this
163 -- is still an aspect specification so we give an appropriate message.
166 if Get_Aspect_Id
(Token_Name
) = No_Aspect
then
170 Scan
; -- past aspect name
174 if Token
= Tok_Arrow
then
177 -- The identifier may be the name of a boolean aspect with a
178 -- defaulted True value. Further checks when analyzing aspect
179 -- specification, which may include further aspects.
181 elsif Token
= Tok_Comma
or else Token
= Tok_Semicolon
then
184 elsif Token
= Tok_Apostrophe
then
185 Scan
; -- past apostrophe
187 if Token
= Tok_Identifier
188 and then Token_Name
= Name_Class
192 if Token
= Tok_Arrow
then
199 Restore_Scan_State
(Scan_State
);
200 Error_Msg_Ada_2012_Feature
("|aspect specification", Token_Ptr
);
206 Restore_Scan_State
(Scan_State
);
208 end Aspect_Specifications_Present
;
210 -------------------------------
211 -- Get_Aspect_Specifications --
212 -------------------------------
214 function Get_Aspect_Specifications
215 (Semicolon
: Boolean := True) return List_Id
223 -- True if current aspect takes an optional argument
226 Aspects
:= Empty_List
;
228 -- Check if aspect specification present
230 if not Aspect_Specifications_Present
then
238 Scan
; -- past WITH (or possible WHEN after error)
239 Aspects
:= Empty_List
;
241 -- Loop to scan aspects
246 -- The aspect mark is not an identifier
248 if Token
/= Tok_Identifier
then
249 Error_Msg_SC
("aspect identifier expected");
251 -- Skip the whole aspect specification list
254 Resync_Past_Semicolon
;
260 A_Id
:= Get_Aspect_Id
(Token_Name
);
262 Make_Aspect_Specification
(Token_Ptr
,
263 Identifier
=> Token_Node
);
265 -- The aspect mark is not recognized
267 if A_Id
= No_Aspect
then
268 Error_Msg_N
("& is not a valid aspect identifier", Token_Node
);
271 -- Check bad spelling
273 for J
in Aspect_Id_Exclude_No_Aspect
loop
274 if Is_Bad_Spelling_Of
(Token_Name
, Aspect_Names
(J
)) then
275 Error_Msg_Name_1
:= Aspect_Names
(J
);
276 Error_Msg_N
-- CODEFIX
277 ("\possible misspelling of%", Token_Node
);
282 Scan
; -- past incorrect identifier
284 if Token
= Tok_Apostrophe
then
285 Scan
; -- past apostrophe
286 Scan
; -- past presumably CLASS
289 -- Attempt to parse the aspect definition by assuming it is an
292 if Token
= Tok_Arrow
then
294 Set_Expression
(Aspect
, P_Expression
);
296 -- If we have a correct terminator (comma or semicolon, or a
297 -- reasonable likely missing comma), then just proceed.
299 elsif Token
= Tok_Comma
or else
300 Token
= Tok_Semicolon
or else
301 Token
= Tok_Identifier
305 -- Otherwise the aspect contains a junk definition
309 Resync_Past_Semicolon
;
318 Scan
; -- past identifier
319 Opt
:= Aspect_Argument
(A_Id
) = Optional_Expression
321 Aspect_Argument
(A_Id
) = Optional_Name
;
323 -- Check for 'Class present
325 if Token
= Tok_Apostrophe
then
326 if Class_Aspect_OK
(A_Id
) then
327 Scan
; -- past apostrophe
329 if Token
= Tok_Identifier
330 and then Token_Name
= Name_Class
333 Set_Class_Present
(Aspect
);
335 Error_Msg_SC
("Class attribute expected here");
338 if Token
= Tok_Identifier
then
339 Scan
; -- past identifier not CLASS
343 -- The aspect does not allow 'Class
346 Error_Msg_Node_1
:= Identifier
(Aspect
);
347 Error_Msg_SC
("aspect& does not permit attribute here");
350 Scan
; -- past apostrophe
351 Scan
; -- past presumably CLASS
355 -- Check for a missing aspect definition. Aspects with optional
356 -- definitions are not considered.
358 if Token
= Tok_Comma
or else Token
= Tok_Semicolon
then
360 Error_Msg_Node_1
:= Identifier
(Aspect
);
361 Error_Msg_AP
("aspect& requires an aspect definition");
365 -- Here we do not have a comma or a semicolon, we are done if we
366 -- do not have an arrow and the aspect does not need an argument
368 elsif Opt
and then Token
/= Tok_Arrow
then
371 -- Here we have either an arrow, or an aspect that definitely
372 -- needs an aspect definition, and we will look for one even if
373 -- no arrow is preseant.
375 -- Otherwise we have an aspect definition
378 if Token
= Tok_Arrow
then
385 -- Detect a common error where the non-null definition of
386 -- aspect Depends, Global, Refined_Depends, Refined_Global
387 -- or Refined_State lacks enclosing parentheses.
389 if Token
/= Tok_Left_Paren
and then Token
/= Tok_Null
then
393 if A_Id
= Aspect_Depends
395 A_Id
= Aspect_Refined_Depends
397 Error_Msg_SC
-- CODEFIX
399 Resync_Past_Malformed_Aspect
;
401 -- Return when the current aspect is the last in the list
402 -- of specifications and the list applies to a body.
404 if Token
= Tok_Is
then
410 elsif A_Id
= Aspect_Global
412 A_Id
= Aspect_Refined_Global
415 Scan_State
: Saved_Scan_State
;
418 Save_Scan_State
(Scan_State
);
419 Scan
; -- past item or mode_selector
421 -- Emit an error when the aspect has a mode_selector
422 -- as the moded_global_list must be parenthesized:
423 -- with Global => Output => Item
425 if Token
= Tok_Arrow
then
426 Restore_Scan_State
(Scan_State
);
427 Error_Msg_SC
-- CODEFIX
429 Resync_Past_Malformed_Aspect
;
431 -- Return when the current aspect is the last in
432 -- the list of specifications and the list applies
435 if Token
= Tok_Is
then
439 elsif Token
= Tok_Comma
then
442 -- An item followed by a comma does not need to
443 -- be parenthesized if the next token is a valid
445 -- with Global => Item,
448 if Token
= Tok_Identifier
449 and then Get_Aspect_Id
(Token_Name
) /= No_Aspect
451 Restore_Scan_State
(Scan_State
);
453 -- Otherwise this is a list of items in which case
454 -- the list must be parenthesized.
457 Restore_Scan_State
(Scan_State
);
458 Error_Msg_SC
-- CODEFIX
460 Resync_Past_Malformed_Aspect
;
462 -- Return when the current aspect is the last
463 -- in the list of specifications and the list
464 -- applies to a body.
466 if Token
= Tok_Is
then
471 -- The definition of [Refined_]Global does not need to
475 Restore_Scan_State
(Scan_State
);
481 elsif A_Id
= Aspect_Refined_State
then
482 if Token
= Tok_Identifier
then
484 Scan_State
: Saved_Scan_State
;
487 Save_Scan_State
(Scan_State
);
490 -- The refinement contains a constituent, the whole
491 -- argument of Refined_State must be parenthesized.
493 -- with Refined_State => State => Constit
495 if Token
= Tok_Arrow
then
496 Restore_Scan_State
(Scan_State
);
497 Error_Msg_SC
-- CODEFIX
499 Resync_Past_Malformed_Aspect
;
501 -- Return when the current aspect is the last
502 -- in the list of specifications and the list
503 -- applies to a body.
505 if Token
= Tok_Is
then
509 -- The refinement lacks constituents. Do not flag
510 -- this case as the error would be misleading. The
511 -- diagnostic is left to the analysis.
513 -- with Refined_State => State
516 Restore_Scan_State
(Scan_State
);
523 -- Note if inside Depends aspect
525 if A_Id
= Aspect_Depends
then
526 Inside_Depends
:= True;
529 -- Parse the aspect definition depening on the expected
532 if Aspect_Argument
(A_Id
) = Name
533 or else Aspect_Argument
(A_Id
) = Optional_Name
535 Set_Expression
(Aspect
, P_Name
);
539 (Aspect_Argument
(A_Id
) = Expression
541 Aspect_Argument
(A_Id
) = Optional_Expression
);
542 Set_Expression
(Aspect
, P_Expression
);
545 -- Unconditionally reset flag for Inside_Depends
547 Inside_Depends
:= False;
550 -- Add the aspect to the resulting list only when it was properly
554 Append
(Aspect
, Aspects
);
558 -- Merge here after good or bad aspect (we should be at a comma
559 -- or a semicolon, but there might be other possible errors).
561 -- The aspect specification list contains more than one aspect
563 if Token
= Tok_Comma
then
567 -- Check for a missing comma between two aspects. Emit an error
568 -- and proceed to the next aspect.
570 elsif Token
= Tok_Identifier
571 and then Get_Aspect_Id
(Token_Name
) /= No_Aspect
574 Scan_State
: Saved_Scan_State
;
577 Save_Scan_State
(Scan_State
);
578 Scan
; -- past identifier
580 -- Attempt to detect ' or => following a potential aspect
583 if Token
= Tok_Apostrophe
or else Token
= Tok_Arrow
then
584 Restore_Scan_State
(Scan_State
);
585 Error_Msg_AP
-- CODEFIX
589 -- The construct following the current aspect is not an
593 Restore_Scan_State
(Scan_State
);
597 -- Check for a mistyped semicolon in place of a comma between two
598 -- aspects. Emit an error and proceed to the next aspect.
600 elsif Token
= Tok_Semicolon
then
602 Scan_State
: Saved_Scan_State
;
605 Save_Scan_State
(Scan_State
);
606 Scan
; -- past semicolon
608 if Token
= Tok_Identifier
609 and then Get_Aspect_Id
(Token_Name
) /= No_Aspect
611 Scan
; -- past identifier
613 -- Attempt to detect ' or => following potential aspect mark
615 if Token
= Tok_Apostrophe
or else Token
= Tok_Arrow
then
616 Restore_Scan_State
(Scan_State
);
617 Error_Msg_SC
-- CODEFIX
618 ("|"";"" should be "",""");
619 Scan
; -- past semicolon
624 -- Construct following the current aspect is not an aspect
626 Restore_Scan_State
(Scan_State
);
630 -- Require semicolon if caller expects to scan this out
643 end Get_Aspect_Specifications
;
645 --------------------------------------------
646 -- 13.1 Representation Clause (also I.7) --
647 --------------------------------------------
649 -- REPRESENTATION_CLAUSE ::=
650 -- ATTRIBUTE_DEFINITION_CLAUSE
651 -- | ENUMERATION_REPRESENTATION_CLAUSE
652 -- | RECORD_REPRESENTATION_CLAUSE
655 -- ATTRIBUTE_DEFINITION_CLAUSE ::=
656 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
657 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
659 -- Note: in Ada 83, the expression must be a simple expression
661 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
663 -- Note: in Ada 83, the expression must be a simple expression
665 -- ENUMERATION_REPRESENTATION_CLAUSE ::=
666 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
668 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
670 -- RECORD_REPRESENTATION_CLAUSE ::=
671 -- for first_subtype_LOCAL_NAME use
672 -- record [MOD_CLAUSE]
673 -- {COMPONENT_CLAUSE}
676 -- Note: for now we allow only a direct name as the local name in the
677 -- above constructs. This probably needs changing later on ???
679 -- The caller has checked that the initial token is FOR
681 -- Error recovery: cannot raise Error_Resync, if an error occurs,
682 -- the scan is repositioned past the next semicolon.
684 function P_Representation_Clause
return Node_Id
is
685 For_Loc
: Source_Ptr
;
687 Prefix_Node
: Node_Id
;
689 Identifier_Node
: Node_Id
;
690 Rep_Clause_Node
: Node_Id
;
692 Record_Items
: List_Id
;
695 For_Loc
:= Token_Ptr
;
698 -- Note that the name in a representation clause is always a simple
699 -- name, even in the attribute case, see AI-300 which made this so.
701 Identifier_Node
:= P_Identifier
(C_Use
);
703 -- Check case of qualified name to give good error message
705 if Token
= Tok_Dot
then
707 ("representation clause requires simple name!");
710 exit when Token
/= Tok_Dot
;
712 Discard_Junk_Node
(P_Identifier
);
716 -- Attribute Definition Clause
718 if Token
= Tok_Apostrophe
then
720 -- Allow local names of the form a'b'.... This enables
721 -- us to parse class-wide streams attributes correctly.
723 Name_Node
:= Identifier_Node
;
724 while Token
= Tok_Apostrophe
loop
726 Scan
; -- past apostrophe
728 Identifier_Node
:= Token_Node
;
729 Attr_Name
:= No_Name
;
731 if Token
= Tok_Identifier
then
732 Attr_Name
:= Token_Name
;
734 -- Note that the parser must complain in case of an internal
735 -- attribute name that comes from source since internal names
736 -- are meant to be used only by the compiler.
738 if not Is_Attribute_Name
(Attr_Name
)
739 and then (not Is_Internal_Attribute_Name
(Attr_Name
)
740 or else Comes_From_Source
(Token_Node
))
742 Signal_Bad_Attribute
;
746 Style
.Check_Attribute_Name
(False);
749 -- Here for case of attribute designator is not an identifier
752 if Token
= Tok_Delta
then
753 Attr_Name
:= Name_Delta
;
755 elsif Token
= Tok_Digits
then
756 Attr_Name
:= Name_Digits
;
758 elsif Token
= Tok_Access
then
759 Attr_Name
:= Name_Access
;
762 Error_Msg_AP
("attribute designator expected");
767 Style
.Check_Attribute_Name
(True);
771 -- Here we have an OK attribute scanned, and the corresponding
772 -- Attribute identifier node is stored in Ident_Node.
774 Prefix_Node
:= Name_Node
;
775 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
776 Set_Prefix
(Name_Node
, Prefix_Node
);
777 Set_Attribute_Name
(Name_Node
, Attr_Name
);
780 -- Check for Address clause which needs to be marked for use in
781 -- optimizing performance of Exp_Util.Following_Address_Clause.
783 if Attr_Name
= Name_Address
784 and then Nkind
(Prefix_Node
) = N_Identifier
786 Set_Name_Table_Boolean1
(Chars
(Prefix_Node
), True);
790 Rep_Clause_Node
:= New_Node
(N_Attribute_Definition_Clause
, For_Loc
);
791 Set_Name
(Rep_Clause_Node
, Prefix_Node
);
792 Set_Chars
(Rep_Clause_Node
, Attr_Name
);
795 Expr_Node
:= P_Expression_No_Right_Paren
;
796 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
797 Set_Expression
(Rep_Clause_Node
, Expr_Node
);
801 Rep_Clause_Node
:= Empty
;
803 -- AT follows USE (At Clause)
805 if Token
= Tok_At
then
807 Rep_Clause_Node
:= New_Node
(N_At_Clause
, For_Loc
);
808 Set_Identifier
(Rep_Clause_Node
, Identifier_Node
);
809 Expr_Node
:= P_Expression_No_Right_Paren
;
810 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
811 Set_Expression
(Rep_Clause_Node
, Expr_Node
);
813 -- Mark occurrence of address clause (used to optimize performance
814 -- of Exp_Util.Following_Address_Clause).
816 Set_Name_Table_Boolean1
(Chars
(Identifier_Node
), True);
818 -- RECORD follows USE (Record Representation Clause)
820 elsif Token
= Tok_Record
then
821 Record_Items
:= P_Pragmas_Opt
;
823 New_Node
(N_Record_Representation_Clause
, For_Loc
);
824 Set_Identifier
(Rep_Clause_Node
, Identifier_Node
);
827 Scope
.Table
(Scope
.Last
).Etyp
:= E_Record
;
828 Scope
.Table
(Scope
.Last
).Ecol
:= Start_Column
;
829 Scope
.Table
(Scope
.Last
).Sloc
:= Token_Ptr
;
831 Record_Items
:= P_Pragmas_Opt
;
833 -- Possible Mod Clause
835 if Token
= Tok_At
then
836 Set_Mod_Clause
(Rep_Clause_Node
, P_Mod_Clause
);
837 Set_Pragmas_Before
(Mod_Clause
(Rep_Clause_Node
), Record_Items
);
838 Record_Items
:= P_Pragmas_Opt
;
841 if No
(Record_Items
) then
842 Record_Items
:= New_List
;
845 Set_Component_Clauses
(Rep_Clause_Node
, Record_Items
);
847 -- Loop through component clauses
850 if Token
not in Token_Class_Name
then
854 Append
(P_Component_Clause
, Record_Items
);
855 P_Pragmas_Opt
(Record_Items
);
858 -- Left paren follows USE (Enumeration Representation Clause)
860 elsif Token
= Tok_Left_Paren
then
862 New_Node
(N_Enumeration_Representation_Clause
, For_Loc
);
863 Set_Identifier
(Rep_Clause_Node
, Identifier_Node
);
864 Set_Array_Aggregate
(Rep_Clause_Node
, P_Aggregate
);
866 -- Some other token follows FOR (invalid representation clause)
869 Error_Msg_SC
("invalid representation clause");
875 return Rep_Clause_Node
;
879 Resync_Past_Semicolon
;
882 end P_Representation_Clause
;
884 ----------------------
885 -- 13.1 Local Name --
886 ----------------------
888 -- Local name is always parsed by its parent. In the case of its use in
889 -- pragmas, the check for a local name is handled in Par.Prag and allows
890 -- all the possible forms of local name. For the uses in chapter 13, we
891 -- currently only allow a direct name, but this should probably change???
893 ---------------------------
894 -- 13.1 At Clause (I.7) --
895 ---------------------------
897 -- Parsed by P_Representation_Clause (13.1)
899 ---------------------------------------
900 -- 13.3 Attribute Definition Clause --
901 ---------------------------------------
903 -- Parsed by P_Representation_Clause (13.1)
905 --------------------------------
906 -- 13.1 Aspect Specification --
907 --------------------------------
909 -- ASPECT_SPECIFICATION ::=
910 -- with ASPECT_MARK [=> ASPECT_DEFINITION] {,
911 -- ASPECT_MARK [=> ASPECT_DEFINITION] }
913 -- ASPECT_MARK ::= aspect_IDENTIFIER['Class]
915 -- ASPECT_DEFINITION ::= NAME | EXPRESSION
917 -- Error recovery: cannot raise Error_Resync
919 procedure P_Aspect_Specifications
921 Semicolon
: Boolean := True)
927 -- Aspect Specification is present
931 -- Here we have an aspect specification to scan, note that we don't
932 -- set the flag till later, because it may turn out that we have no
933 -- valid aspects in the list.
935 Aspects
:= Get_Aspect_Specifications
(Semicolon
);
937 -- Here if aspects present
939 if Is_Non_Empty_List
(Aspects
) then
941 -- If Decl is Empty, we just ignore the aspects (the caller in this
942 -- case has always issued an appropriate error message).
947 -- If Decl is Error, we ignore the aspects, and issue a message
949 elsif Decl
= Error
then
950 Error_Msg
("aspect specifications not allowed here", Ptr
);
952 -- Here aspects are allowed, and we store them
955 Set_Parent
(Aspects
, Decl
);
956 Set_Aspect_Specifications
(Decl
, Aspects
);
959 end P_Aspect_Specifications
;
961 ---------------------------------------------
962 -- 13.4 Enumeration Representation Clause --
963 ---------------------------------------------
965 -- Parsed by P_Representation_Clause (13.1)
967 ---------------------------------
968 -- 13.4 Enumeration Aggregate --
969 ---------------------------------
971 -- Parsed by P_Representation_Clause (13.1)
973 ------------------------------------------
974 -- 13.5.1 Record Representation Clause --
975 ------------------------------------------
977 -- Parsed by P_Representation_Clause (13.1)
979 ------------------------------
980 -- 13.5.1 Mod Clause (I.8) --
981 ------------------------------
983 -- MOD_CLAUSE ::= at mod static_EXPRESSION;
985 -- Note: in Ada 83, the expression must be a simple expression
987 -- The caller has checked that the initial Token is AT
989 -- Error recovery: cannot raise Error_Resync
991 -- Note: the caller is responsible for setting the Pragmas_Before field
993 function P_Mod_Clause
return Node_Id
is
998 Mod_Node
:= New_Node
(N_Mod_Clause
, Token_Ptr
);
1001 Expr_Node
:= P_Expression_No_Right_Paren
;
1002 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
1003 Set_Expression
(Mod_Node
, Expr_Node
);
1008 ------------------------------
1009 -- 13.5.1 Component Clause --
1010 ------------------------------
1012 -- COMPONENT_CLAUSE ::=
1013 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
1014 -- range FIRST_BIT .. LAST_BIT;
1016 -- COMPONENT_CLAUSE_COMPONENT_NAME ::=
1017 -- component_DIRECT_NAME
1018 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
1019 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
1021 -- POSITION ::= static_EXPRESSION
1023 -- Note: in Ada 83, the expression must be a simple expression
1025 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION
1026 -- LAST_BIT ::= static_SIMPLE_EXPRESSION
1028 -- Note: the AARM V2.0 grammar has an error at this point, it uses
1029 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
1031 -- Error recovery: cannot raise Error_Resync
1033 function P_Component_Clause
return Node_Id
is
1034 Component_Node
: Node_Id
;
1035 Comp_Name
: Node_Id
;
1036 Expr_Node
: Node_Id
;
1039 Component_Node
:= New_Node
(N_Component_Clause
, Token_Ptr
);
1040 Comp_Name
:= P_Name
;
1042 if Nkind
(Comp_Name
) = N_Identifier
1043 or else Nkind
(Comp_Name
) = N_Attribute_Reference
1045 Set_Component_Name
(Component_Node
, Comp_Name
);
1048 ("component name must be direct name or attribute", Comp_Name
);
1049 Set_Component_Name
(Component_Node
, Error
);
1052 Set_Sloc
(Component_Node
, Token_Ptr
);
1054 Expr_Node
:= P_Expression_No_Right_Paren
;
1055 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
1056 Set_Position
(Component_Node
, Expr_Node
);
1058 Expr_Node
:= P_Expression_No_Right_Paren
;
1059 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
1060 Set_First_Bit
(Component_Node
, Expr_Node
);
1062 Expr_Node
:= P_Expression_No_Right_Paren
;
1063 Check_Simple_Expression_In_Ada_83
(Expr_Node
);
1064 Set_Last_Bit
(Component_Node
, Expr_Node
);
1066 return Component_Node
;
1067 end P_Component_Clause
;
1069 ----------------------
1070 -- 13.5.1 Position --
1071 ----------------------
1073 -- Parsed by P_Component_Clause (13.5.1)
1075 -----------------------
1076 -- 13.5.1 First Bit --
1077 -----------------------
1079 -- Parsed by P_Component_Clause (13.5.1)
1081 ----------------------
1082 -- 13.5.1 Last Bit --
1083 ----------------------
1085 -- Parsed by P_Component_Clause (13.5.1)
1087 --------------------------
1088 -- 13.8 Code Statement --
1089 --------------------------
1091 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
1093 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
1094 -- single argument, and the scan points to the apostrophe.
1096 -- Error recovery: can raise Error_Resync
1098 function P_Code_Statement
(Subtype_Mark
: Node_Id
) return Node_Id
is
1102 Scan
; -- past apostrophe
1104 -- If left paren, then we have a possible code statement
1106 if Token
= Tok_Left_Paren
then
1107 Node1
:= New_Node
(N_Code_Statement
, Sloc
(Subtype_Mark
));
1108 Set_Expression
(Node1
, P_Qualified_Expression
(Subtype_Mark
));
1112 -- Otherwise we have an illegal range attribute. Note that P_Name
1113 -- ensures that Token = Tok_Range is the only possibility left here.
1116 Error_Msg_SC
("RANGE attribute illegal here!");
1119 end P_Code_Statement
;