-- Called to place complaint about bad range attribute at the given
-- source location. Terminates by raising Error_Resync.
+ procedure P_Membership_Test (N : Node_Id);
+ -- N is the node for a N_In or N_Not_In node whose right operand has not
+ -- yet been processed. It is called just after scanning out the IN keyword.
+ -- On return, either Right_Opnd or Alternatives is set, as appropriate.
+
function P_Range_Attribute_Reference (Prefix_Node : Node_Id) return Node_Id;
-- Scan a range attribute reference. The caller has scanned out the
-- prefix. The current token is known to be an apostrophe and the
-- following token is known to be RANGE.
- procedure Set_Op_Name (Node : Node_Id);
- -- Procedure to set name field (Chars) in operator node
-
-------------------------
-- Bad_Range_Attribute --
-------------------------
Resync_Expression;
end Bad_Range_Attribute;
- ------------------
- -- Set_Op_Name --
- ------------------
-
- procedure Set_Op_Name (Node : Node_Id) is
- type Name_Of_Type is array (N_Op) of Name_Id;
- Name_Of : constant Name_Of_Type := Name_Of_Type'(
- N_Op_And => Name_Op_And,
- N_Op_Or => Name_Op_Or,
- N_Op_Xor => Name_Op_Xor,
- N_Op_Eq => Name_Op_Eq,
- N_Op_Ne => Name_Op_Ne,
- N_Op_Lt => Name_Op_Lt,
- N_Op_Le => Name_Op_Le,
- N_Op_Gt => Name_Op_Gt,
- N_Op_Ge => Name_Op_Ge,
- N_Op_Add => Name_Op_Add,
- N_Op_Subtract => Name_Op_Subtract,
- N_Op_Concat => Name_Op_Concat,
- N_Op_Multiply => Name_Op_Multiply,
- N_Op_Divide => Name_Op_Divide,
- N_Op_Mod => Name_Op_Mod,
- N_Op_Rem => Name_Op_Rem,
- N_Op_Expon => Name_Op_Expon,
- N_Op_Plus => Name_Op_Add,
- N_Op_Minus => Name_Op_Subtract,
- N_Op_Abs => Name_Op_Abs,
- N_Op_Not => Name_Op_Not,
-
- -- We don't really need these shift operators, since they never
- -- appear as operators in the source, but the path of least
- -- resistance is to put them in (the aggregate must be complete)
-
- N_Op_Rotate_Left => Name_Rotate_Left,
- N_Op_Rotate_Right => Name_Rotate_Right,
- N_Op_Shift_Left => Name_Shift_Left,
- N_Op_Shift_Right => Name_Shift_Right,
- N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
-
- begin
- if Nkind (Node) in N_Op then
- Set_Chars (Node, Name_Of (Nkind (Node)));
- end if;
- end Set_Op_Name;
-
--------------------------
-- 4.1 Name (also 6.4) --
--------------------------
loop
Discard_Junk_Node (P_Expression_If_OK);
- exit when not Comma_Present;
+ exit when not Comma_Present;
end loop;
T_Right_Paren;
exception
when Error_Resync =>
return Error;
-
end P_Function_Name;
-- This function parses a restricted form of Names which are either
exception
when Error_Resync =>
return Error;
-
end P_Qualified_Simple_Name;
-- This procedure differs from P_Qualified_Simple_Name only in that it
Set_Selector_Name (Selector_Node, Designator_Node);
return Selector_Node;
end if;
-
end P_Qualified_Simple_Name_Resync;
----------------------
Append (Expr_Node, Expr_List);
+ -- Check for aggregate followed by left parent, maybe missing comma
+
+ elsif Nkind (Expr_Node) = N_Aggregate
+ and then Token = Tok_Left_Paren
+ then
+ T_Comma;
+
+ if No (Expr_List) then
+ Expr_List := New_List;
+ end if;
+
+ Append (Expr_Node, Expr_List);
+
-- Anything else is assumed to be a named association
else
end if;
Node2 := Node1;
- Node1 := New_Node (Logical_Op, Op_Location);
+ Node1 := New_Op_Node (Logical_Op, Op_Location);
Set_Left_Opnd (Node1, Node2);
Set_Right_Opnd (Node1, P_Relation);
- Set_Op_Name (Node1);
exit when Token not in Token_Class_Logop;
end loop;
end if;
Node2 := Node1;
- Node1 := New_Node (Logical_Op, Op_Location);
+ Node1 := New_Op_Node (Logical_Op, Op_Location);
Set_Left_Opnd (Node1, Node2);
Set_Right_Opnd (Node1, P_Relation);
- Set_Op_Name (Node1);
exit when Token not in Token_Class_Logop;
end loop;
-- P_Relational_Operator also parses the IN and NOT IN operations.
Optok := Token_Ptr;
- Node2 := New_Node (P_Relational_Operator, Optok);
+ Node2 := New_Op_Node (P_Relational_Operator, Optok);
Set_Left_Opnd (Node2, Node1);
- Set_Op_Name (Node2);
-- Case of IN or NOT IN
if Prev_Token = Tok_In then
- Set_Right_Opnd (Node2, P_Range_Or_Subtype_Mark);
+ P_Membership_Test (Node2);
-- Case of relational operator (= /= < <= > >=)
Style.Check_Exponentiation_Operator;
end if;
- Node2 := New_Node (N_Op_Expon, Token_Ptr);
+ Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
Scan; -- past **
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Primary);
- Set_Op_Name (Node2);
Node1 := Node2;
end if;
loop
exit when Token not in Token_Class_Mulop;
Tokptr := Token_Ptr;
- Node2 := New_Node (P_Multiplying_Operator, Tokptr);
+ Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
if Style_Check then
Style.Check_Binary_Operator;
Scan; -- past operator
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Factor);
- Set_Op_Name (Node2);
Node1 := Node2;
end loop;
loop
exit when Token not in Token_Class_Binary_Addop;
Tokptr := Token_Ptr;
- Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
+ Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
if Style_Check then
Style.Check_Binary_Operator;
Scan; -- past operator
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Term);
- Set_Op_Name (Node2);
Node1 := Node2;
end loop;
if Token in Token_Class_Unary_Addop then
Tokptr := Token_Ptr;
- Node1 := New_Node (P_Unary_Adding_Operator, Tokptr);
+ Node1 := New_Op_Node (P_Unary_Adding_Operator, Tokptr);
if Style_Check then
Style.Check_Unary_Plus_Or_Minus;
Scan; -- past operator
Set_Right_Opnd (Node1, P_Term);
- Set_Op_Name (Node1);
else
Node1 := P_Term;
end if;
loop
exit when Token not in Token_Class_Binary_Addop;
Tokptr := Token_Ptr;
- Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
+ Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
Scan; -- past operator
Set_Left_Opnd (Node2, Node1);
Node1 := P_Term;
Set_Right_Opnd (Node2, Node1);
- Set_Op_Name (Node2);
-- Check if we're still concatenating string literals
if not Token_Is_At_Start_Of_Line
and then Token not in Token_Class_Sterm
then
- Error_Msg_AP ("binary operator expected");
+ -- Normally the right error message is indeed that we expected a
+ -- binary operator, but in the case of being between a right and left
+ -- paren, e.g. in an aggregate, a more likely error is missing comma.
+
+ if Prev_Token = Tok_Right_Paren and then Token = Tok_Left_Paren then
+ T_Comma;
+ else
+ Error_Msg_AP ("binary operator expected");
+ end if;
+
raise Error_Resync;
+
else
return Node1;
end if;
Resync_Expression;
Expr_Form := EF_Simple;
return Error;
-
end P_Simple_Expression;
-----------------------------------------------
loop
exit when Token not in Token_Class_Mulop;
Tokptr := Token_Ptr;
- Node2 := New_Node (P_Multiplying_Operator, Tokptr);
+ Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
Scan; -- past operator
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Factor);
- Set_Op_Name (Node2);
Node1 := Node2;
end loop;
begin
if Token = Tok_Abs then
- Node1 := New_Node (N_Op_Abs, Token_Ptr);
+ Node1 := New_Op_Node (N_Op_Abs, Token_Ptr);
if Style_Check then
Style.Check_Abs_Not;
Scan; -- past ABS
Set_Right_Opnd (Node1, P_Primary);
- Set_Op_Name (Node1);
return Node1;
elsif Token = Tok_Not then
- Node1 := New_Node (N_Op_Not, Token_Ptr);
+ Node1 := New_Op_Node (N_Op_Not, Token_Ptr);
if Style_Check then
Style.Check_Abs_Not;
Scan; -- past NOT
Set_Right_Opnd (Node1, P_Primary);
- Set_Op_Name (Node1);
return Node1;
else
Node1 := P_Primary;
if Token = Tok_Double_Asterisk then
- Node2 := New_Node (N_Op_Expon, Token_Ptr);
+ Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
Scan; -- past **
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Primary);
- Set_Op_Name (Node2);
return Node2;
else
return Node1;
function P_Relational_Operator return Node_Kind is
Op_Kind : Node_Kind;
Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
- (Tok_Less => N_Op_Lt,
- Tok_Equal => N_Op_Eq,
- Tok_Greater => N_Op_Gt,
- Tok_Not_Equal => N_Op_Ne,
- Tok_Greater_Equal => N_Op_Ge,
- Tok_Less_Equal => N_Op_Le,
- Tok_In => N_In,
- Tok_Not => N_Not_In,
- Tok_Box => N_Op_Ne);
+ (Tok_Less => N_Op_Lt,
+ Tok_Equal => N_Op_Eq,
+ Tok_Greater => N_Op_Gt,
+ Tok_Not_Equal => N_Op_Ne,
+ Tok_Greater_Equal => N_Op_Ge,
+ Tok_Less_Equal => N_Op_Le,
+ Tok_In => N_In,
+ Tok_Not => N_Not_In,
+ Tok_Box => N_Op_Ne);
begin
if Token = Tok_Box then
function P_Binary_Adding_Operator return Node_Kind is
Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
- (Tok_Ampersand => N_Op_Concat,
- Tok_Minus => N_Op_Subtract,
- Tok_Plus => N_Op_Add);
+ (Tok_Ampersand => N_Op_Concat,
+ Tok_Minus => N_Op_Subtract,
+ Tok_Plus => N_Op_Add);
begin
return Addop_Node (Token);
end P_Binary_Adding_Operator;
function P_Unary_Adding_Operator return Node_Kind is
Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
- (Tok_Minus => N_Op_Minus,
- Tok_Plus => N_Op_Plus);
+ (Tok_Minus => N_Op_Minus,
+ Tok_Plus => N_Op_Plus);
begin
return Addop_Node (Token);
end P_Unary_Adding_Operator;
function P_Conditional_Expression return Node_Id is
Exprs : constant List_Id := New_List;
- Loc : constant Source_Ptr := Scan_Ptr;
+ Loc : constant Source_Ptr := Token_Ptr;
Expr : Node_Id;
State : Saved_Scan_State;
Inside_Conditional_Expression := Inside_Conditional_Expression + 1;
if Token = Tok_If and then not Extensions_Allowed then
- Error_Msg_SC ("conditional expression is an Ada extension");
- Error_Msg_SC ("\use -gnatX switch to compile this unit");
+ Error_Msg_SC ("|conditional expression is an Ada extension");
+ Error_Msg_SC ("\|use -gnatX switch to compile this unit");
end if;
Scan; -- past IF or ELSIF
Expressions => Exprs);
end P_Conditional_Expression;
+ -----------------------
+ -- P_Membership_Test --
+ -----------------------
+
+ procedure P_Membership_Test (N : Node_Id) is
+ Alt : constant Node_Id :=
+ P_Range_Or_Subtype_Mark
+ (Allow_Simple_Expression => Extensions_Allowed);
+
+ begin
+ -- Set case
+
+ if Token = Tok_Vertical_Bar then
+ if not Extensions_Allowed then
+ Error_Msg_SC ("set notation is a language extension");
+ Error_Msg_SC ("\|use -gnatX switch to compile this unit");
+ end if;
+
+ Set_Alternatives (N, New_List (Alt));
+ Set_Right_Opnd (N, Empty);
+
+ -- Loop to accumulate alternatives
+
+ while Token = Tok_Vertical_Bar loop
+ Scan; -- past vertical bar
+ Append_To
+ (Alternatives (N),
+ P_Range_Or_Subtype_Mark (Allow_Simple_Expression => True));
+ end loop;
+
+ -- Not set case
+
+ else
+ Set_Right_Opnd (N, Alt);
+ Set_Alternatives (N, No_List);
+ end if;
+ end P_Membership_Test;
+
end Ch4;
OSDN Git Service
