-- prefix. The current token is known to be an apostrophe and the
-- following token is known to be RANGE.
+ function P_Unparen_Cond_Case_Quant_Expression return Node_Id;
+ -- This function is called with Token pointing to IF, CASE, or FOR, in a
+ -- context that allows a case, conditional, or quantified expression if
+ -- it is surrounded by parentheses. If not surrounded by parentheses, the
+ -- expression is still returned, but an error message is issued.
+
-------------------------
-- Bad_Range_Attribute --
-------------------------
end if;
end if;
- -- We come here with an OK attribute scanned, and the
- -- corresponding Attribute identifier node stored in Ident_Node.
+ -- We come here with an OK attribute scanned, and corresponding
+ -- Attribute identifier node stored in Ident_Node.
Prefix_Node := Name_Node;
Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
Error_Msg
("expect identifier in parameter association",
Sloc (Expr_Node));
- Scan; -- past arrow
+ Scan; -- past arrow
elsif not Comma_Present then
T_Right_Paren;
-- that doesn't belong to us!
if Token in Token_Class_Eterm then
-
- -- If Some becomes a keyword, the following is needed to make it
- -- acceptable in older versions of Ada.
-
- if Token = Tok_Some
- and then Ada_Version < Ada_2012
- then
- Scan_Reserved_Identifier (False);
- else
- Error_Msg_AP
- ("expecting expression or component association");
- exit;
- end if;
+ Error_Msg_AP
+ ("expecting expression or component association");
+ exit;
end if;
-- Deal with misused box
-- This function is identical to the normal P_Expression, except that it
-- also permits the appearance of a case, conditional, or quantified
- -- expression without the usual surrounding parentheses.
+ -- expression if the call immediately follows a left paren, and followed
+ -- by a right parenthesis. These forms are allowed if these conditions
+ -- are not met, but an error message will be issued.
function P_Expression_If_OK return Node_Id is
begin
- if Token = Tok_Case then
- return P_Case_Expression;
+ -- Case of conditional, case or quantified expression
- elsif Token = Tok_If then
- return P_Conditional_Expression;
+ if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
+ return P_Unparen_Cond_Case_Quant_Expression;
- elsif Token = Tok_For then
- return P_Quantified_Expression;
+ -- Normal case, not case/conditional/quantified expression
else
return P_Expression;
end P_Expression_Or_Range_Attribute;
-- Version that allows a non-parenthesized case, conditional, or quantified
- -- expression
+ -- expression if the call immediately follows a left paren, and followed
+ -- by a right parenthesis. These forms are allowed if these conditions
+ -- are not met, but an error message will be issued.
function P_Expression_Or_Range_Attribute_If_OK return Node_Id is
begin
- if Token = Tok_Case then
- return P_Case_Expression;
+ -- Case of conditional, case or quantified expression
- elsif Token = Tok_If then
- return P_Conditional_Expression;
+ if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
+ return P_Unparen_Cond_Case_Quant_Expression;
- elsif Token = Tok_For then
- return P_Quantified_Expression;
+ -- Normal case, not one of the above expression types
else
return P_Expression_Or_Range_Attribute;
if Token = Tok_All then
Set_All_Present (Node1);
- -- We treat Some as a non-reserved keyword, so it appears to the scanner
- -- as an identifier. If Some is made into a reserved word, the check
- -- below is against Tok_Some.
-
- elsif Token /= Tok_Identifier
- or else Chars (Token_Node) /= Name_Some
- then
+ elsif Token /= Tok_Some then
Error_Msg_AP ("missing quantifier");
raise Error_Resync;
end if;
--------------------
-- ALLOCATOR ::=
- -- new [NULL_EXCLUSION] SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
+ -- new [SUBPOOL_SPECIFICATION] SUBTYPE_INDICATION
+ -- | new [SUBPOOL_SPECIFICATION] QUALIFIED_EXPRESSION
+ --
+ -- SUBPOOL_SPECIFICATION ::= (subpool_handle_NAME)
-- The caller has checked that the initial token is NEW
Alloc_Node := New_Node (N_Allocator, Token_Ptr);
T_New;
+ -- Scan subpool_specification if present (Ada 2012 (AI05-0111-3))
+
-- Scan Null_Exclusion if present (Ada 2005 (AI-231))
+ if Token = Tok_Left_Paren then
+ Scan; -- past (
+ Set_Subpool_Handle_Name (Alloc_Node, P_Name);
+ T_Right_Paren;
+
+ if Ada_Version < Ada_2012 then
+ Error_Msg_N
+ ("|subpool specification is an Ada 2012 feature",
+ Subpool_Handle_Name (Alloc_Node));
+ Error_Msg_N
+ ("\|unit must be compiled with -gnat2012 switch",
+ Subpool_Handle_Name (Alloc_Node));
+ end if;
+ end if;
+
Null_Exclusion_Present := P_Null_Exclusion;
Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
Type_Node := P_Subtype_Mark_Resync;
end if;
end P_Membership_Test;
+ ------------------------------------------
+ -- P_Unparen_Cond_Case_Quant_Expression --
+ ------------------------------------------
+
+ function P_Unparen_Cond_Case_Quant_Expression return Node_Id is
+ Lparen : constant Boolean := Prev_Token = Tok_Left_Paren;
+ Result : Node_Id;
+
+ begin
+ -- Case expression
+
+ if Token = Tok_Case then
+ Result := P_Case_Expression;
+
+ if not (Lparen and then Token = Tok_Right_Paren) then
+ Error_Msg_N
+ ("case expression must be parenthesized!", Result);
+ end if;
+
+ -- Conditional expression
+
+ elsif Token = Tok_If then
+ Result := P_Conditional_Expression;
+
+ if not (Lparen and then Token = Tok_Right_Paren) then
+ Error_Msg_N
+ ("conditional expression must be parenthesized!", Result);
+ end if;
+
+ -- Quantified expression
+
+ elsif Token = Tok_For then
+ Result := P_Quantified_Expression;
+
+ if not (Lparen and then Token = Tok_Right_Paren) then
+ Error_Msg_N
+ ("quantified expression must be parenthesized!", Result);
+ end if;
+
+ -- No other possibility should exist (caller was supposed to check)
+
+ else
+ raise Program_Error;
+ end if;
+
+ -- Return expression (possibly after having given message)
+
+ return Result;
+ end P_Unparen_Cond_Case_Quant_Expression;
+
end Ch4;
OSDN Git Service
