Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/par-ch4.adb @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- P A R . C H 4 -- 5 -- P A R . C H 4 --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- -- 12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- 13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
79 function P_Record_Or_Array_Component_Association return Node_Id; 79 function P_Record_Or_Array_Component_Association return Node_Id;
80 function P_Factor return Node_Id; 80 function P_Factor return Node_Id;
81 function P_Primary return Node_Id; 81 function P_Primary return Node_Id;
82 function P_Relation return Node_Id; 82 function P_Relation return Node_Id;
83 function P_Term return Node_Id; 83 function P_Term return Node_Id;
84 function P_Reduction_Attribute_Reference (S : Node_Id)
85 return Node_Id;
84 86
85 function P_Binary_Adding_Operator return Node_Kind; 87 function P_Binary_Adding_Operator return Node_Kind;
86 function P_Logical_Operator return Node_Kind; 88 function P_Logical_Operator return Node_Kind;
87 function P_Multiplying_Operator return Node_Kind; 89 function P_Multiplying_Operator return Node_Kind;
88 function P_Relational_Operator return Node_Kind; 90 function P_Relational_Operator return Node_Kind;
1200 end if; 1202 end if;
1201 1203
1202 return Attr_Node; 1204 return Attr_Node;
1203 end P_Range_Attribute_Reference; 1205 end P_Range_Attribute_Reference;
1204 1206
1207 -------------------------------------
1208 -- P_Reduction_Attribute_Reference --
1209 -------------------------------------
1210
1211 function P_Reduction_Attribute_Reference (S : Node_Id)
1212 return Node_Id
1213 is
1214 Attr_Node : Node_Id;
1215 Attr_Name : Name_Id;
1216
1217 begin
1218 Attr_Name := Token_Name;
1219 Scan; -- past Reduce
1220 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1221 Set_Attribute_Name (Attr_Node, Attr_Name);
1222 if Attr_Name /= Name_Reduce then
1223 Error_Msg ("reduce attribute expected", Prev_Token_Ptr);
1224 end if;
1225
1226 Set_Prefix (Attr_Node, S);
1227 Set_Expressions (Attr_Node, New_List);
1228 T_Left_Paren;
1229 Append (P_Name, Expressions (Attr_Node));
1230 T_Comma;
1231 Append (P_Expression, Expressions (Attr_Node));
1232 T_Right_Paren;
1233
1234 return Attr_Node;
1235 end P_Reduction_Attribute_Reference;
1236
1205 --------------------------------------- 1237 ---------------------------------------
1206 -- 4.1.4 Range Attribute Designator -- 1238 -- 4.1.4 Range Attribute Designator --
1207 --------------------------------------- 1239 ---------------------------------------
1208 1240
1209 -- Parsed by P_Range_Attribute_Reference (4.4) 1241 -- Parsed by P_Range_Attribute_Reference (4.4)
1242
1243 ---------------------------------------------
1244 -- 4.1.4 (2) Reduction_Attribute_Reference --
1245 ---------------------------------------------
1246
1247 -- parsed by P_Reduction_Attribute_Reference
1210 1248
1211 -------------------- 1249 --------------------
1212 -- 4.3 Aggregate -- 1250 -- 4.3 Aggregate --
1213 -------------------- 1251 --------------------
1214 1252
1227 1265
1228 begin 1266 begin
1229 if Nkind (Aggr_Node) /= N_Aggregate 1267 if Nkind (Aggr_Node) /= N_Aggregate
1230 and then 1268 and then
1231 Nkind (Aggr_Node) /= N_Extension_Aggregate 1269 Nkind (Aggr_Node) /= N_Extension_Aggregate
1270 and then Ada_Version < Ada_2020
1232 then 1271 then
1233 Error_Msg 1272 Error_Msg
1234 ("aggregate may not have single positional component", Aggr_Sloc); 1273 ("aggregate may not have single positional component", Aggr_Sloc);
1235 return Error; 1274 return Error;
1236 else 1275 else
1341 1380
1342 -- Start of processing for P_Aggregate_Or_Paren_Expr 1381 -- Start of processing for P_Aggregate_Or_Paren_Expr
1343 1382
1344 begin 1383 begin
1345 Lparen_Sloc := Token_Ptr; 1384 Lparen_Sloc := Token_Ptr;
1346 T_Left_Paren; 1385 if Token = Tok_Left_Bracket and then Ada_Version >= Ada_2020 then
1386 Scan;
1387
1388 -- Special case for null aggregate in Ada2020.
1389
1390 if Token = Tok_Right_Bracket then
1391 Scan; -- past ]
1392 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1393 Set_Expressions (Aggregate_Node, New_List);
1394 Set_Is_Homogeneous_Aggregate (Aggregate_Node);
1395 return Aggregate_Node;
1396 end if;
1397 else
1398 T_Left_Paren;
1399 end if;
1347 1400
1348 -- Note on parentheses count. For cases like an if expression, the 1401 -- Note on parentheses count. For cases like an if expression, the
1349 -- parens here really count as real parentheses for the paren count, 1402 -- parens here really count as real parentheses for the paren count,
1350 -- so we adjust the paren count accordingly after scanning the expr. 1403 -- so we adjust the paren count accordingly after scanning the expr.
1351 1404
1575 Expr_List := New_List; 1628 Expr_List := New_List;
1576 end if; 1629 end if;
1577 1630
1578 Append (Expr_Node, Expr_List); 1631 Append (Expr_Node, Expr_List);
1579 1632
1633 elsif Token = Tok_Right_Bracket then
1634 if No (Expr_List) then
1635 Expr_List := New_List;
1636 end if;
1637
1638 Append (Expr_Node, Expr_List);
1639 exit;
1640
1580 -- Anything else is assumed to be a named association 1641 -- Anything else is assumed to be a named association
1581 1642
1582 else 1643 else
1583 Restore_Scan_State (Scan_State); -- to start of expression 1644 Restore_Scan_State (Scan_State); -- to start of expression
1584 1645
1623 end if; 1684 end if;
1624 end loop; 1685 end loop;
1625 1686
1626 -- All component associations (positional and named) have been scanned 1687 -- All component associations (positional and named) have been scanned
1627 1688
1628 T_Right_Paren; 1689 if Token = Tok_Right_Bracket and then Ada_Version >= Ada_2020 then
1690 Set_Component_Associations (Aggregate_Node, Assoc_List);
1691 Set_Is_Homogeneous_Aggregate (Aggregate_Node);
1692 Scan; -- past right bracket
1693 if Token = Tok_Apostrophe then
1694 Scan;
1695 if Token = Tok_Identifier then
1696 return P_Reduction_Attribute_Reference (Aggregate_Node);
1697 end if;
1698 end if;
1699 else
1700 T_Right_Paren;
1701 end if;
1629 1702
1630 if Nkind (Aggregate_Node) /= N_Delta_Aggregate then 1703 if Nkind (Aggregate_Node) /= N_Delta_Aggregate then
1631 Set_Expressions (Aggregate_Node, Expr_List); 1704 Set_Expressions (Aggregate_Node, Expr_List);
1632 end if; 1705 end if;
1633 1706
1882 -- This function is identical to the normal P_Expression, except that it 1955 -- This function is identical to the normal P_Expression, except that it
1883 -- checks that the expression scan did not stop on a right paren. It is 1956 -- checks that the expression scan did not stop on a right paren. It is
1884 -- called in all contexts where a right parenthesis cannot legitimately 1957 -- called in all contexts where a right parenthesis cannot legitimately
1885 -- follow an expression. 1958 -- follow an expression.
1886 1959
1887 -- Error recovery: can not raise Error_Resync 1960 -- Error recovery: cannot raise Error_Resync
1888 1961
1889 function P_Expression_No_Right_Paren return Node_Id is 1962 function P_Expression_No_Right_Paren return Node_Id is
1890 Expr : constant Node_Id := P_Expression; 1963 Expr : constant Node_Id := P_Expression;
1891 begin 1964 begin
1892 Ignore (Tok_Right_Paren); 1965 Ignore (Tok_Right_Paren);
2260 -- resolves the "&" to a predefined one, then this folding gives the 2333 -- resolves the "&" to a predefined one, then this folding gives the
2261 -- right answer. Otherwise, semantic analysis will complain about a 2334 -- right answer. Otherwise, semantic analysis will complain about a
2262 -- capacity-exceeded error. The purpose of this trick is to avoid 2335 -- capacity-exceeded error. The purpose of this trick is to avoid
2263 -- creating a deeply nested tree, which would cause deep recursion 2336 -- creating a deeply nested tree, which would cause deep recursion
2264 -- during semantics, causing stack overflow. This way, we can handle 2337 -- during semantics, causing stack overflow. This way, we can handle
2265 -- enormous concatenations in the normal case of predefined "&". We 2338 -- enormous concatenations in the normal case of predefined "&". We
2266 -- first build up the normal tree, and then rewrite it if 2339 -- first build up the normal tree, and then rewrite it if
2267 -- appropriate. 2340 -- appropriate.
2268 2341
2269 declare 2342 declare
2270 Num_Concats_Threshold : constant Positive := 1000; 2343 Num_Concats_Threshold : constant Positive := 1000;
2621 -- PRIMARY ::= 2694 -- PRIMARY ::=
2622 -- NUMERIC_LITERAL | null 2695 -- NUMERIC_LITERAL | null
2623 -- | STRING_LITERAL | AGGREGATE 2696 -- | STRING_LITERAL | AGGREGATE
2624 -- | NAME | QUALIFIED_EXPRESSION 2697 -- | NAME | QUALIFIED_EXPRESSION
2625 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION 2698 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2699 -- | REDUCTION_ATTRIBUTE_REFERENCE
2626 2700
2627 -- Error recovery: can raise Error_Resync 2701 -- Error recovery: can raise Error_Resync
2628 2702
2629 function P_Primary return Node_Id is 2703 function P_Primary return Node_Id is
2630 Scan_State : Saved_Scan_State; 2704 Scan_State : Saved_Scan_State;
2712 Bad_Range_Attribute (Sloc (Expr)); 2786 Bad_Range_Attribute (Sloc (Expr));
2713 end if; 2787 end if;
2714 2788
2715 return Expr; 2789 return Expr;
2716 end; 2790 end;
2791
2792 when Tok_Left_Bracket =>
2793 return P_Aggregate;
2717 2794
2718 -- Allocator 2795 -- Allocator
2719 2796
2720 when Tok_New => 2797 when Tok_New =>
2721 return P_Allocator; 2798 return P_Allocator;
2848 Error_Msg_SC ("parentheses required for unary minus"); 2925 Error_Msg_SC ("parentheses required for unary minus");
2849 Scan; -- past minus 2926 Scan; -- past minus
2850 2927
2851 when Tok_At_Sign => -- AI12-0125 : target_name 2928 when Tok_At_Sign => -- AI12-0125 : target_name
2852 if Ada_Version < Ada_2020 then 2929 if Ada_Version < Ada_2020 then
2853 Error_Msg_SC ("target name is an Ada 2020 extension"); 2930 Error_Msg_SC ("target name is an Ada 202x feature");
2854 Error_Msg_SC ("\compile with -gnatX"); 2931 Error_Msg_SC ("\compile with -gnatX");
2855 end if; 2932 end if;
2856 2933
2857 Node1 := P_Name; 2934 Node1 := P_Name;
2858 return Node1; 2935 return Node1;
3323 Set_Discrete_Choices (Assoc_Node, P_Discrete_Choice_List); 3400 Set_Discrete_Choices (Assoc_Node, P_Discrete_Choice_List);
3324 TF_Arrow; 3401 TF_Arrow;
3325 Set_Expression (Assoc_Node, P_Expression); 3402 Set_Expression (Assoc_Node, P_Expression);
3326 3403
3327 if Ada_Version < Ada_2020 then 3404 if Ada_Version < Ada_2020 then
3328 Error_Msg_SC ("iterated component is an Ada 2020 extension"); 3405 Error_Msg_SC ("iterated component is an Ada 202x feature");
3329 Error_Msg_SC ("\compile with -gnatX"); 3406 Error_Msg_SC ("\compile with -gnatX");
3330 end if; 3407 end if;
3331 3408
3332 return Assoc_Node; 3409 return Assoc_Node;
3333 end P_Iterated_Component_Association; 3410 end P_Iterated_Component_Association;