This completes the transition of the Resolve_Iterated_Association procedure to
the preanalysis of the original nodes for the sake of generic instantiations.
Tested on x86-64/Linux, applied on the mainline.
2026-02-27 Eric Botcazou <[email protected]>
PR ada/124201
PR ada/124282
* exp_aggr.adb (Expand_Iterated_Component): Replace the iteration
variable in the expression as well.
* sem_aggr.adb (Resolve_Iterated_Component_Association): Preanalyze
the expression directly as well.
2026-02-27 Eric Botcazou <[email protected]>
* gnat.dg/generic_inst18.adb: New test.
--
Eric Botcazoudiff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index d2e99f49e01..4b14043d276 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -7017,14 +7017,11 @@ package body Exp_Aggr is
-------------------------------
procedure Expand_Iterated_Component (Comp : Node_Id) is
- Expr : constant Node_Id := Expression (Comp);
-
- Key_Expr : Node_Id;
- Loop_Id : Entity_Id;
- L_Range : Node_Id;
- L_Iteration_Scheme : Node_Id;
- Loop_Stat : Node_Id;
- Stats : List_Id;
+ Key_Expr : Node_Id;
+ Loop_Id : Entity_Id;
+ Loop_Iter_Scheme : Node_Id;
+ Loop_Stat : Node_Id;
+ Stats : List_Id;
procedure Replace_Iteration_Variable (N : Node_Id; Var : Entity_Id);
-- Replace the iteration variable of N, a N_Iterator_Specification or
@@ -7062,6 +7059,9 @@ package body Exp_Aggr is
Set_Iterator_Filter (N,
New_Copy_Tree (Iterator_Filter (N), Map => Map));
end if;
+
+ Set_Expression (Comp,
+ New_Copy_Tree (Expression (Comp), Map => Map));
end if;
Set_Defining_Identifier (N, Var);
@@ -7079,18 +7079,18 @@ package body Exp_Aggr is
-- Specification is present.
if Present (Iterator_Specification (Comp)) then
- L_Iteration_Scheme :=
+ Loop_Iter_Scheme :=
Make_Iteration_Scheme (Loc,
Iterator_Specification => Iterator_Specification (Comp));
Loop_Id :=
- Make_Defining_Identifier (Loc,
- Chars => Chars (Defining_Identifier
- (Iterator_Specification (Comp))));
+ Make_Defining_Identifier (Loc,
+ Chars => Chars (Defining_Identifier
+ (Iterator_Specification (Comp))));
Replace_Iteration_Variable
- (Iterator_Specification (Comp), Loop_Id);
+ (Iterator_Specification (Loop_Iter_Scheme), Loop_Id);
else
- L_Iteration_Scheme :=
+ Loop_Iter_Scheme :=
Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification =>
Loop_Parameter_Specification (Comp));
@@ -7099,14 +7099,14 @@ package body Exp_Aggr is
Chars => Chars (Defining_Identifier
(Loop_Parameter_Specification (Comp))));
Replace_Iteration_Variable
- (Loop_Parameter_Specification (Comp), Loop_Id);
+ (Loop_Parameter_Specification (Loop_Iter_Scheme), Loop_Id);
end if;
Key_Expr := Key_Expression (Comp);
else pragma Assert (Nkind (Comp) = N_Iterated_Component_Association);
if Present (Iterator_Specification (Comp)) then
- L_Iteration_Scheme :=
+ Loop_Iter_Scheme :=
Make_Iteration_Scheme (Loc,
Iterator_Specification => Iterator_Specification (Comp));
Loop_Id :=
@@ -7114,7 +7114,7 @@ package body Exp_Aggr is
Chars => Chars (Defining_Identifier
(Iterator_Specification (Comp))));
Replace_Iteration_Variable
- (Iterator_Specification (Comp), Loop_Id);
+ (Iterator_Specification (Loop_Iter_Scheme), Loop_Id);
-- Loop_Parameter_Specification is parsed with a choice list
-- where the range is the first (and only) choice.
@@ -7123,15 +7123,16 @@ package body Exp_Aggr is
Loop_Id :=
Make_Defining_Identifier (Loc,
Chars => Chars (Defining_Identifier (Comp)));
- L_Range := Relocate_Node (First (Discrete_Choices (Comp)));
-
- L_Iteration_Scheme :=
+ Loop_Iter_Scheme :=
Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification =>
Make_Loop_Parameter_Specification (Loc,
- Defining_Identifier => Loop_Id,
+ Defining_Identifier => Defining_Identifier (Comp),
Reverse_Present => Reverse_Present (Comp),
- Discrete_Subtype_Definition => L_Range));
+ Discrete_Subtype_Definition =>
+ Relocate_Node (First (Discrete_Choices (Comp)))));
+ Replace_Iteration_Variable
+ (Loop_Parameter_Specification (Loop_Iter_Scheme), Loop_Id);
end if;
Key_Expr := Empty;
@@ -7149,7 +7150,7 @@ package body Exp_Aggr is
New_Occurrence_Of (Entity (Add_Unnamed_Subp), Loc),
Parameter_Associations => New_List (
New_Copy_Tree (Lhs),
- New_Copy_Tree (Expr))));
+ Expression (Comp))));
-- Named or indexed aggregate. If a Key_Expression is present, it
-- serves as the additional parameter. Otherwise the key is given
@@ -7165,13 +7166,13 @@ package body Exp_Aggr is
(if Present (Key_Expr)
then Key_Expr
else New_Occurrence_Of (Loop_Id, Loc)),
- New_Copy_Tree (Expr))));
+ Expression (Comp))));
end if;
Loop_Stat := Make_Implicit_Loop_Statement
(Node => N,
Identifier => Empty,
- Iteration_Scheme => L_Iteration_Scheme,
+ Iteration_Scheme => Loop_Iter_Scheme,
Statements => Stats);
Append (Loop_Stat, Aggr_Code);
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 4b82a340219..4bb3cb21c21 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3836,7 +3836,6 @@ package body Sem_Aggr is
Choice : Node_Id;
Copy : Node_Id;
- Expr : Node_Id;
Key_Expr : Node_Id := Empty;
Id : Entity_Id;
Scop : Entity_Id;
@@ -3983,14 +3982,12 @@ package body Sem_Aggr is
"(RM22 4.3.5(27))", Id, Etype (Id));
end if;
- -- 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.
+ -- Preanalyze the expression, to verify legality. We preanalyze it
+ -- 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 := Copy_Separate_Tree (Expression (Comp));
- Set_Parent (Expr, Comp);
- Preanalyze_And_Resolve (Expr, Elmt_Type);
+ Preanalyze_And_Resolve (Expression (Comp), Elmt_Type);
End_Scope;
end Resolve_Iterated_Association;
-- { dg-do compile }
-- { dg-options "-gnat2022" }
with Ada.Containers.Indefinite_Ordered_Maps;
procedure Generic_Inst18 is
package Nested is
type Axis_Name is (X_Axis, Y_Axis, Z_Axis, E_Axis);
type R (A : Axis_Name) is record
B : Axis_Name;
end record;
package Status_Group_Maps is new
Ada.Containers.Indefinite_Ordered_Maps (Axis_Name, R);
generic
package Modules is
type Module is abstract tagged null record;
function Status_Schema (This : Module) return Status_Group_Maps.Map
is ([]);
end Modules;
generic
with package My_Modules is new Modules;
package Internal_Status_Reporter is
type Module is new My_Modules.Module with null record;
function Status_Schema (This : Module) return Status_Group_Maps.Map
is ([for A in Axis_Name => (A => X_Axis, B => X_Axis)]);
end Internal_Status_Reporter;
generic
package Controller is
package My_Modules is new Modules;
package My_Internal_Status_Reporter is new
Internal_Status_Reporter (My_Modules);
end Controller;
end Nested;
package My_Controller is new Nested.Controller;
begin
null;
end Generic_Inst18;
