X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fpar-ch4.adb;h=2bb9d25fcc12add6ed1152387fec4635be0e3a60;hb=2a62ce00f61d26370c9b174c98dbd2f5136082bd;hp=c164e60b61d0400d8a57ac1e2f3d5f7b5372dd1e;hpb=7f2cf564eba680b23a70b5a610426d6a993a7f4a;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index c164e60b61d..2bb9d25fcc1 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -79,14 +79,16 @@ package body Ch4 is -- 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 -- ------------------------- @@ -97,51 +99,6 @@ package body Ch4 is 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) -- -------------------------- @@ -453,7 +410,7 @@ package body Ch4 is loop Discard_Junk_Node (P_Expression_If_OK); - exit when not Comma_Present; + exit when not Comma_Present; end loop; T_Right_Paren; @@ -1386,6 +1343,19 @@ package body Ch4 is 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 @@ -1582,10 +1552,9 @@ package body Ch4 is 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; @@ -1686,10 +1655,9 @@ package body Ch4 is 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; @@ -1750,14 +1718,13 @@ package body Ch4 is -- 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 (= /= < <= > >=) @@ -1863,18 +1830,17 @@ package body Ch4 is 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; @@ -1883,14 +1849,13 @@ package body Ch4 is 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; @@ -1899,7 +1864,6 @@ package body Ch4 is Scan; -- past operator Set_Left_Opnd (Node2, Node1); Set_Right_Opnd (Node2, P_Term); - Set_Op_Name (Node2); Node1 := Node2; end loop; @@ -1913,7 +1877,7 @@ package body Ch4 is 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; @@ -1921,7 +1885,6 @@ package body Ch4 is Scan; -- past operator Set_Right_Opnd (Node1, P_Term); - Set_Op_Name (Node1); else Node1 := P_Term; end if; @@ -1963,12 +1926,11 @@ package body Ch4 is 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 @@ -2088,8 +2050,18 @@ package body Ch4 is 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; @@ -2186,11 +2158,10 @@ package body Ch4 is 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; @@ -2211,7 +2182,7 @@ package body Ch4 is 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; @@ -2219,11 +2190,10 @@ package body Ch4 is 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; @@ -2231,18 +2201,16 @@ package body Ch4 is 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; @@ -2734,4 +2702,42 @@ package body Ch4 is 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;