[multiple changes]

2017-01-13  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch13.adb: Minor reformatting and typo fix.

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

	* par-ch4.adb (P_Aggregate_Or_Parent_Expr): An
	Iterated_Component_Association is a named association in an
	array aggregate.
	* sem_aggr.adb (Resolve_Iterated_Component_Association): New
	procedure, subsidiary of Resolve_Array_Aggregate, to analyze
	and resolve the discrete choices and the expression of the
	new construct.
	* sinfo.adb, sinfo.ads: In analogy with N_Component_Association,
	Loop_Actions and Box_Present are attributes of
	N_Iterated_Component_Association nodes. Box_Present is always
	False in this case.
	* sprint.adb (Sprint_Node): An Iterated_Component_Association
	has a Discrete_Choices list, as specified in the RM. A
	Component_Association for aggregate uses instead a Choices list.
	We have to live with this small inconsistency because the new
	construct also has a defining identifier, and there is no way
	to merge the two node structures.

From-SVN: r244410

gcc/ada/ChangeLog

+2017-01-13  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_ch13.adb: Minor reformatting and typo fix.
+
+2017-01-13  Ed Schonberg  <schonberg@adacore.com>
+
+	* par-ch4.adb (P_Aggregate_Or_Parent_Expr): An
+	Iterated_Component_Association is a named association in an
+	array aggregate.
+	* sem_aggr.adb (Resolve_Iterated_Component_Association): New
+	procedure, subsidiary of Resolve_Array_Aggregate, to analyze
+	and resolve the discrete choices and the expression of the
+	new construct.
+	* sinfo.adb, sinfo.ads: In analogy with N_Component_Association,
+	Loop_Actions and Box_Present are attributes of
+	N_Iterated_Component_Association nodes. Box_Present is always
+	False in this case.
+	* sprint.adb (Sprint_Node): An Iterated_Component_Association
+	has a Discrete_Choices list, as specified in the RM. A
+	Component_Association for aggregate uses instead a Choices list.
+	We have to live with this small inconsistency because the new
+	construct also has a defining identifier, and there is no way
+	to merge the two node structures.
+
 2017-01-13  Yannick Moy  <moy@adacore.com>
 
 	* inline.adb (Remove_Aspects_And_Pragmas): Add Unused to the

gcc/ada/par-ch4.adb

@@ -1490,7 +1490,14 @@ package body Ch4 is
          --  Assume positional case if comma, right paren, or literal or
          --  identifier or OTHERS follows (the latter cases are missing
          --  comma cases). Also assume positional if a semicolon follows,
-         --  which can happen if there are missing parens
+         --  which can happen if there are missing parens.
+
+         elsif Nkind (Expr_Node) = N_Iterated_Component_Association then
+            if No (Assoc_List) then
+               Assoc_List := New_List (Expr_Node);
+            else
+               Append_To (Assoc_List, Expr_Node);
+            end if;
 
          elsif Token = Tok_Comma
            or else Token = Tok_Right_Paren
@@ -1500,8 +1507,8 @@ package body Ch4 is
          then
             if Present (Assoc_List) then
                Error_Msg_BC -- CODEFIX
-                  ("""='>"" expected (positional association cannot follow " &
-                   "named association)");
+                 ("""='>"" expected (positional association cannot follow "
+                  & "named association)");
             end if;
 
             if No (Expr_List) then

gcc/ada/sem_aggr.adb

@@ -1180,6 +1180,11 @@ package body Sem_Aggr is
       Index_Base_High : constant Node_Id   := Type_High_Bound (Index_Base);
       --  Ditto for the base type
 
+      Others_Present : Boolean := False;
+
+      Nb_Choices : Nat := 0;
+      --  Contains the overall number of named choices in this sub-aggregate
+
       function Add (Val : Uint; To : Node_Id) return Node_Id;
       --  Creates a new expression node where Val is added to expression To.
       --  Tries to constant fold whenever possible. To must be an already
@@ -1202,6 +1207,10 @@ package body Sem_Aggr is
       function Dynamic_Or_Null_Range (L, H : Node_Id) return Boolean;
       --  Returns True if range L .. H is dynamic or null
 
+      function Choice_List (N : Node_Id) return List_Id;
+      --  Utility to retrieve the choices of a Component_Association or the
+      --  Discrete_Choices of an Iterated_Component_Association.
+
       procedure Get (Value : out Uint; From : Node_Id; OK : out Boolean);
       --  Given expression node From, this routine sets OK to False if it
       --  cannot statically evaluate From. Otherwise it stores this static
@@ -1221,6 +1230,11 @@ package body Sem_Aggr is
       --  N_Component_Association node as Expr, since there is no Expression in
       --  that case, and we need a Sloc for the error message.
 
+      procedure Resolve_Iterated_Component_Association
+        (N         : Node_Id;
+         Index_Typ : Entity_Id);
+      --  For AI12-061
+
       ---------
       -- Add --
       ---------
@@ -1459,6 +1473,19 @@ package body Sem_Aggr is
            or else Val_L > Val_H;
       end Dynamic_Or_Null_Range;
 
+      -----------------
+      -- Choice_List --
+      -----------------
+
+      function Choice_List (N : Node_Id) return List_Id is
+      begin
+         if Nkind (N) = N_Iterated_Component_Association then
+            return Discrete_Choices (N);
+         else
+            return Choices (N);
+         end if;
+      end Choice_List;
+
       ---------
       -- Get --
       ---------
@@ -1626,38 +1653,83 @@ package body Sem_Aggr is
          return Resolution_OK;
       end Resolve_Aggr_Expr;
 
-      --  Variables local to Resolve_Array_Aggregate
+      --------------------------------------------
+      -- Resolve_Iterated_Component_Association --
+      --------------------------------------------
+
+      procedure Resolve_Iterated_Component_Association
+        (N         : Node_Id;
+         Index_Typ : Entity_Id)
+      is
+         Id  : constant Entity_Id  := Defining_Identifier (N);
+         Loc : constant Source_Ptr := Sloc (N);
+
+         Choice : Node_Id;
+         Dummy  : Boolean;
+         Ent    : Entity_Id;
+
+      begin
+         Choice := First (Discrete_Choices (N));
+
+         while Present (Choice) loop
+            if Nkind (Choice) = N_Others_Choice then
+               Error_Msg_N ("others choice not allowed in this context", N);
+               Others_Present := True;
+
+            else
+               Analyze_And_Resolve (Choice, Index_Typ);
+            end if;
+
+            Nb_Choices := Nb_Choices + 1;
+            Next (Choice);
+         end loop;
+
+         --  Create a scope in which to introduce an index, which is usually
+         --  visible in the expression for the component.
+
+         Ent := New_Internal_Entity (E_Loop, Current_Scope, Loc, 'L');
+         Set_Etype  (Ent, Standard_Void_Type);
+         Set_Parent (Ent, Parent (N));
+
+         Enter_Name (Id);
+         Set_Etype (Id, Index_Typ);
+         Set_Ekind (Id, E_Variable);
+         Set_Scope (Id, Ent);
+
+         Push_Scope (Ent);
+         Dummy := Resolve_Aggr_Expr (Expression (N), False);
+         End_Scope;
+      end Resolve_Iterated_Component_Association;
+
+      --  Local variables
 
       Assoc   : Node_Id;
       Choice  : Node_Id;
       Expr    : Node_Id;
       Discard : Node_Id;
 
-      Delete_Choice : Boolean;
-      --  Used when replacing a subtype choice with predicate by a list
+      Iterated_Component_Present : Boolean := False;
 
       Aggr_Low  : Node_Id := Empty;
       Aggr_High : Node_Id := Empty;
       --  The actual low and high bounds of this sub-aggregate
 
+      Case_Table_Size : Nat;
+      --  Contains the size of the case table needed to sort aggregate choices
+
       Choices_Low  : Node_Id := Empty;
       Choices_High : Node_Id := Empty;
       --  The lowest and highest discrete choices values for a named aggregate
 
+      Delete_Choice : Boolean;
+      --  Used when replacing a subtype choice with predicate by a list
+
       Nb_Elements : Uint := Uint_0;
       --  The number of elements in a positional aggregate
 
-      Others_Present : Boolean := False;
-
-      Nb_Choices : Nat := 0;
-      --  Contains the overall number of named choices in this sub-aggregate
-
       Nb_Discrete_Choices : Nat := 0;
       --  The overall number of discrete choices (not counting others choice)
 
-      Case_Table_Size : Nat;
-      --  Contains the size of the case table needed to sort aggregate choices
-
    --  Start of processing for Resolve_Array_Aggregate
 
    begin
@@ -1675,6 +1747,12 @@ package body Sem_Aggr is
       if Present (Component_Associations (N)) then
          Assoc := First (Component_Associations (N));
          while Present (Assoc) loop
+            if Nkind (Assoc) = N_Iterated_Component_Association then
+               Resolve_Iterated_Component_Association (Assoc, Index_Typ);
+               Iterated_Component_Present := True;
+               goto Next_Assoc;
+            end if;
+
             Choice := First (Choices (Assoc));
             Delete_Choice := False;
             while Present (Choice) loop
@@ -1766,6 +1844,7 @@ package body Sem_Aggr is
                end;
             end loop;
 
+            <<Next_Assoc>>
             Next (Assoc);
          end loop;
       end if;
@@ -1780,7 +1859,7 @@ package body Sem_Aggr is
       then
          Error_Msg_N
            ("named association cannot follow positional association",
-            First (Choices (First (Component_Associations (N)))));
+            First (Choice_List (First (Component_Associations (N)))));
          return Failure;
       end if;
 
@@ -1860,7 +1939,8 @@ package body Sem_Aggr is
             Assoc := First (Component_Associations (N));
             while Present (Assoc) loop
                Prev_Nb_Discrete_Choices := Nb_Discrete_Choices;
-               Choice := First (Choices (Assoc));
+               Choice := First (Choice_List (Assoc));
+
                loop
                   Analyze (Choice);
 
@@ -2475,11 +2555,7 @@ package body Sem_Aggr is
                Check_Can_Never_Be_Null (Etype (N), Expr);
             end if;
 
-            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
+            if not Resolve_Aggr_Expr (Expr, Single_Elmt => True) then
                return Failure;
             end if;
 
@@ -2645,6 +2721,10 @@ package body Sem_Aggr is
 
       Analyze_Dimension_Array_Aggregate (N, Component_Typ);
 
+      if Iterated_Component_Present then
+         Error_Msg_N ("iterated association not implemented yet", N);
+      end if;
+
       return Success;
    end Resolve_Array_Aggregate;
 

gcc/ada/sem_ch13.adb

@@ -8963,12 +8963,12 @@ package body Sem_Ch13 is
       --  Expression to be analyzed at end of declarations
 
       Freeze_Expr : constant Node_Id := Expression (ASN);
-      --  Expression from call to Check_Aspect_At_Freeze_Point. We use
+      --  Expression from call to Check_Aspect_At_Freeze_Point.
 
       T : constant Entity_Id := Etype (Original_Node (Freeze_Expr));
-      --  Type required for preanalyze call. We use the originsl
-      --  expression to get the proper type, to prevent cascaded errors
-      --  when the expression is constant-folded.
+      --  Type required for preanalyze call. We use the original expression to
+      --  get the proper type, to prevent cascaded errors when the expression
+      --  is constant-folded.
 
       Err : Boolean;
       --  Set False if error

gcc/ada/sinfo.adb

@@ -366,7 +366,8 @@ package body Sinfo is
         or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
         or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration
         or else NT (N).Nkind = N_Formal_Package_Declaration
-        or else NT (N).Nkind = N_Generic_Association);
+        or else NT (N).Nkind = N_Generic_Association
+        or else NT (N).Nkind = N_Iterated_Component_Association);
       return Flag15 (N);
    end Box_Present;
 
@@ -2201,7 +2202,8 @@ package body Sinfo is
       (N : Node_Id) return List_Id is
    begin
       pragma Assert (False
-        or else NT (N).Nkind = N_Component_Association);
+        or else NT (N).Nkind = N_Component_Association
+        or else NT (N).Nkind = N_Iterated_Component_Association);
       return List2 (N);
    end Loop_Actions;
 
@@ -3665,7 +3667,8 @@ package body Sinfo is
         or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
         or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration
         or else NT (N).Nkind = N_Formal_Package_Declaration
-        or else NT (N).Nkind = N_Generic_Association);
+        or else NT (N).Nkind = N_Generic_Association
+        or else NT (N).Nkind = N_Iterated_Component_Association);
       Set_Flag15 (N, Val);
    end Set_Box_Present;
 
@@ -5491,7 +5494,8 @@ package body Sinfo is
       (N : Node_Id; Val : List_Id) is
    begin
       pragma Assert (False
-        or else NT (N).Nkind = N_Component_Association);
+        or else NT (N).Nkind = N_Component_Association
+        or else NT (N).Nkind = N_Iterated_Component_Association);
       Set_List2 (N, Val); -- semantic field, no parent set
    end Set_Loop_Actions;
 

gcc/ada/sinfo.ads

@@ -4114,8 +4114,13 @@ package Sinfo is
       --  N_Iterated_Component_Association
       --  Sloc points to FOR
       --  Defining_Identifier (Node1)
+      --  Loop_Actions (List2-Sem)
       --  Expression (Node3)
       --  Discrete_Choices (List4)
+      --  Box_Present (Flag15)
+
+      --  Note that Box_Present is always False, but it is intentionally added
+      --  for completeness.
 
       --------------------------------------------------
       -- 4.4  Expression/Relation/Term/Factor/Primary --

gcc/ada/sprint.adb

@@ -1333,7 +1333,7 @@ package body Sprint is
             Write_Str (" for ");
             Write_Id (Defining_Identifier (Node));
             Write_Str (" in ");
-            Sprint_Bar_List (Choices (Node));
+            Sprint_Bar_List (Discrete_Choices (Node));
             Write_Str (" => ");
             Sprint_Node (Expression (Node));