Ada: Fix infinite loop on iterated element association with iterator and key

Unlike when the key expression is not present, Resolve_Iterated_Association
analyzes instead of preanalyzes the iterator specification, which causes the
expander to be invoked on an orphaned copy of the iterator expression.

gcc/ada/
	PR ada/123371
	* sem_aggr.adb (Resolve_Iterated_Association): Call Preanalyze
	instead of Analyze consistently, as well as Copy_Separate_Tree
	instead of New_Copy_Tree.

gcc/testsuite/
	* gnat.dg/specs/aggr10.ads: New test.

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 729835053ede466456edee62800e9e6152af5c99..928f4f7bbc4a6666ef9adcf4337eeb91b57e54f4 100644 (file)
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3853,10 +3853,9 @@ package body Sem_Aggr is
          --  is present.
 
          if Nkind (Comp) = N_Iterated_Element_Association then
-
             --  Create a temporary scope to avoid some modifications from
-            --  escaping the Analyze call below. The original Tree will be
-            --  reanalyzed later.
+            --  escaping the Preanalyze call below. The original tree will
+            --  be reanalyzed later.
 
             Ent := New_Internal_Entity
                      (E_Loop, Current_Scope, Sloc (Comp), 'L');
@@ -3868,8 +3867,7 @@ package body Sem_Aggr is
                Copy := Copy_Separate_Tree (Comp);
                Set_Parent (Copy, Parent (Comp));
 
-               Analyze
-                 (Loop_Parameter_Specification (Copy));
+               Preanalyze (Loop_Parameter_Specification (Copy));
 
                if Present (Iterator_Specification (Copy)) then
                   Loop_Param_Id :=
@@ -3880,9 +3878,11 @@ package body Sem_Aggr is
                end if;
 
                Id_Name := Chars (Loop_Param_Id);
+
             else
                Copy := Copy_Separate_Tree (Iterator_Specification (Comp));
-               Analyze (Copy);
+
+               Preanalyze (Copy);
 
                Loop_Param_Id := Defining_Identifier (Copy);
 
@@ -3903,17 +3903,19 @@ package body Sem_Aggr is
                        & "(RM22 4.3.5(24))",
                      Comp);
                else
-                  Preanalyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type);
+                  Preanalyze_And_Resolve
+                    (Copy_Separate_Tree (Key_Expr), Key_Type);
                end if;
             end if;
+
             End_Scope;
 
             Typ := Etype (Loop_Param_Id);
 
          elsif Present (Iterator_Specification (Comp)) then
             --  Create a temporary scope to avoid some modifications from
-            --  escaping the Analyze call below. The original Tree will be
-            --  reanalyzed later.
+            --  escaping the Preanalyze call below. The original tree will
+            --  be reanalyzed later.
 
             Ent := New_Internal_Entity
                      (E_Loop, Current_Scope, Sloc (Comp), 'L');

diff --git a/gcc/testsuite/gnat.dg/specs/aggr10.ads b/gcc/testsuite/gnat.dg/specs/aggr10.ads
new file mode 100644 (file)
index 0000000..caa42ff
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/aggr10.ads
@@ -0,0 +1,21 @@
+-- PR ada/123371
+-- { dg-do compile }
+-- { dg-options "-gnat2022" }
+
+with Ada.Containers.Ordered_Maps;
+
+package Aggr10 is
+
+  package Maps is new Ada.Containers.Ordered_Maps (Integer, Integer);
+
+  function F return Maps.Map is ([]);
+
+  A : Maps.Map := [for I of Maps.Map'[] => 1]; --  Works
+  B : Maps.Map := [for I of A => 1]; --  Works
+  C : Maps.Map := [for I of B use 1 => 1]; --  Works
+  D : Maps.Map := [for I of F => 1]; --  Works
+
+  X : Maps.Map := [for I of Maps.Map'[] use 1 => 1]; --  Infinite loop
+  Y : Maps.Map := [for I of F use 1 => 1]; --  Infinite loop
+
+end Aggr10;