ada: Fix internal error on nested iterated component associations

The problem is that Insert_Actions gets confused as to where it should
insert actions coming from within an N_Iterated_Component_Association,
because some actions may be generated during semantic analysis and some
others during expansion.

Instead of another ad-hoc fix, this change extends the processing done
for N_Component_Association, that is to say waiting for the Loop_Actions
field to be set during expansion before inserting actions in there.

This in turn requires semantic analysis to stop generating actions for
N_Iterated_Component_Association nodes.  The current processing is a
little unstable:
  - for container aggregates, Resolve_Iterated_Association preanalyzes
    a copy of the expression,
  - for delta aggregates, Resolve_Delta_Array_Aggregate fully analyzes
    a copy of the expression,
  - for array aggregate, Resolve_Aggr_Expr entirely skips the analysis.

The change implements a preanalysis of a copy of the expression using
Copy_Separate_Tree, which should be sufficient since the expression is
supposed to be unanalyzed at this point, recursively in the context of
N_Iterated_Component_Association nodes.

gcc/ada/ChangeLog:

	PR ada/117018
	* exp_aggr.adb (Build_Array_Aggr_Code): Do not expect the
	Loop_Actions field to be already present on association nodes.
	* exp_util.adb (Insert_Actions): For association nodes, insert
	into the Loop_Actions field only if it is already present.
	* sem_aggr.adb (Resolve_Array_Aggregate): Add Iterated parameter.
	(Resolve_Aggregate): Adjust calls to Resolve_Array_Aggregate.
	(Resolve_Aggr_Expr): Add Iterated_Elmt defaulted parameter and
	a default for Single_Elmt.  Adjust call to Resolve_Array_Aggregate.
	Preanalyze a copy of the expression in an iteration context.
	(Resolve_Iterated_Component_Association): Pass Iterated_Elmt as
	True to Resolve_Aggr_Expr and remove processing of Loop_Actions.
	Do not check incorrect use of dynamically tagged expression in
	an iteration context.
	(Resolve_Iterated_Association): Use Copy_Separate_Tree instead of
	New_Copy_Tree and set the Parent field of the result.
	(Resolve_Delta_Array_Aggregate): Likewise.  Only preanalyze the
	copy instead of analyzing it.

3 files changed, 91 insertions, 77 deletions

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index f4844b7..ed50d94 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -1973,30 +1973,35 @@ package body Exp_Aggr is
 
          Assoc := First (Component_Associations (N));
          while Present (Assoc) loop
-            Choice := First (Choice_List (Assoc));
-            while Present (Choice) loop
-               if Nkind (Choice) = N_Others_Choice then
-                  Others_Assoc := Assoc;
-                  exit;
-               end if;
+            declare
+               First_Range : Boolean := True;
 
-               Bounds := Get_Index_Bounds (Choice);
+            begin
+               Choice := First (Choice_List (Assoc));
+               while Present (Choice) loop
+                  if Nkind (Choice) = N_Others_Choice then
+                     Others_Assoc := Assoc;
+                     exit;
+                  end if;
 
-               if Low /= High
-                 and then No (Loop_Actions (Assoc))
-               then
-                  Set_Loop_Actions (Assoc, New_List);
-               end if;
+                  Bounds := Get_Index_Bounds (Choice);
 
-               Nb_Choices := Nb_Choices + 1;
+                  if First_Range and then Low /= High then
+                     pragma Assert (No (Loop_Actions (Assoc)));
+                     Set_Loop_Actions (Assoc, New_List);
+                     First_Range := False;
+                  end if;
 
-               Table (Nb_Choices) :=
-                  (Choice_Lo   => Low,
-                   Choice_Hi   => High,
-                   Choice_Node => Get_Assoc_Expr (Assoc));
+                  Nb_Choices := Nb_Choices + 1;
 
-               Next (Choice);
-            end loop;
+                  Table (Nb_Choices) :=
+                     (Choice_Lo   => Low,
+                      Choice_Hi   => High,
+                      Choice_Node => Get_Assoc_Expr (Assoc));
+
+                  Next (Choice);
+               end loop;
+            end;
 
             Next (Assoc);
          end loop;
@@ -2059,12 +2064,10 @@ package body Exp_Aggr is
                   end if;
 
                   if First or else not Empty_Range (Low, High) then
-                     First := False;
-                     if Present (Loop_Actions (Others_Assoc)) then
-                        pragma Assert
-                          (Is_Empty_List (Loop_Actions (Others_Assoc)));
-                     else
+                     if First then
+                        pragma Assert (No (Loop_Actions (Others_Assoc)));
                         Set_Loop_Actions (Others_Assoc, New_List);
+                        First := False;
                      end if;
                      Expr := Get_Assoc_Expr (Others_Assoc);
                      Append_List (Gen_Loop (Low, High, Expr), To => New_Code);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index b400505..666c9ba 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8116,9 +8116,9 @@ package body Exp_Util is
             --  If a component association appears within a loop created for
             --  an array aggregate, attach the actions to the association so
             --  they can be subsequently inserted within the loop. For other
-            --  component associations insert outside of the aggregate. For
+            --  component associations, insert outside of the aggregate. For
             --  an association that will generate a loop, its Loop_Actions
-            --  attribute is already initialized (see exp_aggr.adb).
+            --  field is already initialized (see exp_aggr.adb).
 
             --  The list of Loop_Actions can in turn generate additional ones,
             --  that are inserted before the associated node. If the associated
@@ -8131,27 +8131,12 @@ package body Exp_Util is
                | N_Iterated_Element_Association
             =>
                if Nkind (Parent (P)) in N_Aggregate | N_Delta_Aggregate
-
-                 --  We must not climb up out of an N_Iterated_xxx_Association
-                 --  because the actions might contain references to the loop
-                 --  parameter, except if we come from the Discrete_Choices of
-                 --  N_Iterated_Component_Association which cannot contain any.
-                 --  But it turns out that setting the Loop_Actions field in
-                 --  the case of an N_Component_Association when the field was
-                 --  not already set can lead to gigi assertion failures that
-                 --  are presumably due to malformed trees, so don't do that.
-
-                 and then
-                   not (Nkind (P) = N_Iterated_Component_Association
-                          and then Is_List_Member (N)
-                          and then List_Containing (N) = Discrete_Choices (P))
-                 and then
-                   not (Nkind (P) = N_Component_Association
-                          and then No (Loop_Actions (P)))
+                 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;
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index b05b0b2..0faca28 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -253,6 +253,7 @@ package body Sem_Aggr is
       Index          : Node_Id;
       Index_Constr   : Node_Id;
       Component_Typ  : Entity_Id;
+      Iterated       : Boolean;
       Others_Allowed : Boolean) return Boolean;
    --  This procedure performs the semantic checks for an array aggregate.
    --  True is returned if the aggregate resolution succeeds.
@@ -278,6 +279,9 @@ package body Sem_Aggr is
    --
    --    Component_Typ is the array component type.
    --
+   --    Iterated indicates whether the aggregate appears in the context of an
+   --    iterated association for a parent aggregate.
+   --
    --    Others_Allowed indicates whether an others choice is allowed
    --    in the context where the top-level aggregate appeared.
    --
@@ -1499,6 +1503,7 @@ package body Sem_Aggr is
                     Index          => First_Index (Aggr_Typ),
                     Index_Constr   => First_Index (Typ),
                     Component_Typ  => Component_Type (Typ),
+                    Iterated       => False,
                     Others_Allowed => True);
             else
                Aggr_Resolved :=
@@ -1507,6 +1512,7 @@ package body Sem_Aggr is
                     Index          => First_Index (Aggr_Typ),
                     Index_Constr   => First_Index (Aggr_Typ),
                     Component_Typ  => Component_Type (Typ),
+                    Iterated       => False,
                     Others_Allowed => False);
             end if;
 
@@ -1575,6 +1581,7 @@ package body Sem_Aggr is
       Index          : Node_Id;
       Index_Constr   : Node_Id;
       Component_Typ  : Entity_Id;
+      Iterated       : Boolean;
       Others_Allowed : Boolean) return Boolean
    is
       Loc : constant Source_Ptr := Sloc (N);
@@ -1633,8 +1640,9 @@ package body Sem_Aggr is
       --  cause raising CE at runtime.
 
       function Resolve_Aggr_Expr
-        (Expr        : Node_Id;
-         Single_Elmt : Boolean) return Boolean;
+        (Expr          : Node_Id;
+         Iterated_Elmt : Boolean := False;
+         Single_Elmt   : Boolean := True) return Boolean;
       --  Resolves aggregate expression Expr. Returns False if resolution
       --  fails. If Single_Elmt is set to False, the expression Expr may be
       --  used to initialize several array aggregate elements (this can happen
@@ -1966,9 +1974,13 @@ package body Sem_Aggr is
       -----------------------
 
       function Resolve_Aggr_Expr
-        (Expr        : Node_Id;
-         Single_Elmt : Boolean) return Boolean
+        (Expr          : Node_Id;
+         Iterated_Elmt : Boolean := False;
+         Single_Elmt   : Boolean := True) return Boolean
       is
+         Iterated_Expr  : constant Boolean := Iterated_Elmt or else Iterated;
+         --  True if the Expr is in an iteration context, possibly nested
+
          Nxt_Ind        : constant Node_Id := Next_Index (Index);
          Nxt_Ind_Constr : constant Node_Id := Next_Index (Index_Constr);
          --  Index is the current index corresponding to the expression
@@ -2040,12 +2052,15 @@ package body Sem_Aggr is
 
             Set_Etype (Expr, Etype (N));
 
-            Resolution_OK := Resolve_Array_Aggregate
-              (Expr, Nxt_Ind, Nxt_Ind_Constr, Component_Typ, Others_Allowed);
+            Resolution_OK :=
+              Resolve_Array_Aggregate
+                (Expr, Nxt_Ind, Nxt_Ind_Constr, Component_Typ,
+                 Iterated => Iterated_Expr, Others_Allowed => Others_Allowed);
 
             if Resolution_OK = Failure then
                return Failure;
             end if;
+
          else
             --  If it's "... => <>", nothing to resolve
 
@@ -2055,15 +2070,15 @@ package body Sem_Aggr is
             end if;
 
             --  Do not resolve the expressions of discrete or others choices
-            --  unless the expression covers a single component, or the
-            --  expander is inactive.
+            --  unless the expression covers a single component, or else the
+            --  expander is inactive or this is a spec expression.
 
             --  In SPARK mode, expressions that can perform side effects will
             --  be recognized by the gnat2why back-end, and the whole
             --  subprogram will be ignored. So semantic analysis can be
             --  performed safely.
 
-            if Single_Elmt
+            if (Single_Elmt and then not Iterated_Expr)
               or else not Expander_Active
               or else In_Spec_Expression
             then
@@ -2072,6 +2087,20 @@ package body Sem_Aggr is
                Check_Non_Static_Context (Expr);
                Aggregate_Constraint_Checks (Expr, Component_Typ);
                Check_Unset_Reference (Expr);
+
+            --  Analyze a copy of the expression, to verify legality. We use
+            --  a copy because the expression will be analyzed anew when the
+            --  enclosing aggregate is expanded, and the construct is rewritten
+            --  as a loop with a new index variable.
+
+            elsif Iterated_Expr then
+               declare
+                  New_Expr : constant Node_Id := Copy_Separate_Tree (Expr);
+
+               begin
+                  Set_Parent (New_Expr, Parent (Expr));
+                  Preanalyze_And_Resolve (New_Expr, Component_Typ);
+               end;
             end if;
          end if;
 
@@ -2212,23 +2241,15 @@ package body Sem_Aggr is
 
          --  Analyze expression without expansion, to verify legality.
          --  When generating code, we then remove references to the index
-         --  variable, because the expression will be analyzed anew after
-         --  rewritting as a loop with a new index variable; when not
-         --  generating code we leave the analyzed expression as it is.
+         --  variable, because the expression will be analyzed anew when the
+         --  enclosing aggregate is expanded, and the construct is rewritten
+         --  as a loop with a new index variable; when not generating code we
+         --  leave the analyzed expression as it is.
 
-         Resolution_OK := Resolve_Aggr_Expr (Expr, Single_Elmt => False);
+         Resolution_OK := Resolve_Aggr_Expr (Expr, Iterated_Elmt => True);
 
          if Operating_Mode /= Check_Semantics then
             Remove_References (Expr);
-            declare
-               Loop_Action : Node_Id;
-            begin
-               Loop_Action := First (Loop_Actions (N));
-               while Present (Loop_Action) loop
-                  Remove_References (Loop_Action);
-                  Next (Loop_Action);
-               end loop;
-            end;
          end if;
 
          End_Scope;
@@ -3582,17 +3603,19 @@ 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 not Resolve_Aggr_Expr (Expr) then
                return Failure;
             end if;
 
             --  Check incorrect use of dynamically tagged expression
 
-            if Is_Tagged_Type (Etype (Expr)) then
-               Check_Dynamically_Tagged_Expression
-                 (Expr => Expr,
-                  Typ  => Component_Type (Etype (N)),
-                  Related_Nod => N);
+            if not Iterated then
+               if Is_Tagged_Type (Etype (Expr)) then
+                  Check_Dynamically_Tagged_Expression
+                    (Expr => Expr,
+                     Typ  => Component_Type (Etype (N)),
+                     Related_Nod => N);
+               end if;
             end if;
 
             Next (Expr);
@@ -4030,10 +4053,10 @@ package body Sem_Aggr is
          --  enclosing aggregate is expanded, and the construct is rewritten
          --  as a loop with a new index variable.
 
-         Expr := New_Copy_Tree (Expression (Comp));
+         Expr := Copy_Separate_Tree (Expression (Comp));
+         Set_Parent (Expr, Comp);
          Preanalyze_And_Resolve (Expr, Elmt_Type);
          End_Scope;
-
       end Resolve_Iterated_Association;
 
    --  Start of processing for Resolve_Container_Aggregate
@@ -4468,14 +4491,17 @@ package body Sem_Aggr is
                   Set_Is_Not_Self_Hidden (Id);
                   Set_Scope (Id, Ent);
                end if;
+
                Enter_Name (Id);
 
-               --  Resolve a copy of the expression, after setting
-               --  its parent properly to preserve its context.
+               --  Analyze a copy of the expression, to verify legality. We use
+               --  a copy because the expression will be analyzed anew when the
+               --  enclosing aggregate is expanded, and the construct is
+               --  rewritten as a loop with a new index variable.
 
-               Expr := New_Copy_Tree (Expression (Assoc));
+               Expr := Copy_Separate_Tree (Expression (Assoc));
                Set_Parent (Expr, Assoc);
-               Analyze_And_Resolve (Expr, Component_Type (Typ));
+               Preanalyze_And_Resolve (Expr, Component_Type (Typ));
                End_Scope;
             end;