From: Ed Schonberg Date: Fri, 13 Jan 2017 10:11:17 +0000 (+0000) Subject: exp_util.adb (Insert_Actions): Handle Iterated_Component_Association. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a702c9b9eec3cf67dc205462c9d7ba5b6d62cdc8;p=gcc.git exp_util.adb (Insert_Actions): Handle Iterated_Component_Association. 2017-01-13 Ed Schonberg * exp_util.adb (Insert_Actions): Handle Iterated_Component_Association. * par-ch3.adb (P_Discrete_Choice_List): An Iterated_Component_Association is an array aggregate component. * par-ch4.adb (P_Iterated_Component_Association): New procedure. (Is_Quantified_Expression): New function that performs a lookahead to distinguish quantified expressions from iterated component associations. (P_Aggregate_Or_Paren_Expr): Recognize iterated component associations. (P_Unparen_Cond_Case_Quant_Expression, P_Primary): Ditto. * sem.adb (Analyze): Handle Iterated_Component_Association. * sem_aggr.adb (Resolve_Array_Aggregate): Dummy handling of iterated component associations. * sinfo.ads, sinfo.adb: Entries for for N_Iterated_Component_Association and its fields. * sprint.adb (Sprint_Node_Actual): Handle N_Iterated_Component_Association. From-SVN: r244403 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d851a51b4b7..9fe36adafe5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2017-01-13 Ed Schonberg + + * exp_util.adb (Insert_Actions): Handle Iterated_Component_Association. + * par-ch3.adb (P_Discrete_Choice_List): An + Iterated_Component_Association is an array aggregate component. + * par-ch4.adb (P_Iterated_Component_Association): New procedure. + (Is_Quantified_Expression): New function that performs a lookahead + to distinguish quantified expressions from iterated component + associations. + (P_Aggregate_Or_Paren_Expr): Recognize iterated component + associations. + (P_Unparen_Cond_Case_Quant_Expression, P_Primary): Ditto. + * sem.adb (Analyze): Handle Iterated_Component_Association. + * sem_aggr.adb (Resolve_Array_Aggregate): Dummy handling of iterated + component associations. + * sinfo.ads, sinfo.adb: Entries for for + N_Iterated_Component_Association and its fields. + * sprint.adb (Sprint_Node_Actual): Handle + N_Iterated_Component_Association. + 2017-01-13 Justin Squirek * sem_ch12.adb (Analyze_Package_Instantiation): Move disabiling diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index ea71e38fe0b..8ab95d0db5a 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -5715,49 +5715,50 @@ package body Exp_Util is -- at the end of the loop actions, to respect the order in which -- they are to be elaborated. - when - N_Component_Association => - if Nkind (Parent (P)) = N_Aggregate - and then Present (Loop_Actions (P)) - then - if Is_Empty_List (Loop_Actions (P)) then - Set_Loop_Actions (P, Ins_Actions); - Analyze_List (Ins_Actions); - - else - declare - Decl : Node_Id; - - begin - -- Check whether these actions were generated by a - -- declaration that is part of the loop_ actions - -- for the component_association. - - Decl := Assoc_Node; - while Present (Decl) loop - exit when Parent (Decl) = P - and then Is_List_Member (Decl) - and then - List_Containing (Decl) = Loop_Actions (P); - Decl := Parent (Decl); - end loop; - - if Present (Decl) then - Insert_List_Before_And_Analyze - (Decl, Ins_Actions); - else - Insert_List_After_And_Analyze - (Last (Loop_Actions (P)), Ins_Actions); - end if; - end; - end if; - - return; + when N_Component_Association + | N_Iterated_Component_Association + => + if Nkind (Parent (P)) = N_Aggregate + and then Present (Loop_Actions (P)) + then + if Is_Empty_List (Loop_Actions (P)) then + Set_Loop_Actions (P, Ins_Actions); + Analyze_List (Ins_Actions); else - null; + declare + Decl : Node_Id; + + begin + -- Check whether these actions were generated by a + -- declaration that is part of the loop_ actions for + -- the component_association. + + Decl := Assoc_Node; + while Present (Decl) loop + exit when Parent (Decl) = P + and then Is_List_Member (Decl) + and then + List_Containing (Decl) = Loop_Actions (P); + Decl := Parent (Decl); + end loop; + + if Present (Decl) then + Insert_List_Before_And_Analyze + (Decl, Ins_Actions); + else + Insert_List_After_And_Analyze + (Last (Loop_Actions (P)), Ins_Actions); + end if; + end; end if; + return; + + else + null; + end if; + -- Another special case, an attribute denoting a procedure call when diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 3863c5a56f3..b7ab2ad3534 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -3852,6 +3852,10 @@ package body Ch3 is end if; if Token = Tok_Comma then + if Nkind (Expr_Node) = N_Iterated_Component_Association then + return Choices; + end if; + Scan; -- past comma if Token = Tok_Vertical_Bar then diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index c61a76602a5..64402a598d3 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -76,6 +76,7 @@ package body Ch4 is function P_Aggregate_Or_Paren_Expr return Node_Id; function P_Allocator return Node_Id; function P_Case_Expression_Alternative return Node_Id; + function P_Iterated_Component_Association return Node_Id; function P_Record_Or_Array_Component_Association return Node_Id; function P_Factor return Node_Id; function P_Primary return Node_Id; @@ -1260,6 +1261,10 @@ package body Ch4 is -- Called if <> is encountered as positional aggregate element. Issues -- error message and sets Expr_Node to Error. + function Is_Quantified_Expression return Boolean; + -- The presence of iterated component associations requires a one + -- token lookahead to distinguish it from quantified expressions. + --------------- -- Box_Error -- --------------- @@ -1281,6 +1286,22 @@ package body Ch4 is Expr_Node := Error; end Box_Error; + ------------------------------ + -- Is_Quantified_Expression -- + ------------------------------ + + function Is_Quantified_Expression return Boolean is + Maybe : Boolean; + Scan_State : Saved_Scan_State; + + begin + Save_Scan_State (Scan_State); + Scan; -- past FOR + Maybe := Token = Tok_All or else Token = Tok_Some; + Restore_Scan_State (Scan_State); -- to FOR + return Maybe; + end Is_Quantified_Expression; + -- Start of processing for P_Aggregate_Or_Paren_Expr begin @@ -1309,7 +1330,7 @@ package body Ch4 is -- Quantified expression - elsif Token = Tok_For then + elsif Token = Tok_For and then Is_Quantified_Expression then Expr_Node := P_Quantified_Expression; T_Right_Paren; Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1); @@ -1338,6 +1359,11 @@ package body Ch4 is else Restore_Scan_State (Scan_State); -- to NULL that must be expr end if; + + elsif Token = Tok_For then + Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc); + Expr_Node := P_Iterated_Component_Association; + goto Aggregate; end if; -- Scan expression, handling box appearing as positional argument @@ -1425,7 +1451,7 @@ package body Ch4 is end if; -- Prepare to scan list of component associations - + <> Expr_List := No_List; -- don't set yet, maybe all named entries Assoc_List := No_List; -- don't set yet, maybe all positional entries @@ -1515,7 +1541,7 @@ package body Ch4 is -- wrong, so let's get out now, before we start eating up stuff -- that doesn't belong to us. - if Token in Token_Class_Eterm then + if Token in Token_Class_Eterm and then Token /= Tok_For then Error_Msg_AP ("expecting expression or component association"); exit; @@ -1527,11 +1553,15 @@ package body Ch4 is Box_Error; -- Otherwise initiate for reentry to top of loop by scanning an - -- initial expression, unless the first token is OTHERS. + -- initial expression, unless the first token is OTHERS or FOR, + -- which indicates an iterated component association. elsif Token = Tok_Others then Expr_Node := Empty; + elsif Token = Tok_For then + Expr_Node := P_Iterated_Component_Association; + else Save_Scan_State (Scan_State); -- at start of expression Expr_Node := P_Expression_Or_Range_Attribute_If_OK; @@ -1562,6 +1592,7 @@ package body Ch4 is -- ARRAY_COMPONENT_ASSOCIATION ::= -- DISCRETE_CHOICE_LIST => EXPRESSION -- | DISCRETE_CHOICE_LIST => <> + -- | ITERATED_COMPONENT_ASSOCIATION -- Note: this routine only handles the named cases, including others. -- Cases where the component choice list is not present have already @@ -2718,12 +2749,21 @@ package body Ch4 is return Error; elsif Ada_Version >= Ada_2012 then - Node1 := P_Quantified_Expression; + Save_Scan_State (Scan_State); + Scan; -- past FOR - if not (Lparen and then Token = Tok_Right_Paren) then - Error_Msg - ("quantified expression must be parenthesized", - Sloc (Node1)); + if Token = Tok_All or else Token = Tok_Some then + Restore_Scan_State (Scan_State); -- To FOR + Node1 := P_Quantified_Expression; + + if not (Lparen and then Token = Tok_Right_Paren) then + Error_Msg + ("quantified expression must be parenthesized", + Sloc (Node1)); + end if; + else + Restore_Scan_State (Scan_State); -- To FOR + Node1 := P_Iterated_Component_Association; end if; return Node1; @@ -2786,7 +2826,7 @@ package body Ch4 is raise Error_Resync; end if; - Scan; -- past SOME + Scan; -- past ALL or SOME I_Spec := P_Loop_Parameter_Specification; if Nkind (I_Spec) = N_Loop_Parameter_Specification then @@ -3172,12 +3212,40 @@ package body Ch4 is return Case_Alt_Node; end P_Case_Expression_Alternative; + -------------------------------------- + -- P_Iterated_Component_Association -- + -------------------------------------- + + -- ITERATED_COMPONENT_ASSOCIATION ::= + -- for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION + + function P_Iterated_Component_Association return Node_Id is + Assoc_Node : Node_Id; + + begin + Scan; -- past FOR + Assoc_Node := + New_Node (N_Iterated_Component_Association, Prev_Token_Ptr); + Set_Defining_Identifier (Assoc_Node, P_Defining_Identifier); + T_In; + Set_Discrete_Choices (Assoc_Node, P_Discrete_Choice_List); + TF_Arrow; + Set_Expression (Assoc_Node, P_Expression); + return Assoc_Node; + end P_Iterated_Component_Association; + --------------------- -- P_If_Expression -- --------------------- - function P_If_Expression return Node_Id is + -- IF_EXPRESSION ::= + -- if CONDITION then DEPENDENT_EXPRESSION + -- {elsif CONDITION then DEPENDENT_EXPRESSION} + -- [else DEPENDENT_EXPRESSION] + + -- DEPENDENT_EXPRESSION ::= EXPRESSION + function P_If_Expression return Node_Id is function P_If_Expression_Internal (Loc : Source_Ptr; Cond : Node_Id) return Node_Id; @@ -3355,7 +3423,9 @@ package body Ch4 is function P_Unparen_Cond_Case_Quant_Expression return Node_Id is Lparen : constant Boolean := Prev_Token = Tok_Left_Paren; - Result : Node_Id; + + Result : Node_Id; + Scan_State : Saved_Scan_State; begin -- Case expression @@ -3376,14 +3446,28 @@ package body Ch4 is Error_Msg_N ("if expression must be parenthesized!", Result); end if; - -- Quantified expression + -- Quantified expression or iterated component association 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); + Save_Scan_State (Scan_State); + Scan; -- past FOR + + if Token = Tok_All or else Token = Tok_Some then + Restore_Scan_State (Scan_State); + 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; + + else + -- If no quantifier keyword, this is an iterated component in + -- an aggregate. + + Restore_Scan_State (Scan_State); + Result := P_Iterated_Component_Association; end if; -- No other possibility should exist (caller was supposed to check) diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index fc7bf7b80f5..74d77ab2490 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -698,6 +698,7 @@ package body Sem is N_Function_Specification | N_Generic_Association | N_Index_Or_Discriminant_Constraint | + N_Iterated_Component_Association | N_Iteration_Scheme | N_Mod_Clause | N_Modular_Type_Definition | diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 580d33ecce6..be2fd901940 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2475,7 +2475,11 @@ package body Sem_Aggr is Check_Can_Never_Be_Null (Etype (N), Expr); end if; - if not Resolve_Aggr_Expr (Expr, Single_Elmt => True) then + if Nkind (Expr) = N_Iterated_Component_Association then + Error_Msg_N ("iterated association not implemented yet", Expr); + return Failure; + + elsif not Resolve_Aggr_Expr (Expr, Single_Elmt => True) then return Failure; end if; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 2ded5b82759..dbe51ec33c6 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -790,6 +790,7 @@ package body Sinfo is or else NT (N).Nkind = N_Full_Type_Declaration or else NT (N).Nkind = N_Implicit_Label_Declaration or else NT (N).Nkind = N_Incomplete_Type_Declaration + or else NT (N).Nkind = N_Iterated_Component_Association or else NT (N).Nkind = N_Iterator_Specification or else NT (N).Nkind = N_Loop_Parameter_Specification or else NT (N).Nkind = N_Number_Declaration @@ -879,6 +880,7 @@ package body Sinfo is pragma Assert (False or else NT (N).Nkind = N_Case_Expression_Alternative or else NT (N).Nkind = N_Case_Statement_Alternative + or else NT (N).Nkind = N_Iterated_Component_Association or else NT (N).Nkind = N_Variant); return List4 (N); end Discrete_Choices; @@ -1268,6 +1270,7 @@ package body Sinfo is or else NT (N).Nkind = N_Expression_Function or else NT (N).Nkind = N_Expression_With_Actions or else NT (N).Nkind = N_Free_Statement + or else NT (N).Nkind = N_Iterated_Component_Association or else NT (N).Nkind = N_Mod_Clause or else NT (N).Nkind = N_Modular_Type_Definition or else NT (N).Nkind = N_Number_Declaration @@ -4086,6 +4089,7 @@ package body Sinfo is or else NT (N).Nkind = N_Full_Type_Declaration or else NT (N).Nkind = N_Implicit_Label_Declaration or else NT (N).Nkind = N_Incomplete_Type_Declaration + or else NT (N).Nkind = N_Iterated_Component_Association or else NT (N).Nkind = N_Iterator_Specification or else NT (N).Nkind = N_Loop_Parameter_Specification or else NT (N).Nkind = N_Number_Declaration @@ -4175,6 +4179,7 @@ package body Sinfo is pragma Assert (False or else NT (N).Nkind = N_Case_Expression_Alternative or else NT (N).Nkind = N_Case_Statement_Alternative + or else NT (N).Nkind = N_Iterated_Component_Association or else NT (N).Nkind = N_Variant); Set_List4_With_Parent (N, Val); end Set_Discrete_Choices; @@ -4555,6 +4560,7 @@ package body Sinfo is or else NT (N).Nkind = N_Expression_Function or else NT (N).Nkind = N_Expression_With_Actions or else NT (N).Nkind = N_Free_Statement + or else NT (N).Nkind = N_Iterated_Component_Association or else NT (N).Nkind = N_Mod_Clause or else NT (N).Nkind = N_Modular_Type_Definition or else NT (N).Nkind = N_Number_Declaration diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index dd1aec58036..588d02e3d16 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -4098,8 +4098,24 @@ package Sinfo is -- ARRAY_COMPONENT_ASSOCIATION ::= -- DISCRETE_CHOICE_LIST => EXPRESSION + -- | ITERATED_COMPONENT_ASSOCIATION -- See Record_Component_Association (4.3.1) for node structure + -- The iterated_component_association is introduced into the + -- Corrigendum of Ada_2012 by AI12-061. + + ------------------------------------------ + -- 4.3.3 Iterated component Association -- + ------------------------------------------ + + -- ITERATED_COMPONENT_ASSOCIATION ::= + -- for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION + + -- N_Iterated_Component_Association + -- Sloc points to FOR + -- Defining_Identifier (Node1) + -- Expression (Node3) + -- Discrete_Choices (List4) -------------------------------------------------- -- 4.4 Expression/Relation/Term/Factor/Primary -- @@ -8645,6 +8661,7 @@ package Sinfo is N_Generic_Association, N_Handled_Sequence_Of_Statements, N_Index_Or_Discriminant_Constraint, + N_Iterated_Component_Association, N_Itype_Reference, N_Label, N_Modular_Type_Definition, @@ -11463,6 +11480,13 @@ package Sinfo is 4 => False, -- unused 5 => False), -- unused + N_Iterated_Component_Association => + (1 => True, -- Defining_Identifier (Node1) + 2 => False, -- unused + 3 => True, -- Expression (Node3) + 4 => True, -- Discrete_Choices (List4) + 5 => False), -- unused + N_Extension_Aggregate => (1 => True, -- Expressions (List1) 2 => True, -- Component_Associations (List2) diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 1e82a1f024f..bf85f016516 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -1328,6 +1328,15 @@ package body Sprint is Sprint_Node (Expression (Node)); end if; + when N_Iterated_Component_Association => + Set_Debug_Sloc; + Write_Str (" for "); + Write_Id (Defining_Identifier (Node)); + Write_Str (" in "); + Sprint_Bar_List (Choices (Node)); + Write_Str (" => "); + Sprint_Node (Expression (Node)); + when N_Component_Clause => Write_Indent; Sprint_Node (Component_Name (Node));