1 -----------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2020, 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
30 with Stringt; use Stringt;
35 -- Attributes that cannot have arguments
37 Is_Parameterless_Attribute : constant Attribute_Class_Array :=
38 (Attribute_Base => True,
39 Attribute_Body_Version => True,
40 Attribute_Class => True,
41 Attribute_External_Tag => True,
42 Attribute_Img => True,
43 Attribute_Loop_Entry => True,
44 Attribute_Old => True,
45 Attribute_Result => True,
46 Attribute_Stub_Type => True,
47 Attribute_Version => True,
48 Attribute_Type_Key => True,
50 -- This map contains True for parameterless attributes that return a string
51 -- or a type. For those attributes, a left parenthesis after the attribute
52 -- should not be analyzed as the beginning of a parameters list because it
53 -- may denote a slice operation (X'Img (1 .. 2)) or a type conversion
56 -- Note: Loop_Entry is in this list because, although it can take an
57 -- optional argument (the loop name), we can't distinguish that at parse
58 -- time from the case where no loop name is given and a legitimate index
59 -- expression is present. So we parse the argument as an indexed component
60 -- and the semantic analysis sorts out this syntactic ambiguity based on
61 -- the type and form of the expression.
63 -- Note that this map designates the minimum set of attributes where a
64 -- construct in parentheses that is not an argument can appear right
65 -- after the attribute. For attributes like 'Size, we do not put them
66 -- in the map. If someone writes X'Size (3), that's illegal in any case,
67 -- but we get a better error message by parsing the (3) as an illegal
68 -- argument to the attribute, rather than some meaningless junk that
69 -- follows the attribute.
71 -----------------------
72 -- Local Subprograms --
73 -----------------------
75 function P_Aggregate_Or_Paren_Expr return Node_Id;
76 function P_Allocator return Node_Id;
77 function P_Case_Expression_Alternative return Node_Id;
78 function P_Iterated_Component_Association return Node_Id;
79 function P_Record_Or_Array_Component_Association return Node_Id;
80 function P_Factor return Node_Id;
81 function P_Primary return Node_Id;
82 function P_Relation return Node_Id;
83 function P_Term return Node_Id;
84 function P_Reduction_Attribute_Reference (S : Node_Id)
87 function P_Binary_Adding_Operator return Node_Kind;
88 function P_Logical_Operator return Node_Kind;
89 function P_Multiplying_Operator return Node_Kind;
90 function P_Relational_Operator return Node_Kind;
91 function P_Unary_Adding_Operator return Node_Kind;
93 procedure Bad_Range_Attribute (Loc : Source_Ptr);
94 -- Called to place complaint about bad range attribute at the given
95 -- source location. Terminates by raising Error_Resync.
97 procedure Check_Bad_Exp;
98 -- Called after scanning a**b, posts error if ** detected
100 procedure P_Membership_Test (N : Node_Id);
101 -- N is the node for a N_In or N_Not_In node whose right operand has not
102 -- yet been processed. It is called just after scanning out the IN keyword.
103 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
105 function P_Range_Attribute_Reference (Prefix_Node : Node_Id) return Node_Id;
106 -- Scan a range attribute reference. The caller has scanned out the
107 -- prefix. The current token is known to be an apostrophe and the
108 -- following token is known to be RANGE.
110 function P_Unparen_Cond_Case_Quant_Expression return Node_Id;
111 -- This function is called with Token pointing to IF, CASE, or FOR, in a
112 -- context that allows a case, conditional, or quantified expression if
113 -- it is surrounded by parentheses. If not surrounded by parentheses, the
114 -- expression is still returned, but an error message is issued.
116 -------------------------
117 -- Bad_Range_Attribute --
118 -------------------------
120 procedure Bad_Range_Attribute (Loc : Source_Ptr) is
122 Error_Msg ("range attribute cannot be used in expression!", Loc);
124 end Bad_Range_Attribute;
130 procedure Check_Bad_Exp is
132 if Token = Tok_Double_Asterisk then
133 Error_Msg_SC ("parenthesization required for '*'*");
135 Discard_Junk_Node (P_Primary);
140 --------------------------
141 -- 4.1 Name (also 6.4) --
142 --------------------------
145 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
146 -- | INDEXED_COMPONENT | SLICE
147 -- | SELECTED_COMPONENT | ATTRIBUTE
148 -- | TYPE_CONVERSION | FUNCTION_CALL
149 -- | CHARACTER_LITERAL | TARGET_NAME
151 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
153 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
155 -- EXPLICIT_DEREFERENCE ::= NAME . all
157 -- IMPLICIT_DEREFERENCE ::= NAME
159 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
161 -- SLICE ::= PREFIX (DISCRETE_RANGE)
163 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
165 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
167 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
169 -- ATTRIBUTE_DESIGNATOR ::=
170 -- IDENTIFIER [(static_EXPRESSION)]
171 -- | access | delta | digits
175 -- | function_PREFIX ACTUAL_PARAMETER_PART
177 -- ACTUAL_PARAMETER_PART ::=
178 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
180 -- PARAMETER_ASSOCIATION ::=
181 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
183 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
185 -- TARGET_NAME ::= @ (AI12-0125-3: abbreviation for LHS)
187 -- Note: syntactically a procedure call looks just like a function call,
188 -- so this routine is in practice used to scan out procedure calls as well.
190 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
192 -- Error recovery: can raise Error_Resync
194 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
195 -- followed by either a left paren (qualified expression case), or by
196 -- range (range attribute case). All other uses of apostrophe (i.e. all
197 -- other attributes) are handled in this routine.
199 -- Error recovery: can raise Error_Resync
201 function P_Name return Node_Id is
202 Scan_State : Saved_Scan_State;
204 Prefix_Node : Node_Id;
205 Ident_Node : Node_Id;
207 Range_Node : Node_Id;
210 Arg_List : List_Id := No_List; -- kill junk warning
211 Attr_Name : Name_Id := No_Name; -- kill junk warning
214 -- Case of not a name
216 if Token not in Token_Class_Name then
218 -- If it looks like start of expression, complain and scan expression
220 if Token in Token_Class_Literal
221 or else Token = Tok_Left_Paren
223 Error_Msg_SC ("name expected");
226 -- Otherwise some other junk, not much we can do
229 Error_Msg_AP ("name expected");
234 -- Loop through designators in qualified name
235 -- AI12-0125 : target_name
237 if Token = Tok_At_Sign then
238 Scan_Reserved_Identifier (Force_Msg => False);
240 if Present (Current_Assign_Node) then
241 Set_Has_Target_Names (Current_Assign_Node);
245 Name_Node := Token_Node;
248 Scan; -- past designator
249 exit when Token /= Tok_Dot;
250 Save_Scan_State (Scan_State); -- at dot
253 -- If we do not have another designator after the dot, then join
254 -- the normal circuit to handle a dot extension (may be .all or
255 -- character literal case). Otherwise loop back to scan the next
258 if Token not in Token_Class_Desig then
259 goto Scan_Name_Extension_Dot;
261 Prefix_Node := Name_Node;
262 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
263 Set_Prefix (Name_Node, Prefix_Node);
264 Set_Selector_Name (Name_Node, Token_Node);
268 -- We have now scanned out a qualified designator. If the last token is
269 -- an operator symbol, then we certainly do not have the Snam case, so
270 -- we can just use the normal name extension check circuit
272 if Prev_Token = Tok_Operator_Symbol then
273 goto Scan_Name_Extension;
276 -- We have scanned out a qualified simple name, check for name extension
277 -- Note that we know there is no dot here at this stage, so the only
278 -- possible cases of name extension are apostrophe and left paren.
280 if Token = Tok_Apostrophe then
281 Save_Scan_State (Scan_State); -- at apostrophe
282 Scan; -- past apostrophe
284 -- Qualified expression in Ada 2012 mode (treated as a name)
286 if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
287 goto Scan_Name_Extension_Apostrophe;
289 -- If left paren not in Ada 2012, then it is not part of the name,
290 -- since qualified expressions are not names in prior versions of
291 -- Ada, so return with Token backed up to point to the apostrophe.
292 -- The treatment for the range attribute is similar (we do not
293 -- consider x'range to be a name in this grammar).
295 elsif Token = Tok_Left_Paren or else Token = Tok_Range then
296 Restore_Scan_State (Scan_State); -- to apostrophe
297 Expr_Form := EF_Simple_Name;
300 -- Otherwise we have the case of a name extended by an attribute
303 goto Scan_Name_Extension_Apostrophe;
306 -- Check case of qualified simple name extended by a left parenthesis
308 elsif Token = Tok_Left_Paren then
309 Scan; -- past left paren
310 goto Scan_Name_Extension_Left_Paren;
312 -- Otherwise the qualified simple name is not extended, so return
315 Expr_Form := EF_Simple_Name;
319 -- Loop scanning past name extensions. A label is used for control
320 -- transfer for this loop for ease of interfacing with the finite state
321 -- machine in the parenthesis scanning circuit, and also to allow for
322 -- passing in control to the appropriate point from the above code.
324 <<Scan_Name_Extension>>
326 -- Character literal used as name cannot be extended. Also this
327 -- cannot be a call, since the name for a call must be a designator.
328 -- Return in these cases, or if there is no name extension
330 if Token not in Token_Class_Namext
331 or else Prev_Token = Tok_Char_Literal
333 Expr_Form := EF_Name;
337 -- Merge here when we know there is a name extension
339 <<Scan_Name_Extension_OK>>
341 if Token = Tok_Left_Paren then
342 Scan; -- past left paren
343 goto Scan_Name_Extension_Left_Paren;
345 elsif Token = Tok_Apostrophe then
346 Save_Scan_State (Scan_State); -- at apostrophe
347 Scan; -- past apostrophe
348 goto Scan_Name_Extension_Apostrophe;
350 else -- Token = Tok_Dot
351 Save_Scan_State (Scan_State); -- at dot
353 goto Scan_Name_Extension_Dot;
356 -- Case of name extended by dot (selection), dot is already skipped
357 -- and the scan state at the point of the dot is saved in Scan_State.
359 <<Scan_Name_Extension_Dot>>
361 -- Explicit dereference case
363 if Token = Tok_All then
364 Prefix_Node := Name_Node;
365 Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
366 Set_Prefix (Name_Node, Prefix_Node);
368 goto Scan_Name_Extension;
370 -- Selected component case
372 elsif Token in Token_Class_Name then
373 Prefix_Node := Name_Node;
374 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
375 Set_Prefix (Name_Node, Prefix_Node);
376 Set_Selector_Name (Name_Node, Token_Node);
377 Scan; -- past selector
378 goto Scan_Name_Extension;
380 -- Reserved identifier as selector
382 elsif Is_Reserved_Identifier then
383 Scan_Reserved_Identifier (Force_Msg => False);
384 Prefix_Node := Name_Node;
385 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
386 Set_Prefix (Name_Node, Prefix_Node);
387 Set_Selector_Name (Name_Node, Token_Node);
388 Scan; -- past identifier used as selector
389 goto Scan_Name_Extension;
391 -- If dot is at end of line and followed by nothing legal,
392 -- then assume end of name and quit (dot will be taken as
393 -- an incorrect form of some other punctuation by our caller).
395 elsif Token_Is_At_Start_Of_Line then
396 Restore_Scan_State (Scan_State);
399 -- Here if nothing legal after the dot
402 Error_Msg_AP ("selector expected");
406 -- Here for an apostrophe as name extension. The scan position at the
407 -- apostrophe has already been saved, and the apostrophe scanned out.
409 <<Scan_Name_Extension_Apostrophe>>
411 Scan_Apostrophe : declare
412 function Apostrophe_Should_Be_Semicolon return Boolean;
413 -- Checks for case where apostrophe should probably be
414 -- a semicolon, and if so, gives appropriate message,
415 -- resets the scan pointer to the apostrophe, changes
416 -- the current token to Tok_Semicolon, and returns True.
417 -- Otherwise returns False.
419 ------------------------------------
420 -- Apostrophe_Should_Be_Semicolon --
421 ------------------------------------
423 function Apostrophe_Should_Be_Semicolon return Boolean is
425 if Token_Is_At_Start_Of_Line then
426 Restore_Scan_State (Scan_State); -- to apostrophe
427 Error_Msg_SC ("|""''"" should be "";""");
428 Token := Tok_Semicolon;
433 end Apostrophe_Should_Be_Semicolon;
435 -- Start of processing for Scan_Apostrophe
438 -- Check for qualified expression case in Ada 2012 mode
440 if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
441 Name_Node := P_Qualified_Expression (Name_Node);
442 goto Scan_Name_Extension;
444 -- If range attribute after apostrophe, then return with Token
445 -- pointing to the apostrophe. Note that in this case the prefix
446 -- need not be a simple name (cases like A.all'range). Similarly
447 -- if there is a left paren after the apostrophe, then we also
448 -- return with Token pointing to the apostrophe (this is the
449 -- aggregate case, or some error case).
451 elsif Token = Tok_Range or else Token = Tok_Left_Paren then
452 Restore_Scan_State (Scan_State); -- to apostrophe
453 Expr_Form := EF_Name;
456 -- Here for cases where attribute designator is an identifier
458 elsif Token = Tok_Identifier then
459 Attr_Name := Token_Name;
461 if not Is_Attribute_Name (Attr_Name) then
462 if Apostrophe_Should_Be_Semicolon then
463 Expr_Form := EF_Name;
466 -- Here for a bad attribute name
469 Signal_Bad_Attribute;
470 Scan; -- past bad identifier
472 if Token = Tok_Left_Paren then
473 Scan; -- past left paren
476 Discard_Junk_Node (P_Expression_If_OK);
477 exit when not Comma_Present;
488 Style.Check_Attribute_Name (False);
491 -- Here for case of attribute designator is not an identifier
494 if Token = Tok_Delta then
495 Attr_Name := Name_Delta;
497 elsif Token = Tok_Digits then
498 Attr_Name := Name_Digits;
500 elsif Token = Tok_Access then
501 Attr_Name := Name_Access;
503 elsif Token = Tok_Mod and then Ada_Version >= Ada_95 then
504 Attr_Name := Name_Mod;
506 elsif Apostrophe_Should_Be_Semicolon then
507 Expr_Form := EF_Name;
511 Error_Msg_AP ("attribute designator expected");
516 Style.Check_Attribute_Name (True);
520 -- We come here with an OK attribute scanned, and corresponding
521 -- Attribute identifier node stored in Ident_Node.
523 Prefix_Node := Name_Node;
524 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
525 Scan; -- past attribute designator
526 Set_Prefix (Name_Node, Prefix_Node);
527 Set_Attribute_Name (Name_Node, Attr_Name);
529 -- Scan attribute arguments/designator. We skip this if we know
530 -- that the attribute cannot have an argument (see documentation
531 -- of Is_Parameterless_Attribute for further details).
533 if Token = Tok_Left_Paren
535 Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
537 -- Attribute Update contains an array or record association
538 -- list which provides new values for various components or
539 -- elements. The list is parsed as an aggregate, and we get
540 -- better error handling by knowing that in the parser.
542 if Attr_Name = Name_Update then
543 Set_Expressions (Name_Node, New_List);
544 Append (P_Aggregate, Expressions (Name_Node));
546 -- All other cases of parsing attribute arguments
549 Set_Expressions (Name_Node, New_List);
550 Scan; -- past left paren
554 Expr : constant Node_Id := P_Expression_If_OK;
558 -- Case of => for named notation
560 if Token = Tok_Arrow then
562 -- Named notation allowed only for the special
563 -- case of System'Restriction_Set (No_Dependence =>
564 -- unit_NAME), in which case construct a parameter
565 -- assocation node and append to the arguments.
567 if Attr_Name = Name_Restriction_Set
568 and then Nkind (Expr) = N_Identifier
569 and then Chars (Expr) = Name_No_Dependence
573 Append_To (Expressions (Name_Node),
574 Make_Parameter_Association (Sloc (Rnam),
575 Selector_Name => Expr,
576 Explicit_Actual_Parameter => Rnam));
579 -- For all other cases named notation is illegal
583 ("named parameters not permitted "
585 Scan; -- past junk arrow
588 -- Here for normal case (not => for named parameter)
591 -- Special handling for 'Image in Ada 2012, where
592 -- the attribute can be parameterless and its value
593 -- can be the prefix of a slice. Rewrite name as a
594 -- slice, Expr is its low bound.
596 if Token = Tok_Dot_Dot
597 and then Attr_Name = Name_Image
598 and then Ada_Version >= Ada_2012
600 Set_Expressions (Name_Node, No_List);
601 Prefix_Node := Name_Node;
603 New_Node (N_Slice, Sloc (Prefix_Node));
604 Set_Prefix (Name_Node, Prefix_Node);
605 Range_Node := New_Node (N_Range, Token_Ptr);
606 Set_Low_Bound (Range_Node, Expr);
608 Expr_Node := P_Expression;
609 Check_Simple_Expression (Expr_Node);
610 Set_High_Bound (Range_Node, Expr_Node);
611 Set_Discrete_Range (Name_Node, Range_Node);
614 goto Scan_Name_Extension;
617 Append (Expr, Expressions (Name_Node));
618 exit when not Comma_Present;
628 goto Scan_Name_Extension;
631 -- Here for left parenthesis extending name (left paren skipped)
633 <<Scan_Name_Extension_Left_Paren>>
635 -- We now have to scan through a list of items, terminated by a
636 -- right parenthesis. The scan is handled by a finite state
637 -- machine. The possibilities are:
641 -- This is a slice. This case is handled in LP_State_Init
643 -- (expression, expression, ..)
645 -- This is interpreted as an indexed component, i.e. as a
646 -- case of a name which can be extended in the normal manner.
647 -- This case is handled by LP_State_Name or LP_State_Expr.
649 -- Note: if and case expressions (without an extra level of
650 -- parentheses) are permitted in this context).
652 -- (..., identifier => expression , ...)
654 -- If there is at least one occurrence of identifier => (but
655 -- none of the other cases apply), then we have a call.
657 -- Test for Id => case
659 if Token = Tok_Identifier then
660 Save_Scan_State (Scan_State); -- at Id
663 -- Test for => (allow := as an error substitute)
665 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
666 Restore_Scan_State (Scan_State); -- to Id
667 Arg_List := New_List;
671 Restore_Scan_State (Scan_State); -- to Id
675 -- Here we have an expression after all
677 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
679 -- Check cases of discrete range for a slice
681 -- First possibility: Range_Attribute_Reference
683 if Expr_Form = EF_Range_Attr then
684 Range_Node := Expr_Node;
686 -- Second possibility: Simple_expression .. Simple_expression
688 elsif Token = Tok_Dot_Dot then
689 Check_Simple_Expression (Expr_Node);
690 Range_Node := New_Node (N_Range, Token_Ptr);
691 Set_Low_Bound (Range_Node, Expr_Node);
693 Expr_Node := P_Expression;
694 Check_Simple_Expression (Expr_Node);
695 Set_High_Bound (Range_Node, Expr_Node);
697 -- Third possibility: Type_name range Range
699 elsif Token = Tok_Range then
700 if Expr_Form /= EF_Simple_Name then
701 Error_Msg_SC ("subtype mark must precede RANGE");
705 Range_Node := P_Subtype_Indication (Expr_Node);
707 -- Otherwise we just have an expression. It is true that we might
708 -- have a subtype mark without a range constraint but this case
709 -- is syntactically indistinguishable from the expression case.
712 Arg_List := New_List;
716 -- Fall through here with unmistakable Discrete range scanned,
717 -- which means that we definitely have the case of a slice. The
718 -- Discrete range is in Range_Node.
720 if Token = Tok_Comma then
721 Error_Msg_SC ("slice cannot have more than one dimension");
724 elsif Token /= Tok_Right_Paren then
725 if Token = Tok_Arrow then
727 -- This may be an aggregate that is missing a qualification
730 ("context of aggregate must be a qualified expression");
739 Scan; -- past right paren
740 Prefix_Node := Name_Node;
741 Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
742 Set_Prefix (Name_Node, Prefix_Node);
743 Set_Discrete_Range (Name_Node, Range_Node);
745 -- An operator node is legal as a prefix to other names,
746 -- but not for a slice.
748 if Nkind (Prefix_Node) = N_Operator_Symbol then
749 Error_Msg_N ("illegal prefix for slice", Prefix_Node);
752 -- If we have a name extension, go scan it
754 if Token in Token_Class_Namext then
755 goto Scan_Name_Extension_OK;
757 -- Otherwise return (a slice is a name, but is not a call)
760 Expr_Form := EF_Name;
765 -- In LP_State_Expr, we have scanned one or more expressions, and
766 -- so we have a call or an indexed component which is a name. On
767 -- entry we have the expression just scanned in Expr_Node and
768 -- Arg_List contains the list of expressions encountered so far
771 Append (Expr_Node, Arg_List);
773 if Token = Tok_Arrow then
775 ("expect identifier in parameter association", Sloc (Expr_Node));
778 elsif not Comma_Present then
781 Prefix_Node := Name_Node;
782 Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
783 Set_Prefix (Name_Node, Prefix_Node);
784 Set_Expressions (Name_Node, Arg_List);
786 goto Scan_Name_Extension;
789 -- Comma present (and scanned out), test for identifier => case
790 -- Test for identifier => case
792 if Token = Tok_Identifier then
793 Save_Scan_State (Scan_State); -- at Id
796 -- Test for => (allow := as error substitute)
798 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
799 Restore_Scan_State (Scan_State); -- to Id
802 -- Otherwise it's just an expression after all, so backup
805 Restore_Scan_State (Scan_State); -- to Id
809 -- Here we have an expression after all, so stay in this state
811 Expr_Node := P_Expression_If_OK;
814 -- LP_State_Call corresponds to the situation in which at least one
815 -- instance of Id => Expression has been encountered, so we know that
816 -- we do not have a name, but rather a call. We enter it with the
817 -- scan pointer pointing to the next argument to scan, and Arg_List
818 -- containing the list of arguments scanned so far.
822 -- Test for case of Id => Expression (named parameter)
824 if Token = Tok_Identifier then
825 Save_Scan_State (Scan_State); -- at Id
826 Ident_Node := Token_Node;
829 -- Deal with => (allow := as incorrect substitute)
831 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
832 Arg_Node := New_Node (N_Parameter_Association, Prev_Token_Ptr);
833 Set_Selector_Name (Arg_Node, Ident_Node);
835 Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
836 Append (Arg_Node, Arg_List);
838 -- If a comma follows, go back and scan next entry
840 if Comma_Present then
843 -- Otherwise we have the end of a call
846 Prefix_Node := Name_Node;
847 Name_Node := New_Node (N_Function_Call, Sloc (Prefix_Node));
848 Set_Name (Name_Node, Prefix_Node);
849 Set_Parameter_Associations (Name_Node, Arg_List);
852 if Token in Token_Class_Namext then
853 goto Scan_Name_Extension_OK;
855 -- This is a case of a call which cannot be a name
858 Expr_Form := EF_Name;
863 -- Not named parameter: Id started an expression after all
866 Restore_Scan_State (Scan_State); -- to Id
870 -- Here if entry did not start with Id => which means that it
871 -- is a positional parameter, which is not allowed, since we
872 -- have seen at least one named parameter already.
875 ("positional parameter association " &
876 "not allowed after named one");
878 Expr_Node := P_Expression_If_OK;
880 -- Leaving the '>' in an association is not unusual, so suggest
883 if Nkind (Expr_Node) = N_Op_Eq then
884 Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
887 -- We go back to scanning out expressions, so that we do not get
888 -- multiple error messages when several positional parameters
889 -- follow a named parameter.
893 -- End of treatment for name extensions starting with left paren
895 -- End of loop through name extensions
899 -- This function parses a restricted form of Names which are either
900 -- designators, or designators preceded by a sequence of prefixes
901 -- that are direct names.
903 -- Error recovery: cannot raise Error_Resync
905 function P_Function_Name return Node_Id is
906 Designator_Node : Node_Id;
907 Prefix_Node : Node_Id;
908 Selector_Node : Node_Id;
909 Dot_Sloc : Source_Ptr := No_Location;
912 -- Prefix_Node is set to the gathered prefix so far, Empty means that
913 -- no prefix has been scanned. This allows us to build up the result
914 -- in the required right recursive manner.
916 Prefix_Node := Empty;
918 -- Loop through prefixes
921 Designator_Node := Token_Node;
923 if Token not in Token_Class_Desig then
924 return P_Identifier; -- let P_Identifier issue the error message
926 else -- Token in Token_Class_Desig
927 Scan; -- past designator
928 exit when Token /= Tok_Dot;
931 -- Here at a dot, with token just before it in Designator_Node
933 if No (Prefix_Node) then
934 Prefix_Node := Designator_Node;
936 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
937 Set_Prefix (Selector_Node, Prefix_Node);
938 Set_Selector_Name (Selector_Node, Designator_Node);
939 Prefix_Node := Selector_Node;
942 Dot_Sloc := Token_Ptr;
946 -- Fall out of the loop having just scanned a designator
948 if No (Prefix_Node) then
949 return Designator_Node;
951 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
952 Set_Prefix (Selector_Node, Prefix_Node);
953 Set_Selector_Name (Selector_Node, Designator_Node);
954 return Selector_Node;
962 -- This function parses a restricted form of Names which are either
963 -- identifiers, or identifiers preceded by a sequence of prefixes
964 -- that are direct names.
966 -- Error recovery: cannot raise Error_Resync
968 function P_Qualified_Simple_Name return Node_Id is
969 Designator_Node : Node_Id;
970 Prefix_Node : Node_Id;
971 Selector_Node : Node_Id;
972 Dot_Sloc : Source_Ptr := No_Location;
975 -- Prefix node is set to the gathered prefix so far, Empty means that
976 -- no prefix has been scanned. This allows us to build up the result
977 -- in the required right recursive manner.
979 Prefix_Node := Empty;
981 -- Loop through prefixes
984 Designator_Node := Token_Node;
986 if Token = Tok_Identifier then
987 Scan; -- past identifier
988 exit when Token /= Tok_Dot;
990 elsif Token not in Token_Class_Desig then
991 return P_Identifier; -- let P_Identifier issue the error message
994 Scan; -- past designator
996 if Token /= Tok_Dot then
997 Error_Msg_SP ("identifier expected");
1002 -- Here at a dot, with token just before it in Designator_Node
1004 if No (Prefix_Node) then
1005 Prefix_Node := Designator_Node;
1007 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
1008 Set_Prefix (Selector_Node, Prefix_Node);
1009 Set_Selector_Name (Selector_Node, Designator_Node);
1010 Prefix_Node := Selector_Node;
1013 Dot_Sloc := Token_Ptr;
1017 -- Fall out of the loop having just scanned an identifier
1019 if No (Prefix_Node) then
1020 return Designator_Node;
1022 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
1023 Set_Prefix (Selector_Node, Prefix_Node);
1024 Set_Selector_Name (Selector_Node, Designator_Node);
1025 return Selector_Node;
1029 when Error_Resync =>
1031 end P_Qualified_Simple_Name;
1033 -- This procedure differs from P_Qualified_Simple_Name only in that it
1034 -- raises Error_Resync if any error is encountered. It only returns after
1035 -- scanning a valid qualified simple name.
1037 -- Error recovery: can raise Error_Resync
1039 function P_Qualified_Simple_Name_Resync return Node_Id is
1040 Designator_Node : Node_Id;
1041 Prefix_Node : Node_Id;
1042 Selector_Node : Node_Id;
1043 Dot_Sloc : Source_Ptr := No_Location;
1046 Prefix_Node := Empty;
1048 -- Loop through prefixes
1051 Designator_Node := Token_Node;
1053 if Token = Tok_Identifier then
1054 Scan; -- past identifier
1055 exit when Token /= Tok_Dot;
1057 elsif Token not in Token_Class_Desig then
1058 Discard_Junk_Node (P_Identifier); -- to issue the error message
1062 Scan; -- past designator
1064 if Token /= Tok_Dot then
1065 Error_Msg_SP ("identifier expected");
1070 -- Here at a dot, with token just before it in Designator_Node
1072 if No (Prefix_Node) then
1073 Prefix_Node := Designator_Node;
1075 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
1076 Set_Prefix (Selector_Node, Prefix_Node);
1077 Set_Selector_Name (Selector_Node, Designator_Node);
1078 Prefix_Node := Selector_Node;
1081 Dot_Sloc := Token_Ptr;
1082 Scan; -- past period
1085 -- Fall out of the loop having just scanned an identifier
1087 if No (Prefix_Node) then
1088 return Designator_Node;
1090 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
1091 Set_Prefix (Selector_Node, Prefix_Node);
1092 Set_Selector_Name (Selector_Node, Designator_Node);
1093 return Selector_Node;
1095 end P_Qualified_Simple_Name_Resync;
1097 ----------------------
1098 -- 4.1 Direct_Name --
1099 ----------------------
1101 -- Parsed by P_Name and other functions in section 4.1
1107 -- Parsed by P_Name (4.1)
1109 -------------------------------
1110 -- 4.1 Explicit Dereference --
1111 -------------------------------
1113 -- Parsed by P_Name (4.1)
1115 -------------------------------
1116 -- 4.1 Implicit_Dereference --
1117 -------------------------------
1119 -- Parsed by P_Name (4.1)
1121 ----------------------------
1122 -- 4.1 Indexed Component --
1123 ----------------------------
1125 -- Parsed by P_Name (4.1)
1131 -- Parsed by P_Name (4.1)
1133 -----------------------------
1134 -- 4.1 Selected_Component --
1135 -----------------------------
1137 -- Parsed by P_Name (4.1)
1139 ------------------------
1140 -- 4.1 Selector Name --
1141 ------------------------
1143 -- Parsed by P_Name (4.1)
1145 ------------------------------
1146 -- 4.1 Attribute Reference --
1147 ------------------------------
1149 -- Parsed by P_Name (4.1)
1151 -------------------------------
1152 -- 4.1 Attribute Designator --
1153 -------------------------------
1155 -- Parsed by P_Name (4.1)
1157 --------------------------------------
1158 -- 4.1.4 Range Attribute Reference --
1159 --------------------------------------
1161 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1163 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1165 -- In the grammar, a RANGE attribute is simply a name, but its use is
1166 -- highly restricted, so in the parser, we do not regard it as a name.
1167 -- Instead, P_Name returns without scanning the 'RANGE part of the
1168 -- attribute, and the caller uses the following function to construct
1169 -- a range attribute in places where it is appropriate.
1171 -- Note that RANGE here is treated essentially as an identifier,
1172 -- rather than a reserved word.
1174 -- The caller has parsed the prefix, i.e. a name, and Token points to
1175 -- the apostrophe. The token after the apostrophe is known to be RANGE
1176 -- at this point. The prefix node becomes the prefix of the attribute.
1178 -- Error_Recovery: Cannot raise Error_Resync
1180 function P_Range_Attribute_Reference
1181 (Prefix_Node : Node_Id)
1184 Attr_Node : Node_Id;
1187 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1188 Set_Prefix (Attr_Node, Prefix_Node);
1189 Scan; -- past apostrophe
1192 Style.Check_Attribute_Name (True);
1195 Set_Attribute_Name (Attr_Node, Name_Range);
1198 if Token = Tok_Left_Paren then
1199 Scan; -- past left paren
1200 Set_Expressions (Attr_Node, New_List (P_Expression_If_OK));
1205 end P_Range_Attribute_Reference;
1207 -------------------------------------
1208 -- P_Reduction_Attribute_Reference --
1209 -------------------------------------
1211 function P_Reduction_Attribute_Reference (S : Node_Id)
1214 Attr_Node : Node_Id;
1215 Attr_Name : Name_Id;
1218 Attr_Name := Token_Name;
1219 Scan; -- past Reduce
1220 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1221 Set_Attribute_Name (Attr_Node, Attr_Name);
1222 if Attr_Name /= Name_Reduce then
1223 Error_Msg ("reduce attribute expected", Prev_Token_Ptr);
1226 Set_Prefix (Attr_Node, S);
1227 Set_Expressions (Attr_Node, New_List);
1229 Append (P_Name, Expressions (Attr_Node));
1231 Append (P_Expression, Expressions (Attr_Node));
1235 end P_Reduction_Attribute_Reference;
1237 ---------------------------------------
1238 -- 4.1.4 Range Attribute Designator --
1239 ---------------------------------------
1241 -- Parsed by P_Range_Attribute_Reference (4.4)
1243 ---------------------------------------------
1244 -- 4.1.4 (2) Reduction_Attribute_Reference --
1245 ---------------------------------------------
1247 -- parsed by P_Reduction_Attribute_Reference
1249 --------------------
1251 --------------------
1253 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1255 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1256 -- an aggregate is known to be required (code statement, extension
1257 -- aggregate), in which cases this routine performs the necessary check
1258 -- that we have an aggregate rather than a parenthesized expression
1260 -- Error recovery: can raise Error_Resync
1262 function P_Aggregate return Node_Id is
1263 Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1264 Aggr_Node : constant Node_Id := P_Aggregate_Or_Paren_Expr;
1267 if Nkind (Aggr_Node) /= N_Aggregate
1269 Nkind (Aggr_Node) /= N_Extension_Aggregate
1270 and then Ada_Version < Ada_2020
1273 ("aggregate may not have single positional component", Aggr_Sloc);
1280 ------------------------------------------------
1281 -- 4.3 Aggregate or Parenthesized Expression --
1282 ------------------------------------------------
1284 -- This procedure parses out either an aggregate or a parenthesized
1285 -- expression (these two constructs are closely related, since a
1286 -- parenthesized expression looks like an aggregate with a single
1287 -- positional component).
1290 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1292 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1294 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1295 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1298 -- RECORD_COMPONENT_ASSOCIATION ::=
1299 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1301 -- COMPONENT_CHOICE_LIST ::=
1302 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1305 -- EXTENSION_AGGREGATE ::=
1306 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1308 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1310 -- ARRAY_AGGREGATE ::=
1311 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1313 -- POSITIONAL_ARRAY_AGGREGATE ::=
1314 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1315 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1316 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1318 -- NAMED_ARRAY_AGGREGATE ::=
1319 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1321 -- PRIMARY ::= (EXPRESSION);
1323 -- Error recovery: can raise Error_Resync
1325 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1326 -- to Ada 2005 limited aggregates (AI-287)
1328 function P_Aggregate_Or_Paren_Expr return Node_Id is
1329 Aggregate_Node : Node_Id;
1330 Expr_List : List_Id;
1331 Assoc_List : List_Id;
1332 Expr_Node : Node_Id;
1333 Lparen_Sloc : Source_Ptr;
1334 Scan_State : Saved_Scan_State;
1336 procedure Box_Error;
1337 -- Called if <> is encountered as positional aggregate element. Issues
1338 -- error message and sets Expr_Node to Error.
1340 function Is_Quantified_Expression return Boolean;
1341 -- The presence of iterated component associations requires a one
1342 -- token lookahead to distinguish it from quantified expressions.
1348 procedure Box_Error is
1350 if Ada_Version < Ada_2005 then
1351 Error_Msg_SC ("box in aggregate is an Ada 2005 extension");
1354 -- Ada 2005 (AI-287): The box notation is allowed only with named
1355 -- notation because positional notation might be error prone. For
1356 -- example, in "(X, <>, Y, <>)", there is no type associated with
1357 -- the boxes, so you might not be leaving out the components you
1358 -- thought you were leaving out.
1360 Error_Msg_SC ("(Ada 2005) box only allowed with named notation");
1365 ------------------------------
1366 -- Is_Quantified_Expression --
1367 ------------------------------
1369 function Is_Quantified_Expression return Boolean is
1371 Scan_State : Saved_Scan_State;
1374 Save_Scan_State (Scan_State);
1376 Maybe := Token = Tok_All or else Token = Tok_Some;
1377 Restore_Scan_State (Scan_State); -- to FOR
1379 end Is_Quantified_Expression;
1381 -- Start of processing for P_Aggregate_Or_Paren_Expr
1384 Lparen_Sloc := Token_Ptr;
1385 if Token = Tok_Left_Bracket and then Ada_Version >= Ada_2020 then
1388 -- Special case for null aggregate in Ada 2020
1390 if Token = Tok_Right_Bracket then
1392 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1393 Set_Expressions (Aggregate_Node, New_List);
1394 Set_Is_Homogeneous_Aggregate (Aggregate_Node);
1395 return Aggregate_Node;
1401 -- Note on parentheses count. For cases like an if expression, the
1402 -- parens here really count as real parentheses for the paren count,
1403 -- so we adjust the paren count accordingly after scanning the expr.
1407 if Token = Tok_If then
1408 Expr_Node := P_If_Expression;
1410 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1415 elsif Token = Tok_Case then
1416 Expr_Node := P_Case_Expression;
1418 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1421 -- Quantified expression
1423 elsif Token = Tok_For and then Is_Quantified_Expression then
1424 Expr_Node := P_Quantified_Expression;
1426 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1429 -- Note: the mechanism used here of rescanning the initial expression
1430 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1431 -- out the discrete choice list.
1433 -- Deal with expression and extension aggregates first
1435 elsif Token /= Tok_Others then
1436 Save_Scan_State (Scan_State); -- at start of expression
1438 -- Deal with (NULL RECORD)
1440 if Token = Tok_Null then
1443 if Token = Tok_Record then
1444 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1445 Set_Null_Record_Present (Aggregate_Node, True);
1446 Scan; -- past RECORD
1448 return Aggregate_Node;
1450 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1453 elsif Token = Tok_For then
1454 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1455 Expr_Node := P_Iterated_Component_Association;
1459 -- Scan expression, handling box appearing as positional argument
1461 if Token = Tok_Box then
1464 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1467 -- Extension or Delta aggregate
1469 if Token = Tok_With then
1470 if Nkind (Expr_Node) = N_Attribute_Reference
1471 and then Attribute_Name (Expr_Node) = Name_Range
1473 Bad_Range_Attribute (Sloc (Expr_Node));
1477 if Ada_Version = Ada_83 then
1478 Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1482 if Token = Tok_Delta then
1484 Aggregate_Node := New_Node (N_Delta_Aggregate, Lparen_Sloc);
1485 Set_Expression (Aggregate_Node, Expr_Node);
1491 Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1492 Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1495 -- Deal with WITH NULL RECORD case
1497 if Token = Tok_Null then
1498 Save_Scan_State (Scan_State); -- at NULL
1501 if Token = Tok_Record then
1502 Scan; -- past RECORD
1503 Set_Null_Record_Present (Aggregate_Node, True);
1505 return Aggregate_Node;
1508 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1512 if Token /= Tok_Others then
1513 Save_Scan_State (Scan_State);
1514 Expr_Node := P_Expression;
1521 elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1522 if Nkind (Expr_Node) = N_Attribute_Reference
1523 and then Attribute_Name (Expr_Node) = Name_Range
1526 ("|parentheses not allowed for range attribute", Lparen_Sloc);
1527 Scan; -- past right paren
1531 -- Bump paren count of expression
1533 if Expr_Node /= Error then
1534 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1537 T_Right_Paren; -- past right paren (error message if none)
1543 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1549 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1553 -- Prepare to scan list of component associations
1555 Expr_List := No_List; -- don't set yet, maybe all named entries
1556 Assoc_List := No_List; -- don't set yet, maybe all positional entries
1558 -- This loop scans through component associations. On entry to the
1559 -- loop, an expression has been scanned at the start of the current
1560 -- association unless initial token was OTHERS, in which case
1561 -- Expr_Node is set to Empty.
1564 -- Deal with others association first. This is a named association
1566 if No (Expr_Node) then
1567 if No (Assoc_List) then
1568 Assoc_List := New_List;
1571 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1573 -- Improper use of WITH
1575 elsif Token = Tok_With then
1576 Error_Msg_SC ("WITH must be preceded by single expression in " &
1577 "extension aggregate");
1580 -- Range attribute can only appear as part of a discrete choice list
1582 elsif Nkind (Expr_Node) = N_Attribute_Reference
1583 and then Attribute_Name (Expr_Node) = Name_Range
1584 and then Token /= Tok_Arrow
1585 and then Token /= Tok_Vertical_Bar
1587 Bad_Range_Attribute (Sloc (Expr_Node));
1590 -- Assume positional case if comma, right paren, or literal or
1591 -- identifier or OTHERS follows (the latter cases are missing
1592 -- comma cases). Also assume positional if a semicolon follows,
1593 -- which can happen if there are missing parens.
1595 elsif Nkind (Expr_Node) = N_Iterated_Component_Association then
1596 if No (Assoc_List) then
1597 Assoc_List := New_List (Expr_Node);
1599 Append_To (Assoc_List, Expr_Node);
1602 elsif Token = Tok_Comma
1603 or else Token = Tok_Right_Paren
1604 or else Token = Tok_Others
1605 or else Token in Token_Class_Lit_Or_Name
1606 or else Token = Tok_Semicolon
1608 if Present (Assoc_List) then
1609 Error_Msg_BC -- CODEFIX
1610 ("""='>"" expected (positional association cannot follow "
1611 & "named association)");
1614 if No (Expr_List) then
1615 Expr_List := New_List;
1618 Append (Expr_Node, Expr_List);
1620 -- Check for aggregate followed by left parent, maybe missing comma
1622 elsif Nkind (Expr_Node) = N_Aggregate
1623 and then Token = Tok_Left_Paren
1627 if No (Expr_List) then
1628 Expr_List := New_List;
1631 Append (Expr_Node, Expr_List);
1633 elsif Token = Tok_Right_Bracket then
1634 if No (Expr_List) then
1635 Expr_List := New_List;
1638 Append (Expr_Node, Expr_List);
1641 -- Anything else is assumed to be a named association
1644 Restore_Scan_State (Scan_State); -- to start of expression
1646 if No (Assoc_List) then
1647 Assoc_List := New_List;
1650 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1653 exit when not Comma_Present;
1655 -- If we are at an expression terminator, something is seriously
1656 -- wrong, so let's get out now, before we start eating up stuff
1657 -- that doesn't belong to us.
1659 if Token in Token_Class_Eterm and then Token /= Tok_For then
1661 ("expecting expression or component association");
1665 -- Deal with misused box
1667 if Token = Tok_Box then
1670 -- Otherwise initiate for reentry to top of loop by scanning an
1671 -- initial expression, unless the first token is OTHERS or FOR,
1672 -- which indicates an iterated component association.
1674 elsif Token = Tok_Others then
1677 elsif Token = Tok_For then
1678 Expr_Node := P_Iterated_Component_Association;
1681 Save_Scan_State (Scan_State); -- at start of expression
1682 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1687 -- All component associations (positional and named) have been scanned
1689 if Token = Tok_Right_Bracket and then Ada_Version >= Ada_2020 then
1690 Set_Component_Associations (Aggregate_Node, Assoc_List);
1691 Set_Is_Homogeneous_Aggregate (Aggregate_Node);
1692 Scan; -- past right bracket
1694 if Token = Tok_Apostrophe then
1697 if Token = Tok_Identifier then
1698 return P_Reduction_Attribute_Reference (Aggregate_Node);
1705 if Nkind (Aggregate_Node) /= N_Delta_Aggregate then
1706 Set_Expressions (Aggregate_Node, Expr_List);
1709 Set_Component_Associations (Aggregate_Node, Assoc_List);
1710 return Aggregate_Node;
1711 end P_Aggregate_Or_Paren_Expr;
1713 ------------------------------------------------
1714 -- 4.3 Record or Array Component Association --
1715 ------------------------------------------------
1717 -- RECORD_COMPONENT_ASSOCIATION ::=
1718 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1719 -- | COMPONENT_CHOICE_LIST => <>
1721 -- COMPONENT_CHOICE_LIST =>
1722 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1725 -- ARRAY_COMPONENT_ASSOCIATION ::=
1726 -- DISCRETE_CHOICE_LIST => EXPRESSION
1727 -- | DISCRETE_CHOICE_LIST => <>
1728 -- | ITERATED_COMPONENT_ASSOCIATION
1730 -- Note: this routine only handles the named cases, including others.
1731 -- Cases where the component choice list is not present have already
1732 -- been handled directly.
1734 -- Error recovery: can raise Error_Resync
1736 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1737 -- rules have been extended to give support to Ada 2005 limited
1738 -- aggregates (AI-287)
1740 function P_Record_Or_Array_Component_Association return Node_Id is
1741 Assoc_Node : Node_Id;
1744 -- A loop indicates an iterated_component_association
1746 if Token = Tok_For then
1747 return P_Iterated_Component_Association;
1750 Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1751 Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1752 Set_Sloc (Assoc_Node, Token_Ptr);
1755 if Token = Tok_Box then
1757 -- Ada 2005(AI-287): The box notation is used to indicate the
1758 -- default initialization of aggregate components
1760 if Ada_Version < Ada_2005 then
1762 ("component association with '<'> is an Ada 2005 extension");
1763 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1766 Set_Box_Present (Assoc_Node);
1769 Set_Expression (Assoc_Node, P_Expression);
1773 end P_Record_Or_Array_Component_Association;
1775 -----------------------------
1776 -- 4.3.1 Record Aggregate --
1777 -----------------------------
1779 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1780 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1782 ----------------------------------------------
1783 -- 4.3.1 Record Component Association List --
1784 ----------------------------------------------
1786 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1788 ----------------------------------
1789 -- 4.3.1 Component Choice List --
1790 ----------------------------------
1792 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1794 --------------------------------
1795 -- 4.3.1 Extension Aggregate --
1796 --------------------------------
1798 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1800 --------------------------
1801 -- 4.3.1 Ancestor Part --
1802 --------------------------
1804 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1806 ----------------------------
1807 -- 4.3.1 Array Aggregate --
1808 ----------------------------
1810 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1812 ---------------------------------------
1813 -- 4.3.1 Positional Array Aggregate --
1814 ---------------------------------------
1816 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1818 ----------------------------------
1819 -- 4.3.1 Named Array Aggregate --
1820 ----------------------------------
1822 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1824 ----------------------------------------
1825 -- 4.3.1 Array Component Association --
1826 ----------------------------------------
1828 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1830 ---------------------
1831 -- 4.4 Expression --
1832 ---------------------
1834 -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
1837 -- RELATION {LOGICAL_OPERATOR RELATION}
1839 -- CHOICE_EXPRESSION ::=
1840 -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1842 -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1844 -- On return, Expr_Form indicates the categorization of the expression
1845 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1846 -- an error message is given, and Error is returned).
1848 -- Error recovery: cannot raise Error_Resync
1850 function P_Expression return Node_Id is
1851 Logical_Op : Node_Kind;
1852 Prev_Logical_Op : Node_Kind;
1853 Op_Location : Source_Ptr;
1858 Node1 := P_Relation;
1860 if Token in Token_Class_Logop then
1861 Prev_Logical_Op := N_Empty;
1864 Op_Location := Token_Ptr;
1865 Logical_Op := P_Logical_Operator;
1867 if Prev_Logical_Op /= N_Empty and then
1868 Logical_Op /= Prev_Logical_Op
1871 ("mixed logical operators in expression", Op_Location);
1872 Prev_Logical_Op := N_Empty;
1874 Prev_Logical_Op := Logical_Op;
1878 Node1 := New_Op_Node (Logical_Op, Op_Location);
1879 Set_Left_Opnd (Node1, Node2);
1880 Set_Right_Opnd (Node1, P_Relation);
1882 -- Check for case of errant comma or semicolon
1884 if Token = Tok_Comma or else Token = Tok_Semicolon then
1886 Com : constant Boolean := Token = Tok_Comma;
1887 Scan_State : Saved_Scan_State;
1891 Save_Scan_State (Scan_State); -- at comma/semicolon
1892 Scan; -- past comma/semicolon
1894 -- Check for AND THEN or OR ELSE after comma/semicolon. We
1895 -- do not deal with AND/OR because those cases get mixed up
1896 -- with the select alternatives case.
1898 if Token = Tok_And or else Token = Tok_Or then
1899 Logop := P_Logical_Operator;
1900 Restore_Scan_State (Scan_State); -- to comma/semicolon
1902 if Nkind_In (Logop, N_And_Then, N_Or_Else) then
1903 Scan; -- past comma/semicolon
1906 Error_Msg_SP -- CODEFIX
1907 ("|extra "","" ignored");
1909 Error_Msg_SP -- CODEFIX
1910 ("|extra "";"" ignored");
1914 Restore_Scan_State (Scan_State); -- to comma/semicolon
1918 Restore_Scan_State (Scan_State); -- to comma/semicolon
1923 exit when Token not in Token_Class_Logop;
1926 Expr_Form := EF_Non_Simple;
1929 if Token = Tok_Apostrophe then
1930 Bad_Range_Attribute (Token_Ptr);
1937 -- This function is identical to the normal P_Expression, except that it
1938 -- also permits the appearance of a case, conditional, or quantified
1939 -- expression if the call immediately follows a left paren, and followed
1940 -- by a right parenthesis. These forms are allowed if these conditions
1941 -- are not met, but an error message will be issued.
1943 function P_Expression_If_OK return Node_Id is
1945 -- Case of conditional, case or quantified expression
1947 if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
1948 return P_Unparen_Cond_Case_Quant_Expression;
1950 -- Normal case, not case/conditional/quantified expression
1953 return P_Expression;
1955 end P_Expression_If_OK;
1957 -- This function is identical to the normal P_Expression, except that it
1958 -- checks that the expression scan did not stop on a right paren. It is
1959 -- called in all contexts where a right parenthesis cannot legitimately
1960 -- follow an expression.
1962 -- Error recovery: cannot raise Error_Resync
1964 function P_Expression_No_Right_Paren return Node_Id is
1965 Expr : constant Node_Id := P_Expression;
1967 Ignore (Tok_Right_Paren);
1969 end P_Expression_No_Right_Paren;
1971 ----------------------------------------
1972 -- 4.4 Expression_Or_Range_Attribute --
1973 ----------------------------------------
1976 -- RELATION {and RELATION} | RELATION {and then RELATION}
1977 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1978 -- | RELATION {xor RELATION}
1980 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1982 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1984 -- On return, Expr_Form indicates the categorization of the expression
1985 -- and EF_Range_Attr is one of the possibilities.
1987 -- Error recovery: cannot raise Error_Resync
1989 -- In the grammar, a RANGE attribute is simply a name, but its use is
1990 -- highly restricted, so in the parser, we do not regard it as a name.
1991 -- Instead, P_Name returns without scanning the 'RANGE part of the
1992 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1993 -- attribute reference. In the normal case where a range attribute is
1994 -- not allowed, an error message is issued by P_Expression.
1996 function P_Expression_Or_Range_Attribute return Node_Id is
1997 Logical_Op : Node_Kind;
1998 Prev_Logical_Op : Node_Kind;
1999 Op_Location : Source_Ptr;
2002 Attr_Node : Node_Id;
2005 Node1 := P_Relation;
2007 if Token = Tok_Apostrophe then
2008 Attr_Node := P_Range_Attribute_Reference (Node1);
2009 Expr_Form := EF_Range_Attr;
2012 elsif Token in Token_Class_Logop then
2013 Prev_Logical_Op := N_Empty;
2016 Op_Location := Token_Ptr;
2017 Logical_Op := P_Logical_Operator;
2019 if Prev_Logical_Op /= N_Empty and then
2020 Logical_Op /= Prev_Logical_Op
2023 ("mixed logical operators in expression", Op_Location);
2024 Prev_Logical_Op := N_Empty;
2026 Prev_Logical_Op := Logical_Op;
2030 Node1 := New_Op_Node (Logical_Op, Op_Location);
2031 Set_Left_Opnd (Node1, Node2);
2032 Set_Right_Opnd (Node1, P_Relation);
2033 exit when Token not in Token_Class_Logop;
2036 Expr_Form := EF_Non_Simple;
2039 if Token = Tok_Apostrophe then
2040 Bad_Range_Attribute (Token_Ptr);
2045 end P_Expression_Or_Range_Attribute;
2047 -- Version that allows a non-parenthesized case, conditional, or quantified
2048 -- expression if the call immediately follows a left paren, and followed
2049 -- by a right parenthesis. These forms are allowed if these conditions
2050 -- are not met, but an error message will be issued.
2052 function P_Expression_Or_Range_Attribute_If_OK return Node_Id is
2054 -- Case of conditional, case or quantified expression
2056 if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
2057 return P_Unparen_Cond_Case_Quant_Expression;
2059 -- Normal case, not one of the above expression types
2062 return P_Expression_Or_Range_Attribute;
2064 end P_Expression_Or_Range_Attribute_If_OK;
2070 -- This procedure scans both relations and choice relations
2072 -- CHOICE_RELATION ::=
2073 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
2076 -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
2077 -- | RAISE_EXPRESSION
2079 -- MEMBERSHIP_CHOICE_LIST ::=
2080 -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
2082 -- MEMBERSHIP_CHOICE ::=
2083 -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
2085 -- RAISE_EXPRESSION ::= raise exception_NAME [with string_EXPRESSION]
2087 -- On return, Expr_Form indicates the categorization of the expression
2089 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
2090 -- EF_Simple_Name and the following token is RANGE (range attribute case).
2092 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2093 -- expression, then tokens are scanned until either a non-expression token,
2094 -- a right paren (not matched by a left paren) or a comma, is encountered.
2096 function P_Relation return Node_Id is
2097 Node1, Node2 : Node_Id;
2101 -- First check for raise expression
2103 if Token = Tok_Raise then
2104 Expr_Form := EF_Non_Simple;
2105 return P_Raise_Expression;
2110 Node1 := P_Simple_Expression;
2112 if Token not in Token_Class_Relop then
2116 -- Here we have a relational operator following. If so then scan it
2117 -- out. Note that the assignment symbol := is treated as a relational
2118 -- operator to improve the error recovery when it is misused for =.
2119 -- P_Relational_Operator also parses the IN and NOT IN operations.
2122 Node2 := New_Op_Node (P_Relational_Operator, Optok);
2123 Set_Left_Opnd (Node2, Node1);
2125 -- Case of IN or NOT IN
2127 if Prev_Token = Tok_In then
2128 P_Membership_Test (Node2);
2130 -- Case of relational operator (= /= < <= > >=)
2133 Set_Right_Opnd (Node2, P_Simple_Expression);
2136 Expr_Form := EF_Non_Simple;
2138 if Token in Token_Class_Relop then
2139 Error_Msg_SC ("unexpected relational operator");
2146 -- If any error occurs, then scan to the next expression terminator symbol
2147 -- or comma or right paren at the outer (i.e. current) parentheses level.
2148 -- The flags are set to indicate a normal simple expression.
2151 when Error_Resync =>
2153 Expr_Form := EF_Simple;
2157 ----------------------------
2158 -- 4.4 Simple Expression --
2159 ----------------------------
2161 -- SIMPLE_EXPRESSION ::=
2162 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2164 -- On return, Expr_Form indicates the categorization of the expression
2166 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
2167 -- EF_Simple_Name and the following token is RANGE (range attribute case).
2169 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2170 -- expression, then tokens are scanned until either a non-expression token,
2171 -- a right paren (not matched by a left paren) or a comma, is encountered.
2173 -- Note: P_Simple_Expression is called only internally by higher level
2174 -- expression routines. In cases in the grammar where a simple expression
2175 -- is required, the approach is to scan an expression, and then post an
2176 -- appropriate error message if the expression obtained is not simple. This
2177 -- gives better error recovery and treatment.
2179 function P_Simple_Expression return Node_Id is
2180 Scan_State : Saved_Scan_State;
2183 Tokptr : Source_Ptr;
2185 function At_Start_Of_Attribute return Boolean;
2186 -- Tests if we have quote followed by attribute name, if so, return True
2187 -- otherwise return False.
2189 ---------------------------
2190 -- At_Start_Of_Attribute --
2191 ---------------------------
2193 function At_Start_Of_Attribute return Boolean is
2195 if Token /= Tok_Apostrophe then
2200 Scan_State : Saved_Scan_State;
2203 Save_Scan_State (Scan_State);
2206 if Token = Tok_Identifier
2207 and then Is_Attribute_Name (Chars (Token_Node))
2209 Restore_Scan_State (Scan_State);
2212 Restore_Scan_State (Scan_State);
2217 end At_Start_Of_Attribute;
2219 -- Start of processing for P_Simple_Expression
2222 -- Check for cases starting with a name. There are two reasons for
2223 -- special casing. First speed things up by catching a common case
2224 -- without going through several routine layers. Second the caller must
2225 -- be informed via Expr_Form when the simple expression is a name.
2227 if Token in Token_Class_Name then
2230 -- Deal with apostrophe cases
2232 if Token = Tok_Apostrophe then
2233 Save_Scan_State (Scan_State); -- at apostrophe
2234 Scan; -- past apostrophe
2236 -- If qualified expression, scan it out and fall through
2238 if Token = Tok_Left_Paren then
2239 Node1 := P_Qualified_Expression (Node1);
2240 Expr_Form := EF_Simple;
2242 -- If range attribute, then we return with Token pointing to the
2243 -- apostrophe. Note: avoid the normal error check on exit. We
2244 -- know that the expression really is complete in this case.
2246 else -- Token = Tok_Range then
2247 Restore_Scan_State (Scan_State); -- to apostrophe
2248 Expr_Form := EF_Simple_Name;
2253 -- If an expression terminator follows, the previous processing
2254 -- completely scanned out the expression (a common case), and
2255 -- left Expr_Form set appropriately for returning to our caller.
2257 if Token in Token_Class_Sterm then
2260 -- If we do not have an expression terminator, then complete the
2261 -- scan of a simple expression. This code duplicates the code
2262 -- found in P_Term and P_Factor.
2265 if Token = Tok_Double_Asterisk then
2267 Style.Check_Exponentiation_Operator;
2270 Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
2272 Set_Left_Opnd (Node2, Node1);
2273 Set_Right_Opnd (Node2, P_Primary);
2279 exit when Token not in Token_Class_Mulop;
2280 Tokptr := Token_Ptr;
2281 Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
2284 Style.Check_Binary_Operator;
2287 Scan; -- past operator
2288 Set_Left_Opnd (Node2, Node1);
2289 Set_Right_Opnd (Node2, P_Factor);
2294 exit when Token not in Token_Class_Binary_Addop;
2295 Tokptr := Token_Ptr;
2296 Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
2299 Style.Check_Binary_Operator;
2302 Scan; -- past operator
2303 Set_Left_Opnd (Node2, Node1);
2304 Set_Right_Opnd (Node2, P_Term);
2308 Expr_Form := EF_Simple;
2311 -- Cases where simple expression does not start with a name
2314 -- Scan initial sign and initial Term
2316 if Token in Token_Class_Unary_Addop then
2317 Tokptr := Token_Ptr;
2318 Node1 := New_Op_Node (P_Unary_Adding_Operator, Tokptr);
2321 Style.Check_Unary_Plus_Or_Minus (Inside_Depends);
2324 Scan; -- past operator
2325 Set_Right_Opnd (Node1, P_Term);
2330 -- In the following, we special-case a sequence of concatenations of
2331 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
2332 -- else mixed in. For such a sequence, we return a tree representing
2333 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
2334 -- the number of concatenations is large. If semantic analysis
2335 -- resolves the "&" to a predefined one, then this folding gives the
2336 -- right answer. Otherwise, semantic analysis will complain about a
2337 -- capacity-exceeded error. The purpose of this trick is to avoid
2338 -- creating a deeply nested tree, which would cause deep recursion
2339 -- during semantics, causing stack overflow. This way, we can handle
2340 -- enormous concatenations in the normal case of predefined "&". We
2341 -- first build up the normal tree, and then rewrite it if
2345 Num_Concats_Threshold : constant Positive := 1000;
2346 -- Arbitrary threshold value to enable optimization
2348 First_Node : constant Node_Id := Node1;
2349 Is_Strlit_Concat : Boolean;
2350 -- True iff we've parsed a sequence of concatenations of string
2351 -- literals, with nothing else mixed in.
2353 Num_Concats : Natural;
2354 -- Number of "&" operators if Is_Strlit_Concat is True
2358 Nkind (Node1) = N_String_Literal
2359 and then Token = Tok_Ampersand;
2362 -- Scan out sequence of terms separated by binary adding operators
2365 exit when Token not in Token_Class_Binary_Addop;
2366 Tokptr := Token_Ptr;
2367 Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
2369 if Style_Check and then not Debug_Flag_Dot_QQ then
2370 Style.Check_Binary_Operator;
2373 Scan; -- past operator
2374 Set_Left_Opnd (Node2, Node1);
2376 Set_Right_Opnd (Node2, Node1);
2378 -- Check if we're still concatenating string literals
2382 and then Nkind (Node2) = N_Op_Concat
2383 and then Nkind (Node1) = N_String_Literal;
2385 if Is_Strlit_Concat then
2386 Num_Concats := Num_Concats + 1;
2392 -- If we have an enormous series of concatenations of string
2393 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2394 -- flag tells semantic analysis that if the "&" is not predefined,
2395 -- the folded value is wrong.
2398 and then Num_Concats >= Num_Concats_Threshold
2401 Empty_String_Val : String_Id;
2404 Strlit_Concat_Val : String_Id;
2405 -- Contains the folded value (which will be correct if the
2406 -- "&" operators are the predefined ones).
2409 -- For walking up the tree
2412 -- Folded node to replace Node1
2414 Loc : constant Source_Ptr := Sloc (First_Node);
2417 -- Walk up the tree starting at the leftmost string literal
2418 -- (First_Node), building up the Strlit_Concat_Val as we
2419 -- go. Note that we do not use recursion here -- the whole
2420 -- point is to avoid recursively walking that enormous tree.
2423 Store_String_Chars (Strval (First_Node));
2425 Cur_Node := Parent (First_Node);
2426 while Present (Cur_Node) loop
2427 pragma Assert (Nkind (Cur_Node) = N_Op_Concat and then
2428 Nkind (Right_Opnd (Cur_Node)) = N_String_Literal);
2430 Store_String_Chars (Strval (Right_Opnd (Cur_Node)));
2431 Cur_Node := Parent (Cur_Node);
2434 Strlit_Concat_Val := End_String;
2436 -- Create new folded node, and rewrite result with a concat-
2437 -- enation of an empty string literal and the folded node.
2440 Empty_String_Val := End_String;
2442 Make_Op_Concat (Loc,
2443 Make_String_Literal (Loc, Empty_String_Val),
2444 Make_String_Literal (Loc, Strlit_Concat_Val,
2445 Is_Folded_In_Parser => True));
2446 Rewrite (Node1, New_Node);
2451 -- All done, we clearly do not have name or numeric literal so this
2452 -- is a case of a simple expression which is some other possibility.
2454 Expr_Form := EF_Simple;
2457 -- Come here at end of simple expression, where we do a couple of
2458 -- special checks to improve error recovery.
2460 -- Special test to improve error recovery. If the current token is a
2461 -- period, then someone is trying to do selection on something that is
2462 -- not a name, e.g. a qualified expression.
2464 if Token = Tok_Dot then
2465 Error_Msg_SC ("prefix for selection is not a name");
2467 -- If qualified expression, comment and continue, otherwise something
2468 -- is pretty nasty so do an Error_Resync call.
2470 if Ada_Version < Ada_2012
2471 and then Nkind (Node1) = N_Qualified_Expression
2473 Error_Msg_SC ("\would be legal in Ada 2012 mode");
2479 -- Special test to improve error recovery: If the current token is
2480 -- not the first token on a line (as determined by checking the
2481 -- previous token position with the start of the current line),
2482 -- then we insist that we have an appropriate terminating token.
2483 -- Consider the following two examples:
2485 -- 1) if A nad B then ...
2490 -- In the first example, we would like to issue a binary operator
2491 -- expected message and resynchronize to the then. In the second
2492 -- example, we do not want to issue a binary operator message, so
2493 -- that instead we will get the missing semicolon message. This
2494 -- distinction is of course a heuristic which does not always work,
2495 -- but in practice it is quite effective.
2497 -- Note: the one case in which we do not go through this circuit is
2498 -- when we have scanned a range attribute and want to return with
2499 -- Token pointing to the apostrophe. The apostrophe is not normally
2500 -- an expression terminator, and is not in Token_Class_Sterm, but
2501 -- in this special case we know that the expression is complete.
2503 if not Token_Is_At_Start_Of_Line
2504 and then Token not in Token_Class_Sterm
2506 -- Normally the right error message is indeed that we expected a
2507 -- binary operator, but in the case of being between a right and left
2508 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2510 if Prev_Token = Tok_Right_Paren and then Token = Tok_Left_Paren then
2513 -- And if we have a quote, we may have a bad attribute
2515 elsif At_Start_Of_Attribute then
2516 Error_Msg_SC ("prefix of attribute must be a name");
2518 if Ada_Version >= Ada_2012 then
2519 Error_Msg_SC ("\qualify expression to turn it into a name");
2522 -- Normal case for binary operator expected message
2525 Error_Msg_AP ("binary operator expected");
2534 -- If any error occurs, then scan to next expression terminator symbol
2535 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2536 -- level. Expr_Form is set to indicate a normal simple expression.
2539 when Error_Resync =>
2541 Expr_Form := EF_Simple;
2543 end P_Simple_Expression;
2545 -----------------------------------------------
2546 -- 4.4 Simple Expression or Range Attribute --
2547 -----------------------------------------------
2549 -- SIMPLE_EXPRESSION ::=
2550 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2552 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2554 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2556 -- Error recovery: cannot raise Error_Resync
2558 function P_Simple_Expression_Or_Range_Attribute return Node_Id is
2560 Attr_Node : Node_Id;
2563 -- We don't just want to roar ahead and call P_Simple_Expression
2564 -- here, since we want to handle the case of a parenthesized range
2565 -- attribute cleanly.
2567 if Token = Tok_Left_Paren then
2569 Lptr : constant Source_Ptr := Token_Ptr;
2570 Scan_State : Saved_Scan_State;
2573 Save_Scan_State (Scan_State);
2574 Scan; -- past left paren
2575 Sexpr := P_Simple_Expression;
2577 if Token = Tok_Apostrophe then
2578 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2579 Expr_Form := EF_Range_Attr;
2581 if Token = Tok_Right_Paren then
2582 Scan; -- scan past right paren if present
2585 Error_Msg ("parentheses not allowed for range attribute", Lptr);
2590 Restore_Scan_State (Scan_State);
2594 -- Here after dealing with parenthesized range attribute
2596 Sexpr := P_Simple_Expression;
2598 if Token = Tok_Apostrophe then
2599 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2600 Expr_Form := EF_Range_Attr;
2606 end P_Simple_Expression_Or_Range_Attribute;
2612 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2614 -- Error recovery: can raise Error_Resync
2616 function P_Term return Node_Id is
2617 Node1, Node2 : Node_Id;
2618 Tokptr : Source_Ptr;
2624 exit when Token not in Token_Class_Mulop;
2625 Tokptr := Token_Ptr;
2626 Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
2628 if Style_Check and then not Debug_Flag_Dot_QQ then
2629 Style.Check_Binary_Operator;
2632 Scan; -- past operator
2633 Set_Left_Opnd (Node2, Node1);
2634 Set_Right_Opnd (Node2, P_Factor);
2645 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2647 -- Error recovery: can raise Error_Resync
2649 function P_Factor return Node_Id is
2654 if Token = Tok_Abs then
2655 Node1 := New_Op_Node (N_Op_Abs, Token_Ptr);
2658 Style.Check_Abs_Not;
2662 Set_Right_Opnd (Node1, P_Primary);
2665 elsif Token = Tok_Not then
2666 Node1 := New_Op_Node (N_Op_Not, Token_Ptr);
2669 Style.Check_Abs_Not;
2673 Set_Right_Opnd (Node1, P_Primary);
2679 if Token = Tok_Double_Asterisk then
2680 Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
2682 Set_Left_Opnd (Node2, Node1);
2683 Set_Right_Opnd (Node2, P_Primary);
2697 -- NUMERIC_LITERAL | null
2698 -- | STRING_LITERAL | AGGREGATE
2699 -- | NAME | QUALIFIED_EXPRESSION
2700 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2701 -- | REDUCTION_ATTRIBUTE_REFERENCE
2703 -- Error recovery: can raise Error_Resync
2705 function P_Primary return Node_Id is
2706 Scan_State : Saved_Scan_State;
2709 Lparen : constant Boolean := Prev_Token = Tok_Left_Paren;
2710 -- Remember if previous token is a left parenthesis. This is used to
2711 -- deal with checking whether IF/CASE/FOR expressions appearing as
2712 -- primaries require extra parenthesization.
2715 -- The loop runs more than once only if misplaced pragmas are found
2716 -- or if a misplaced unary minus is skipped.
2721 -- Name token can start a name, call or qualified expression, all
2722 -- of which are acceptable possibilities for primary. Note also
2723 -- that string literal is included in name (as operator symbol)
2724 -- and type conversion is included in name (as indexed component).
2726 when Tok_Char_Literal
2728 | Tok_Operator_Symbol
2732 -- All done unless apostrophe follows
2734 if Token /= Tok_Apostrophe then
2737 -- Apostrophe following means that we have either just parsed
2738 -- the subtype mark of a qualified expression, or the prefix
2739 -- or a range attribute.
2741 else -- Token = Tok_Apostrophe
2742 Save_Scan_State (Scan_State); -- at apostrophe
2743 Scan; -- past apostrophe
2745 -- If range attribute, then this is always an error, since
2746 -- the only legitimate case (where the scanned expression is
2747 -- a qualified simple name) is handled at the level of the
2748 -- Simple_Expression processing. This case corresponds to a
2749 -- usage such as 3 + A'Range, which is always illegal.
2751 if Token = Tok_Range then
2752 Restore_Scan_State (Scan_State); -- to apostrophe
2753 Bad_Range_Attribute (Token_Ptr);
2756 -- If left paren, then we have a qualified expression.
2757 -- Note that P_Name guarantees that in this case, where
2758 -- Token = Tok_Apostrophe on return, the only two possible
2759 -- tokens following the apostrophe are left paren and
2760 -- RANGE, so we know we have a left paren here.
2762 else -- Token = Tok_Left_Paren
2763 return P_Qualified_Expression (Node1);
2768 -- Numeric or string literal
2770 when Tok_Integer_Literal
2772 | Tok_String_Literal
2774 Node1 := Token_Node;
2775 Scan; -- past number
2778 -- Left paren, starts aggregate or parenthesized expression
2780 when Tok_Left_Paren =>
2782 Expr : constant Node_Id := P_Aggregate_Or_Paren_Expr;
2785 if Nkind (Expr) = N_Attribute_Reference
2786 and then Attribute_Name (Expr) = Name_Range
2788 Bad_Range_Attribute (Sloc (Expr));
2794 when Tok_Left_Bracket =>
2806 return New_Node (N_Null, Prev_Token_Ptr);
2808 -- Pragma, not allowed here, so just skip past it
2811 P_Pragmas_Misplaced;
2813 -- Deal with IF (possible unparenthesized if expression)
2817 -- If this looks like a real if, defined as an IF appearing at
2818 -- the start of a new line, then we consider we have a missing
2819 -- operand. If in Ada 2012 and the IF is not properly indented
2820 -- for a statement, we prefer to issue a message about an ill-
2821 -- parenthesized if expression.
2823 if Token_Is_At_Start_Of_Line
2825 (Ada_Version >= Ada_2012
2826 and then Style_Check_Indentation /= 0
2827 and then Start_Column rem Style_Check_Indentation /= 0)
2829 Error_Msg_AP ("missing operand");
2832 -- If this looks like an if expression, then treat it that way
2833 -- with an error message if not explicitly surrounded by
2836 elsif Ada_Version >= Ada_2012 then
2837 Node1 := P_If_Expression;
2839 if not (Lparen and then Token = Tok_Right_Paren) then
2841 ("if expression must be parenthesized", Sloc (Node1));
2846 -- Otherwise treat as misused identifier
2849 return P_Identifier;
2852 -- Deal with CASE (possible unparenthesized case expression)
2856 -- If this looks like a real case, defined as a CASE appearing
2857 -- the start of a new line, then we consider we have a missing
2858 -- operand. If in Ada 2012 and the CASE is not properly
2859 -- indented for a statement, we prefer to issue a message about
2860 -- an ill-parenthesized case expression.
2862 if Token_Is_At_Start_Of_Line
2864 (Ada_Version >= Ada_2012
2865 and then Style_Check_Indentation /= 0
2866 and then Start_Column rem Style_Check_Indentation /= 0)
2868 Error_Msg_AP ("missing operand");
2871 -- If this looks like a case expression, then treat it that way
2872 -- with an error message if not within parentheses.
2874 elsif Ada_Version >= Ada_2012 then
2875 Node1 := P_Case_Expression;
2877 if not (Lparen and then Token = Tok_Right_Paren) then
2879 ("case expression must be parenthesized", Sloc (Node1));
2884 -- Otherwise treat as misused identifier
2887 return P_Identifier;
2890 -- For [all | some] indicates a quantified expression
2893 if Token_Is_At_Start_Of_Line then
2894 Error_Msg_AP ("misplaced loop");
2897 elsif Ada_Version >= Ada_2012 then
2898 Save_Scan_State (Scan_State);
2901 if Token = Tok_All or else Token = Tok_Some then
2902 Restore_Scan_State (Scan_State); -- To FOR
2903 Node1 := P_Quantified_Expression;
2905 if not (Lparen and then Token = Tok_Right_Paren) then
2907 ("quantified expression must be parenthesized",
2911 Restore_Scan_State (Scan_State); -- To FOR
2912 Node1 := P_Iterated_Component_Association;
2917 -- Otherwise treat as misused identifier
2920 return P_Identifier;
2923 -- Minus may well be an improper attempt at a unary minus. Give
2924 -- a message, skip the minus and keep going.
2927 Error_Msg_SC ("parentheses required for unary minus");
2930 when Tok_At_Sign => -- AI12-0125 : target_name
2931 if Ada_Version < Ada_2020 then
2932 Error_Msg_SC ("target name is an Ada 202x feature");
2933 Error_Msg_SC ("\compile with -gnat2020");
2939 -- Anything else is illegal as the first token of a primary, but
2940 -- we test for some common errors, to improve error messages.
2943 if Is_Reserved_Identifier then
2944 return P_Identifier;
2946 elsif Prev_Token = Tok_Comma then
2947 Error_Msg_SP -- CODEFIX
2948 ("|extra "","" ignored");
2952 Error_Msg_AP ("missing operand");
2959 -------------------------------
2960 -- 4.4 Quantified_Expression --
2961 -------------------------------
2963 -- QUANTIFIED_EXPRESSION ::=
2964 -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
2965 -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
2967 function P_Quantified_Expression return Node_Id is
2972 Error_Msg_Ada_2012_Feature ("quantified expression", Token_Ptr);
2974 Node1 := New_Node (N_Quantified_Expression, Prev_Token_Ptr);
2976 if Token = Tok_All then
2977 Set_All_Present (Node1);
2978 elsif Token /= Tok_Some then
2979 Error_Msg_AP ("missing quantifier");
2983 Scan; -- past ALL or SOME
2984 I_Spec := P_Loop_Parameter_Specification;
2986 if Nkind (I_Spec) = N_Loop_Parameter_Specification then
2987 Set_Loop_Parameter_Specification (Node1, I_Spec);
2989 Set_Iterator_Specification (Node1, I_Spec);
2992 if Token = Tok_Arrow then
2994 Set_Condition (Node1, P_Expression);
2997 Error_Msg_AP ("missing arrow");
3000 end P_Quantified_Expression;
3002 ---------------------------
3003 -- 4.5 Logical Operator --
3004 ---------------------------
3006 -- LOGICAL_OPERATOR ::= and | or | xor
3008 -- Note: AND THEN and OR ELSE are also treated as logical operators
3009 -- by the parser (even though they are not operators semantically)
3011 -- The value returned is the appropriate Node_Kind code for the operator
3012 -- On return, Token points to the token following the scanned operator.
3014 -- The caller has checked that the first token is a legitimate logical
3015 -- operator token (i.e. is either XOR, AND, OR).
3017 -- Error recovery: cannot raise Error_Resync
3019 function P_Logical_Operator return Node_Kind is
3021 if Token = Tok_And then
3023 Style.Check_Binary_Operator;
3028 if Token = Tok_Then then
3035 elsif Token = Tok_Or then
3037 Style.Check_Binary_Operator;
3042 if Token = Tok_Else then
3049 else -- Token = Tok_Xor
3051 Style.Check_Binary_Operator;
3057 end P_Logical_Operator;
3059 ------------------------------
3060 -- 4.5 Relational Operator --
3061 ------------------------------
3063 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
3065 -- The value returned is the appropriate Node_Kind code for the operator.
3066 -- On return, Token points to the operator token, NOT past it.
3068 -- The caller has checked that the first token is a legitimate relational
3069 -- operator token (i.e. is one of the operator tokens listed above).
3071 -- Error recovery: cannot raise Error_Resync
3073 function P_Relational_Operator return Node_Kind is
3074 Op_Kind : Node_Kind;
3075 Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
3076 (Tok_Less => N_Op_Lt,
3077 Tok_Equal => N_Op_Eq,
3078 Tok_Greater => N_Op_Gt,
3079 Tok_Not_Equal => N_Op_Ne,
3080 Tok_Greater_Equal => N_Op_Ge,
3081 Tok_Less_Equal => N_Op_Le,
3083 Tok_Not => N_Not_In,
3084 Tok_Box => N_Op_Ne);
3087 if Token = Tok_Box then
3088 Error_Msg_SC -- CODEFIX
3089 ("|""'<'>"" should be ""/=""");
3092 Op_Kind := Relop_Node (Token);
3095 Style.Check_Binary_Operator;
3098 Scan; -- past operator token
3100 -- Deal with NOT IN, if previous token was NOT, we must have IN now
3102 if Prev_Token = Tok_Not then
3104 -- Style check, for NOT IN, we require one space between NOT and IN
3106 if Style_Check and then Token = Tok_In then
3114 end P_Relational_Operator;
3116 ---------------------------------
3117 -- 4.5 Binary Adding Operator --
3118 ---------------------------------
3120 -- BINARY_ADDING_OPERATOR ::= + | - | &
3122 -- The value returned is the appropriate Node_Kind code for the operator.
3123 -- On return, Token points to the operator token (NOT past it).
3125 -- The caller has checked that the first token is a legitimate adding
3126 -- operator token (i.e. is one of the operator tokens listed above).
3128 -- Error recovery: cannot raise Error_Resync
3130 function P_Binary_Adding_Operator return Node_Kind is
3131 Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
3132 (Tok_Ampersand => N_Op_Concat,
3133 Tok_Minus => N_Op_Subtract,
3134 Tok_Plus => N_Op_Add);
3136 return Addop_Node (Token);
3137 end P_Binary_Adding_Operator;
3139 --------------------------------
3140 -- 4.5 Unary Adding Operator --
3141 --------------------------------
3143 -- UNARY_ADDING_OPERATOR ::= + | -
3145 -- The value returned is the appropriate Node_Kind code for the operator.
3146 -- On return, Token points to the operator token (NOT past it).
3148 -- The caller has checked that the first token is a legitimate adding
3149 -- operator token (i.e. is one of the operator tokens listed above).
3151 -- Error recovery: cannot raise Error_Resync
3153 function P_Unary_Adding_Operator return Node_Kind is
3154 Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
3155 (Tok_Minus => N_Op_Minus,
3156 Tok_Plus => N_Op_Plus);
3158 return Addop_Node (Token);
3159 end P_Unary_Adding_Operator;
3161 -------------------------------
3162 -- 4.5 Multiplying Operator --
3163 -------------------------------
3165 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
3167 -- The value returned is the appropriate Node_Kind code for the operator.
3168 -- On return, Token points to the operator token (NOT past it).
3170 -- The caller has checked that the first token is a legitimate multiplying
3171 -- operator token (i.e. is one of the operator tokens listed above).
3173 -- Error recovery: cannot raise Error_Resync
3175 function P_Multiplying_Operator return Node_Kind is
3176 Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
3177 (Tok_Asterisk => N_Op_Multiply,
3178 Tok_Mod => N_Op_Mod,
3179 Tok_Rem => N_Op_Rem,
3180 Tok_Slash => N_Op_Divide);
3182 return Mulop_Node (Token);
3183 end P_Multiplying_Operator;
3185 --------------------------------------
3186 -- 4.5 Highest Precedence Operator --
3187 --------------------------------------
3189 -- Parsed by P_Factor (4.4)
3191 -- Note: this rule is not in fact used by the grammar at any point
3193 --------------------------
3194 -- 4.6 Type Conversion --
3195 --------------------------
3197 -- Parsed by P_Primary as a Name (4.1)
3199 -------------------------------
3200 -- 4.7 Qualified Expression --
3201 -------------------------------
3203 -- QUALIFIED_EXPRESSION ::=
3204 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
3206 -- The caller has scanned the name which is the Subtype_Mark parameter
3207 -- and scanned past the single quote following the subtype mark. The
3208 -- caller has not checked that this name is in fact appropriate for
3209 -- a subtype mark name (i.e. it is a selected component or identifier).
3211 -- Error_Recovery: cannot raise Error_Resync
3213 function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
3214 Qual_Node : Node_Id;
3216 Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
3217 Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
3218 Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
3220 end P_Qualified_Expression;
3222 --------------------
3224 --------------------
3227 -- new [SUBPOOL_SPECIFICATION] SUBTYPE_INDICATION
3228 -- | new [SUBPOOL_SPECIFICATION] QUALIFIED_EXPRESSION
3230 -- SUBPOOL_SPECIFICATION ::= (subpool_handle_NAME)
3232 -- The caller has checked that the initial token is NEW
3234 -- Error recovery: can raise Error_Resync
3236 function P_Allocator return Node_Id is
3237 Alloc_Node : Node_Id;
3238 Type_Node : Node_Id;
3239 Null_Exclusion_Present : Boolean;
3242 Alloc_Node := New_Node (N_Allocator, Token_Ptr);
3245 -- Scan subpool_specification if present (Ada 2012 (AI05-0111-3))
3247 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
3249 if Token = Tok_Left_Paren then
3251 Set_Subpool_Handle_Name (Alloc_Node, P_Name);
3254 Error_Msg_Ada_2012_Feature
3255 ("|subpool specification",
3256 Sloc (Subpool_Handle_Name (Alloc_Node)));
3259 Null_Exclusion_Present := P_Null_Exclusion;
3260 Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
3261 Type_Node := P_Subtype_Mark_Resync;
3263 if Token = Tok_Apostrophe then
3264 Scan; -- past apostrophe
3265 Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
3269 P_Subtype_Indication (Type_Node, Null_Exclusion_Present));
3271 -- AI05-0104: An explicit null exclusion is not allowed for an
3272 -- allocator without initialization. In previous versions of the
3273 -- language it just raises constraint error.
3275 if Ada_Version >= Ada_2012 and then Null_Exclusion_Present then
3277 ("an allocator with a subtype indication "
3278 & "cannot have a null exclusion", Alloc_Node);
3285 -----------------------
3286 -- P_Case_Expression --
3287 -----------------------
3289 function P_Case_Expression return Node_Id is
3290 Loc : constant Source_Ptr := Token_Ptr;
3291 Case_Node : Node_Id;
3292 Save_State : Saved_Scan_State;
3295 Error_Msg_Ada_2012_Feature ("|case expression", Token_Ptr);
3298 Make_Case_Expression (Loc,
3299 Expression => P_Expression_No_Right_Paren,
3300 Alternatives => New_List);
3303 -- We now have scanned out CASE expression IS, scan alternatives
3307 Append_To (Alternatives (Case_Node), P_Case_Expression_Alternative);
3309 -- Missing comma if WHEN (more alternatives present)
3311 if Token = Tok_When then
3314 -- A semicolon followed by "when" is probably meant to be a comma
3316 elsif Token = Tok_Semicolon then
3317 Save_Scan_State (Save_State);
3318 Scan; -- past the semicolon
3320 if Token /= Tok_When then
3321 Restore_Scan_State (Save_State);
3325 Error_Msg_SP -- CODEFIX
3326 ("|"";"" should be "",""");
3328 -- If comma/WHEN, skip comma and we have another alternative
3330 elsif Token = Tok_Comma then
3331 Save_Scan_State (Save_State);
3334 if Token /= Tok_When then
3335 Restore_Scan_State (Save_State);
3339 -- If no comma or WHEN, definitely done
3346 -- If we have an END CASE, diagnose as not needed
3348 if Token = Tok_End then
3349 Error_Msg_SC ("`END CASE` not allowed at end of case expression");
3352 if Token = Tok_Case then
3357 -- Return the Case_Expression node
3360 end P_Case_Expression;
3362 -----------------------------------
3363 -- P_Case_Expression_Alternative --
3364 -----------------------------------
3366 -- CASE_STATEMENT_ALTERNATIVE ::=
3367 -- when DISCRETE_CHOICE_LIST =>
3370 -- The caller has checked that and scanned past the initial WHEN token
3371 -- Error recovery: can raise Error_Resync
3373 function P_Case_Expression_Alternative return Node_Id is
3374 Case_Alt_Node : Node_Id;
3376 Case_Alt_Node := New_Node (N_Case_Expression_Alternative, Token_Ptr);
3377 Set_Discrete_Choices (Case_Alt_Node, P_Discrete_Choice_List);
3379 Set_Expression (Case_Alt_Node, P_Expression);
3380 return Case_Alt_Node;
3381 end P_Case_Expression_Alternative;
3383 --------------------------------------
3384 -- P_Iterated_Component_Association --
3385 --------------------------------------
3387 -- ITERATED_COMPONENT_ASSOCIATION ::=
3388 -- for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION
3390 function P_Iterated_Component_Association return Node_Id is
3391 Assoc_Node : Node_Id;
3393 -- Start of processing for P_Iterated_Component_Association
3398 New_Node (N_Iterated_Component_Association, Prev_Token_Ptr);
3400 Set_Defining_Identifier (Assoc_Node, P_Defining_Identifier);
3402 Set_Discrete_Choices (Assoc_Node, P_Discrete_Choice_List);
3404 Set_Expression (Assoc_Node, P_Expression);
3406 if Ada_Version < Ada_2020 then
3407 Error_Msg_SC ("iterated component is an Ada 202x feature");
3408 Error_Msg_SC ("\compile with -gnat2020");
3412 end P_Iterated_Component_Association;
3414 ---------------------
3415 -- P_If_Expression --
3416 ---------------------
3418 -- IF_EXPRESSION ::=
3419 -- if CONDITION then DEPENDENT_EXPRESSION
3420 -- {elsif CONDITION then DEPENDENT_EXPRESSION}
3421 -- [else DEPENDENT_EXPRESSION]
3423 -- DEPENDENT_EXPRESSION ::= EXPRESSION
3425 function P_If_Expression return Node_Id is
3426 function P_If_Expression_Internal
3428 Cond : Node_Id) return Node_Id;
3429 -- This is the internal recursive routine that does all the work, it is
3430 -- recursive since it is used to process ELSIF parts, which internally
3431 -- are N_If_Expression nodes with the Is_Elsif flag set. The calling
3432 -- sequence is like the outer function except that the caller passes
3433 -- the conditional expression (scanned using P_Expression), and the
3434 -- scan pointer points just past this expression. Loc points to the
3435 -- IF or ELSIF token.
3437 ------------------------------
3438 -- P_If_Expression_Internal --
3439 ------------------------------
3441 function P_If_Expression_Internal
3443 Cond : Node_Id) return Node_Id
3445 Exprs : constant List_Id := New_List;
3447 State : Saved_Scan_State;
3451 -- All cases except where we are at right paren
3453 if Token /= Tok_Right_Paren then
3455 Append_To (Exprs, P_Condition (Cond));
3456 Append_To (Exprs, P_Expression);
3458 -- Case of right paren (missing THEN phrase). Note that we know this
3459 -- is the IF case, since the caller dealt with this possibility in
3463 Error_Msg_BC ("missing THEN phrase");
3464 Append_To (Exprs, P_Condition (Cond));
3467 -- We now have scanned out IF expr THEN expr
3469 -- Check for common error of semicolon before the ELSE
3471 if Token = Tok_Semicolon then
3472 Save_Scan_State (State);
3473 Scan; -- past semicolon
3475 if Token = Tok_Else or else Token = Tok_Elsif then
3476 Error_Msg_SP -- CODEFIX
3477 ("|extra "";"" ignored");
3480 Restore_Scan_State (State);
3484 -- Scan out ELSIF sequence if present
3486 if Token = Tok_Elsif then
3489 Expr := P_Expression;
3491 -- If we are at a right paren, we assume the ELSIF should be ELSE
3493 if Token = Tok_Right_Paren then
3494 Error_Msg ("ELSIF should be ELSE", Eptr);
3495 Append_To (Exprs, Expr);
3497 -- Otherwise we have an OK ELSIF
3500 Expr := P_If_Expression_Internal (Eptr, Expr);
3501 Set_Is_Elsif (Expr);
3502 Append_To (Exprs, Expr);
3505 -- Scan out ELSE phrase if present
3507 elsif Token = Tok_Else then
3509 -- Scan out ELSE expression
3512 Append_To (Exprs, P_Expression);
3514 -- Skip redundant ELSE parts
3516 while Token = Tok_Else loop
3517 Error_Msg_SC ("only one ELSE part is allowed");
3519 Discard_Junk_Node (P_Expression);
3522 -- Two expression case (implied True, filled in during semantics)
3528 -- If we have an END IF, diagnose as not needed
3530 if Token = Tok_End then
3531 Error_Msg_SC ("`END IF` not allowed at end of if expression");
3534 if Token = Tok_If then
3539 -- Return the If_Expression node
3541 return Make_If_Expression (Loc, Expressions => Exprs);
3542 end P_If_Expression_Internal;
3546 Loc : constant Source_Ptr := Token_Ptr;
3549 -- Start of processing for P_If_Expression
3552 Error_Msg_Ada_2012_Feature ("|if expression", Token_Ptr);
3554 Inside_If_Expression := Inside_If_Expression + 1;
3555 If_Expr := P_If_Expression_Internal (Loc, P_Expression);
3556 Inside_If_Expression := Inside_If_Expression - 1;
3558 end P_If_Expression;
3560 -----------------------
3561 -- P_Membership_Test --
3562 -----------------------
3564 -- MEMBERSHIP_CHOICE_LIST ::= MEMBERSHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
3565 -- MEMBERSHIP_CHOICE ::= CHOICE_EXPRESSION | range | subtype_mark
3567 procedure P_Membership_Test (N : Node_Id) is
3568 Alt : constant Node_Id :=
3569 P_Range_Or_Subtype_Mark
3570 (Allow_Simple_Expression => (Ada_Version >= Ada_2012));
3575 if Token = Tok_Vertical_Bar then
3576 Error_Msg_Ada_2012_Feature ("set notation", Token_Ptr);
3577 Set_Alternatives (N, New_List (Alt));
3578 Set_Right_Opnd (N, Empty);
3580 -- Loop to accumulate alternatives
3582 while Token = Tok_Vertical_Bar loop
3583 Scan; -- past vertical bar
3586 P_Range_Or_Subtype_Mark (Allow_Simple_Expression => True));
3592 Set_Right_Opnd (N, Alt);
3593 Set_Alternatives (N, No_List);
3595 end P_Membership_Test;
3597 ------------------------------------------
3598 -- P_Unparen_Cond_Case_Quant_Expression --
3599 ------------------------------------------
3601 function P_Unparen_Cond_Case_Quant_Expression return Node_Id is
3602 Lparen : constant Boolean := Prev_Token = Tok_Left_Paren;
3605 Scan_State : Saved_Scan_State;
3610 if Token = Tok_Case then
3611 Result := P_Case_Expression;
3613 if not (Lparen and then Token = Tok_Right_Paren) then
3614 Error_Msg_N ("case expression must be parenthesized!", Result);
3619 elsif Token = Tok_If then
3620 Result := P_If_Expression;
3622 if not (Lparen and then Token = Tok_Right_Paren) then
3623 Error_Msg_N ("if expression must be parenthesized!", Result);
3626 -- Quantified expression or iterated component association
3628 elsif Token = Tok_For then
3630 Save_Scan_State (Scan_State);
3633 if Token = Tok_All or else Token = Tok_Some then
3634 Restore_Scan_State (Scan_State);
3635 Result := P_Quantified_Expression;
3637 if not (Lparen and then Token = Tok_Right_Paren) then
3639 ("quantified expression must be parenthesized!", Result);
3643 -- If no quantifier keyword, this is an iterated component in
3646 Restore_Scan_State (Scan_State);
3647 Result := P_Iterated_Component_Association;
3650 -- No other possibility should exist (caller was supposed to check)
3653 raise Program_Error;
3656 -- Return expression (possibly after having given message)
3659 end P_Unparen_Cond_Case_Quant_Expression;