exp_util.adb (Insert_Actions): Handle Iterated_Component_Association.

2017-01-13  Ed Schonberg  <schonberg@adacore.com>

	* 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

gcc/ada/ChangeLog

+2017-01-13  Ed Schonberg  <schonberg@adacore.com>
+
+	* 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  <squirek@adacore.com>
 
 	* sem_ch12.adb (Analyze_Package_Instantiation): Move disabiling

gcc/ada/exp_util.adb

@@ -5715,8 +5715,9 @@ 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 =>
+            when N_Component_Association
+               | N_Iterated_Component_Association
+            =>
                if Nkind (Parent (P)) = N_Aggregate
                  and then Present (Loop_Actions (P))
                then
@@ -5730,8 +5731,8 @@ package body Exp_Util is
 
                      begin
                         --  Check whether these actions were generated by a
-                           --  declaration that is part of the loop_ actions
-                           --  for the component_association.
+                        --  declaration that is part of the loop_ actions for
+                        --  the component_association.
 
                         Decl := Assoc_Node;
                         while Present (Decl) loop

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

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
-
+      <<Aggregate>>
       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,6 +2749,11 @@ package body Ch4 is
                   return Error;
 
                elsif Ada_Version >= Ada_2012 then
+                  Save_Scan_State (Scan_State);
+                  Scan;   --  past FOR
+
+                  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
@@ -2725,6 +2761,10 @@ package body Ch4 is
                           ("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;
+      Scan_State : Saved_Scan_State;
 
    begin
       --  Case expression
@@ -3376,9 +3446,15 @@ 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
+
+         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
@@ -3386,6 +3462,14 @@ package body Ch4 is
                  ("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)
 
       else

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                |

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;
 

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

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)

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));