Ada: Fix crash on iterated element association for Ordered_Maps

This is a regression present on the mainline and 15 branch: the compiler
crashes on an iterated element association for Ordered_Maps or similar
container types, because the type of the loop variable is not computed.

gcc/ada/
	PR ada/124224
	* sem_aggr.adb (Resolve_Container_Aggregate): Minor tweaks.
	(Resolve_Iterated_Association): Compute Typ on all paths.

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

Co-authored-by: Liam Powell <liam@liampwll.com>

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 4d4dd365354fd144dde6ba8fd59210eda9f09cc3..429f4c543b6c67240498fe5134f6f3b1ec4a56e4 100644 (file)
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3815,7 +3815,7 @@ package body Sem_Aggr is
       --  a subtype indication or an iterator specification that determines
       --  an element type.
 
-      Asp   : constant Node_Id := Find_Value_Of_Aspect (Typ, Aspect_Aggregate);
+      Asp : constant Node_Id := Find_Value_Of_Aspect (Typ, Aspect_Aggregate);
 
       Empty_Subp          : Node_Id := Empty;
       Add_Named_Subp      : Node_Id := Empty;
@@ -3832,7 +3832,8 @@ package body Sem_Aggr is
          Key_Type  : Entity_Id;
          Elmt_Type : Entity_Id)
       is
-         Loc           : constant Source_Ptr := Sloc (N);
+         Loc : constant Source_Ptr := Sloc (N);
+
          Choice        : Node_Id;
          Copy          : Node_Id;
          Ent           : Entity_Id;
@@ -3963,7 +3964,7 @@ package body Sem_Aggr is
               and then Present (Key_Type)
               and then Base_Type (Entity (Choice)) = Base_Type (Key_Type)
             then
-               null;
+               Typ := Entity (Choice);
 
             elsif Is_Object_Reference (Choice) then
                declare
@@ -3975,13 +3976,13 @@ package body Sem_Aggr is
                       Reverse_Present     => Reverse_Present (Comp),
                       Iterator_Filter     => Empty,
                       Subtype_Indication  => Empty);
+
                begin
+                  --  Recurse to expand association as iterator_spec
+
                   Set_Iterator_Specification (Comp, I_Spec);
                   Set_Defining_Identifier (Comp, Empty);
-
                   Resolve_Iterated_Association (Comp, Key_Type, Elmt_Type);
-                  --  Recursive call to expand association as iterator_spec
-
                   return;
                end;
 
@@ -3993,8 +3994,7 @@ package body Sem_Aggr is
                Typ := Etype (Choice);  --  assume unique for now
             end if;
 
-            Loop_Param_Id :=
-              Defining_Identifier (Comp);
+            Loop_Param_Id := Defining_Identifier (Comp);
 
             Id_Name := Chars (Loop_Param_Id);
          end if;
@@ -4003,9 +4003,8 @@ package body Sem_Aggr is
          --  visible in the expression for the component, and needed for its
          --  analysis.
 
-         Id := Make_Defining_Identifier (Sloc (Comp), Id_Name);
-         Ent := New_Internal_Entity (E_Loop,
-                  Current_Scope, Sloc (Comp), 'L');
+         Id  := Make_Defining_Identifier (Sloc (Comp), Id_Name);
+         Ent := New_Internal_Entity (E_Loop, Current_Scope, Sloc (Comp), 'L');
          Set_Etype  (Ent, Standard_Void_Type);
          Set_Parent (Ent, Parent (Comp));
          Push_Scope (Ent);
@@ -4110,12 +4109,10 @@ package body Sem_Aggr is
                   Comp : Node_Id := First (Component_Associations (N));
                begin
                   while Present (Comp) loop
-                     if Nkind (Comp) in
-                       N_Iterated_Component_Association |
-                       N_Iterated_Element_Association
+                     if Nkind (Comp) in N_Iterated_Component_Association
+                                      | N_Iterated_Element_Association
                      then
-                        Resolve_Iterated_Association
-                          (Comp, Empty, Elmt_Type);
+                        Resolve_Iterated_Association (Comp, Empty, Elmt_Type);
                      else
                         Error_Msg_N ("illegal component association "
                           & "for unnamed container aggregate", Comp);
@@ -4171,12 +4168,10 @@ package body Sem_Aggr is
 
                   Analyze_And_Resolve (Expression (Comp), Elmt_Type);
 
-               elsif Nkind (Comp) in
-                 N_Iterated_Component_Association |
-                 N_Iterated_Element_Association
+               elsif Nkind (Comp) in N_Iterated_Component_Association
+                                   | N_Iterated_Element_Association
                then
-                  Resolve_Iterated_Association
-                    (Comp, Key_Type, Elmt_Type);
+                  Resolve_Iterated_Association (Comp, Key_Type, Elmt_Type);
                end if;
 
                Next (Comp);
@@ -4231,9 +4226,8 @@ package body Sem_Aggr is
                         Analyze_And_Resolve (Expression (Comp), Comp_Type);
                      end if;
 
-                  elsif Nkind (Comp) in
-                    N_Iterated_Component_Association |
-                    N_Iterated_Element_Association
+                  elsif Nkind (Comp) in N_Iterated_Component_Association
+                                      | N_Iterated_Element_Association
                   then
                      Resolve_Iterated_Association
                        (Comp, Index_Type, Comp_Type);

diff --git a/gcc/testsuite/gnat.dg/specs/aggr12.ads b/gcc/testsuite/gnat.dg/specs/aggr12.ads
new file mode 100644 (file)
index 0000000..9cadaf0
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/aggr12.ads
@@ -0,0 +1,14 @@
+-- PR ada/124224
+-- { dg-do compile }
+-- { dg-options "-gnat2022" }
+
+with Ada.Containers.Ordered_Maps;
+
+package Aggr12 is
+
+  package Maps is new
+    Ada.Containers.Ordered_Maps (Character, Boolean);
+
+  M : Maps.Map := [for C in Character => False];
+
+end Aggr12;