Mercurial > hg > CbC > CbC_gcc
diff gcc/ada/par-ch4.adb @ 145:1830386684a0
gcc-9.2.0
author | anatofuz |
---|---|
date | Thu, 13 Feb 2020 11:34:05 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line diff
--- a/gcc/ada/par-ch4.adb Thu Oct 25 07:37:49 2018 +0900 +++ b/gcc/ada/par-ch4.adb Thu Feb 13 11:34:05 2020 +0900 @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, 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- -- @@ -81,6 +81,8 @@ function P_Primary return Node_Id; function P_Relation return Node_Id; function P_Term return Node_Id; + function P_Reduction_Attribute_Reference (S : Node_Id) + return Node_Id; function P_Binary_Adding_Operator return Node_Kind; function P_Logical_Operator return Node_Kind; @@ -1202,12 +1204,48 @@ return Attr_Node; end P_Range_Attribute_Reference; + ------------------------------------- + -- P_Reduction_Attribute_Reference -- + ------------------------------------- + + function P_Reduction_Attribute_Reference (S : Node_Id) + return Node_Id + is + Attr_Node : Node_Id; + Attr_Name : Name_Id; + + begin + Attr_Name := Token_Name; + Scan; -- past Reduce + Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr); + Set_Attribute_Name (Attr_Node, Attr_Name); + if Attr_Name /= Name_Reduce then + Error_Msg ("reduce attribute expected", Prev_Token_Ptr); + end if; + + Set_Prefix (Attr_Node, S); + Set_Expressions (Attr_Node, New_List); + T_Left_Paren; + Append (P_Name, Expressions (Attr_Node)); + T_Comma; + Append (P_Expression, Expressions (Attr_Node)); + T_Right_Paren; + + return Attr_Node; + end P_Reduction_Attribute_Reference; + --------------------------------------- -- 4.1.4 Range Attribute Designator -- --------------------------------------- -- Parsed by P_Range_Attribute_Reference (4.4) + --------------------------------------------- + -- 4.1.4 (2) Reduction_Attribute_Reference -- + --------------------------------------------- + + -- parsed by P_Reduction_Attribute_Reference + -------------------- -- 4.3 Aggregate -- -------------------- @@ -1229,6 +1267,7 @@ if Nkind (Aggr_Node) /= N_Aggregate and then Nkind (Aggr_Node) /= N_Extension_Aggregate + and then Ada_Version < Ada_2020 then Error_Msg ("aggregate may not have single positional component", Aggr_Sloc); @@ -1343,7 +1382,21 @@ begin Lparen_Sloc := Token_Ptr; - T_Left_Paren; + if Token = Tok_Left_Bracket and then Ada_Version >= Ada_2020 then + Scan; + + -- Special case for null aggregate in Ada2020. + + if Token = Tok_Right_Bracket then + Scan; -- past ] + Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc); + Set_Expressions (Aggregate_Node, New_List); + Set_Is_Homogeneous_Aggregate (Aggregate_Node); + return Aggregate_Node; + end if; + else + T_Left_Paren; + end if; -- Note on parentheses count. For cases like an if expression, the -- parens here really count as real parentheses for the paren count, @@ -1577,6 +1630,14 @@ Append (Expr_Node, Expr_List); + elsif Token = Tok_Right_Bracket then + if No (Expr_List) then + Expr_List := New_List; + end if; + + Append (Expr_Node, Expr_List); + exit; + -- Anything else is assumed to be a named association else @@ -1625,7 +1686,19 @@ -- All component associations (positional and named) have been scanned - T_Right_Paren; + if Token = Tok_Right_Bracket and then Ada_Version >= Ada_2020 then + Set_Component_Associations (Aggregate_Node, Assoc_List); + Set_Is_Homogeneous_Aggregate (Aggregate_Node); + Scan; -- past right bracket + if Token = Tok_Apostrophe then + Scan; + if Token = Tok_Identifier then + return P_Reduction_Attribute_Reference (Aggregate_Node); + end if; + end if; + else + T_Right_Paren; + end if; if Nkind (Aggregate_Node) /= N_Delta_Aggregate then Set_Expressions (Aggregate_Node, Expr_List); @@ -1884,7 +1957,7 @@ -- called in all contexts where a right parenthesis cannot legitimately -- follow an expression. - -- Error recovery: can not raise Error_Resync + -- Error recovery: cannot raise Error_Resync function P_Expression_No_Right_Paren return Node_Id is Expr : constant Node_Id := P_Expression; @@ -2262,7 +2335,7 @@ -- capacity-exceeded error. The purpose of this trick is to avoid -- creating a deeply nested tree, which would cause deep recursion -- during semantics, causing stack overflow. This way, we can handle - -- enormous concatenations in the normal case of predefined "&". We + -- enormous concatenations in the normal case of predefined "&". We -- first build up the normal tree, and then rewrite it if -- appropriate. @@ -2623,6 +2696,7 @@ -- | STRING_LITERAL | AGGREGATE -- | NAME | QUALIFIED_EXPRESSION -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION + -- | REDUCTION_ATTRIBUTE_REFERENCE -- Error recovery: can raise Error_Resync @@ -2715,6 +2789,9 @@ return Expr; end; + when Tok_Left_Bracket => + return P_Aggregate; + -- Allocator when Tok_New => @@ -2850,7 +2927,7 @@ when Tok_At_Sign => -- AI12-0125 : target_name if Ada_Version < Ada_2020 then - Error_Msg_SC ("target name is an Ada 2020 extension"); + Error_Msg_SC ("target name is an Ada 202x feature"); Error_Msg_SC ("\compile with -gnatX"); end if; @@ -3325,7 +3402,7 @@ Set_Expression (Assoc_Node, P_Expression); if Ada_Version < Ada_2020 then - Error_Msg_SC ("iterated component is an Ada 2020 extension"); + Error_Msg_SC ("iterated component is an Ada 202x feature"); Error_Msg_SC ("\compile with -gnatX"); end if;