-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- Attributes that cannot have arguments
Is_Parameterless_Attribute : constant Attribute_Class_Array :=
- (Attribute_Body_Version => True,
+ (Attribute_Base => True,
+ Attribute_Body_Version => True,
+ Attribute_Class => True,
Attribute_External_Tag => True,
Attribute_Img => True,
- Attribute_Version => True,
- Attribute_Base => True,
- Attribute_Class => True,
Attribute_Stub_Type => True,
+ Attribute_Version => True,
Attribute_Type_Key => True,
others => False);
-- This map contains True for parameterless attributes that return a
-- 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);
raise Error_Resync;
elsif Token /= Tok_Right_Paren then
- T_Right_Paren;
- raise Error_Resync;
+ if Token = Tok_Arrow then
+
+ -- This may be an aggregate that is missing a qualification
+
+ Error_Msg_SC
+ ("context of aggregate must be a qualified expression");
+ raise Error_Resync;
+
+ else
+ T_Right_Paren;
+ raise Error_Resync;
+ end if;
else
Scan; -- past right paren
Error_Msg
("expect identifier in parameter association",
Sloc (Expr_Node));
- Scan; -- past arrow.
+ Scan; -- past arrow
elsif not Comma_Present then
T_Right_Paren;
Expr_Node := Error;
end Box_Error;
- -- Start of processsing for P_Aggregate_Or_Paren_Expr
+ -- Start of processing for P_Aggregate_Or_Paren_Expr
begin
Lparen_Sloc := Token_Ptr;
T_Right_Paren;
return Expr_Node;
+ -- Quantified expression case
+
+ elsif Token = Tok_For then
+ Expr_Node := P_Quantified_Expression;
+ T_Right_Paren;
+ return Expr_Node;
+
-- Note: the mechanism used here of rescanning the initial expression
-- is distinctly unpleasant, but it saves a lot of fiddling in scanning
-- out the discrete choice list.
-- that doesn't belong to us!
if Token in Token_Class_Eterm then
- Error_Msg_AP ("expecting expression or component association");
+ Error_Msg_AP
+ ("expecting expression or component association");
exit;
end if;
-- 4.4 Expression --
---------------------
+ -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
+
-- EXPRESSION ::=
- -- RELATION {and RELATION} | RELATION {and then RELATION}
- -- | RELATION {or RELATION} | RELATION {or else RELATION}
- -- | RELATION {xor RELATION}
+ -- RELATION {LOGICAL_OPERATOR RELATION}
+
+ -- CHOICE_EXPRESSION ::=
+ -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
+
+ -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
-- On return, Expr_Form indicates the categorization of the expression
-- EF_Range_Attr is not a possible value (if a range attribute is found,
end P_Expression;
-- This function is identical to the normal P_Expression, except that it
- -- also permits the appearence of a case of conditional expression without
- -- the usual surrounding parentheses.
+ -- also permits the appearance of a case, conditional, or quantified
+ -- 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;
- elsif Token = Tok_If then
- return P_Conditional_Expression;
+ -- Case of conditional, case or quantified expression
+
+ if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
+ return P_Unparen_Cond_Case_Quant_Expression;
+
+ -- Normal case, not case/conditional/quantified expression
+
else
return P_Expression;
end if;
end if;
end P_Expression_Or_Range_Attribute;
- -- Version that allows a non-parenthesized case or conditional expression
+ -- Version that allows a non-parenthesized case, conditional, or quantified
+ -- 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;
- elsif Token = Tok_If then
- return P_Conditional_Expression;
+ -- Case of conditional, case or quantified expression
+
+ if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
+ return P_Unparen_Cond_Case_Quant_Expression;
+
+ -- Normal case, not one of the above expression types
+
else
return P_Expression_Or_Range_Attribute;
end if;
-- 4.4 Relation --
-------------------
- -- RELATION ::=
+ -- This procedure scans both relations and choice relations
+
+ -- CHOICE_RELATION ::=
-- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
- -- | SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
+
+ -- RELATION ::=
+ -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
+
+ -- MEMBERSHIP_CHOICE_LIST ::=
+ -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
+
+ -- MEMBERSHIP_CHOICE ::=
+ -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
-- On return, Expr_Form indicates the categorization of the expression
-- NUMERIC_LITERAL | null
-- | STRING_LITERAL | AGGREGATE
-- | NAME | QUALIFIED_EXPRESSION
- -- | ALLOCATOR | (EXPRESSION)
+ -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
-- Error recovery: can raise Error_Resync
-- If this looks like a real if, defined as an IF appearing at
-- the start of a new line, then we consider we have a missing
- -- operand.
-
- if Token_Is_At_Start_Of_Line then
+ -- operand. If in Ada 2012 and the IF is not properly indented
+ -- for a statement, we prefer to issue a message about an ill-
+ -- parenthesized conditional expression.
+
+ if Token_Is_At_Start_Of_Line
+ and then not
+ (Ada_Version >= Ada_2012
+ and then Style_Check_Indentation /= 0
+ and then Start_Column rem Style_Check_Indentation /= 0)
+ then
Error_Msg_AP ("missing operand");
return Error;
-- If this looks like a real case, defined as a CASE appearing
-- the start of a new line, then we consider we have a missing
- -- operand.
-
- if Token_Is_At_Start_Of_Line then
+ -- operand. If in Ada 2012 and the CASE is not properly
+ -- indented for a statement, we prefer to issue a message about
+ -- an ill-parenthesized case expression.
+
+ if Token_Is_At_Start_Of_Line
+ and then not
+ (Ada_Version >= Ada_2012
+ and then Style_Check_Indentation /= 0
+ and then Start_Column rem Style_Check_Indentation /= 0)
+ then
Error_Msg_AP ("missing operand");
return Error;
return P_Identifier;
end if;
+ -- For [all | some] indicates a quantified expression
+
+ when Tok_For =>
+
+ if Token_Is_At_Start_Of_Line then
+ Error_Msg_AP ("misplaced loop");
+ return Error;
+
+ elsif Ada_Version >= Ada_2012 then
+ Error_Msg_SC ("quantified expression must be parenthesized");
+ return P_Quantified_Expression;
+
+ else
+
+ -- Otherwise treat as misused identifier
+
+ return P_Identifier;
+ end if;
+
-- Anything else is illegal as the first token of a primary, but
-- we test for a reserved identifier so that it is treated nicely
end loop;
end P_Primary;
+ -------------------------------
+ -- 4.4 Quantified_Expression --
+ -------------------------------
+
+ -- QUANTIFIED_EXPRESSION ::=
+ -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
+ -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
+
+ function P_Quantified_Expression return Node_Id is
+ I_Spec : Node_Id;
+ Node1 : Node_Id;
+
+ begin
+ if Ada_Version < Ada_2012 then
+ Error_Msg_SC ("quantified expression is an Ada 2012 feature");
+ Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
+ end if;
+
+ Scan; -- past FOR
+
+ Node1 := New_Node (N_Quantified_Expression, Prev_Token_Ptr);
+
+ if Token = Tok_All then
+ Set_All_Present (Node1);
+
+ elsif Token /= Tok_Some then
+ Error_Msg_AP ("missing quantifier");
+ raise Error_Resync;
+ end if;
+
+ Scan; -- past SOME
+ I_Spec := P_Loop_Parameter_Specification;
+
+ if Nkind (I_Spec) = N_Loop_Parameter_Specification then
+ Set_Loop_Parameter_Specification (Node1, I_Spec);
+ else
+ Set_Iterator_Specification (Node1, I_Spec);
+ end if;
+
+ if Token = Tok_Arrow then
+ Scan;
+ Set_Condition (Node1, P_Expression);
+ return Node1;
+ else
+ Error_Msg_AP ("missing arrow");
+ raise Error_Resync;
+ end if;
+ end P_Quantified_Expression;
+
---------------------------
-- 4.5 Logical Operator --
---------------------------
--------------------
-- 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
