The problem is that the Resolve_Iterated_Association procedure, unlike its
sibling Resolve_Iterated_Component_Association, preanalyzes a copy of the
specification so, in a generic context, global references cannot later be
captured. This changes it to preanalyze the specification directly, which
requires a small adjustment during expansion.
Tested on x86-64/Linux, applied on the mainline.
2026-02-26 Eric Botcazou <[email protected]>
PR ada/124201
* exp_aggr.adb (Expand_Iterated_Component): Replace the iteration
variable in the key expression and iterator filter, if any.
* sem_aggr.adb (Resolve_Iterated_Component_Association): Preanalyze
the specification and key expression directly.
2026-02-26 Eric Botcazou <[email protected]>
* gnat.dg/generic_inst17.adb: New test.
--
Eric Botcazoudiff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 414034f4c73..d2e99f49e01 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -7019,27 +7019,66 @@ package body Exp_Aggr is
procedure Expand_Iterated_Component (Comp : Node_Id) is
Expr : constant Node_Id := Expression (Comp);
- Key_Expr : Node_Id := Empty;
+ Key_Expr : Node_Id;
Loop_Id : Entity_Id;
L_Range : Node_Id;
L_Iteration_Scheme : Node_Id;
Loop_Stat : Node_Id;
- Params : List_Id;
Stats : List_Id;
- begin
- if Nkind (Comp) = N_Iterated_Element_Association then
- Key_Expr := Key_Expression (Comp);
+ procedure Replace_Iteration_Variable (N : Node_Id; Var : Entity_Id);
+ -- Replace the iteration variable of N, a N_Iterator_Specification or
+ -- a N_Loop_Parameter_Specification node, with Var.
- -- We create a new entity as loop identifier in all cases,
- -- as is done for generated loops elsewhere, as the loop
- -- structure has been previously analyzed.
+ --------------------------------
+ -- Replace_Iteration_Variable --
+ --------------------------------
- if Present (Iterator_Specification (Comp)) then
+ procedure Replace_Iteration_Variable (N : Node_Id; Var : Entity_Id) is
+ Old_Var : constant Entity_Id := Defining_Identifier (N);
+
+ Map : Elist_Id;
- -- Either an Iterator_Specification or a Loop_Parameter_
- -- Specification is present.
+ begin
+ -- We need to replace the variable in preanalyzed expressions
+
+ if Present (Old_Var) then
+ Map := New_Elmt_List (Old_Var, Var);
+
+ -- Key_Expression has been preanalyzed when it is present, see
+ -- Resolve_Iterated_Association.
+
+ if Nkind (Comp) = N_Iterated_Element_Association
+ and then Present (Key_Expression (Comp))
+ then
+ Set_Key_Expression (Comp,
+ New_Copy_Tree (Key_Expression (Comp), Map => Map));
+ end if;
+
+ -- Iterator_Filter has been preanalyzed when it is present, see
+ -- Analyze_{Iterator,Loop_Parameter}_Specification.
+
+ if Present (Iterator_Filter (N)) then
+ Set_Iterator_Filter (N,
+ New_Copy_Tree (Iterator_Filter (N), Map => Map));
+ end if;
+ end if;
+
+ Set_Defining_Identifier (N, Var);
+ end Replace_Iteration_Variable;
+
+ -- Start of processing for Expand_Iterated_Component
+
+ begin
+ -- We create a new entity as loop identifier in all cases, as is done
+ -- for generated loops elsewhere, even though the loop structure has
+ -- been previously analyzed.
+
+ if Nkind (Comp) = N_Iterated_Element_Association then
+ -- Either an Iterator_Specification or a Loop_Parameter_
+ -- Specification is present.
+ if Present (Iterator_Specification (Comp)) then
L_Iteration_Scheme :=
Make_Iteration_Scheme (Loc,
Iterator_Specification => Iterator_Specification (Comp));
@@ -7047,8 +7086,8 @@ package body Exp_Aggr is
Make_Defining_Identifier (Loc,
Chars => Chars (Defining_Identifier
(Iterator_Specification (Comp))));
- Set_Defining_Identifier
- (Iterator_Specification (L_Iteration_Scheme), Loop_Id);
+ Replace_Iteration_Variable
+ (Iterator_Specification (Comp), Loop_Id);
else
L_Iteration_Scheme :=
@@ -7059,29 +7098,28 @@ package body Exp_Aggr is
Make_Defining_Identifier (Loc,
Chars => Chars (Defining_Identifier
(Loop_Parameter_Specification (Comp))));
- Set_Defining_Identifier
- (Loop_Parameter_Specification
- (L_Iteration_Scheme), Loop_Id);
+ Replace_Iteration_Variable
+ (Loop_Parameter_Specification (Comp), Loop_Id);
end if;
- else
- -- Iterated_Component_Association.
+ Key_Expr := Key_Expression (Comp);
+ else pragma Assert (Nkind (Comp) = N_Iterated_Component_Association);
if Present (Iterator_Specification (Comp)) then
+ L_Iteration_Scheme :=
+ Make_Iteration_Scheme (Loc,
+ Iterator_Specification => Iterator_Specification (Comp));
Loop_Id :=
Make_Defining_Identifier (Loc,
Chars => Chars (Defining_Identifier
(Iterator_Specification (Comp))));
- L_Iteration_Scheme :=
- Make_Iteration_Scheme (Loc,
- Iterator_Specification => Iterator_Specification (Comp));
- Set_Defining_Identifier
- (Iterator_Specification (L_Iteration_Scheme), Loop_Id);
+ Replace_Iteration_Variable
+ (Iterator_Specification (Comp), Loop_Id);
- else
- -- Loop_Parameter_Specification is parsed with a choice list.
- -- where the range is the first (and only) choice.
+ -- Loop_Parameter_Specification is parsed with a choice list
+ -- where the range is the first (and only) choice.
+ else
Loop_Id :=
Make_Defining_Identifier (Loc,
Chars => Chars (Defining_Identifier (Comp)));
@@ -7095,44 +7133,39 @@ package body Exp_Aggr is
Reverse_Present => Reverse_Present (Comp),
Discrete_Subtype_Definition => L_Range));
end if;
+
+ Key_Expr := Empty;
end if;
-- Build insertion statement. For a positional aggregate, only the
-- expression is needed. For a named aggregate, the loop variable,
-- whose type is that of the key, is an additional parameter for
-- the insertion operation.
- -- If a Key_Expression is present, it serves as the additional
- -- parameter. Otherwise the key is given by the loop parameter
- -- itself.
- if Present (Add_Unnamed_Subp)
- and then No (Add_Named_Subp)
- then
- Stats := New_List
- (Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (Entity (Add_Unnamed_Subp), Loc),
- Parameter_Associations =>
- New_List (New_Copy_Tree (Lhs),
- New_Copy_Tree (Expr))));
-
- else
- -- Named or indexed aggregate, for which a key is present,
- -- possibly with a specified key_expression.
+ if Present (Add_Unnamed_Subp) and then No (Add_Named_Subp) then
+ Stats := New_List (
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of (Entity (Add_Unnamed_Subp), Loc),
+ Parameter_Associations => New_List (
+ New_Copy_Tree (Lhs),
+ New_Copy_Tree (Expr))));
- if Present (Key_Expr) then
- Params := New_List (New_Copy_Tree (Lhs),
- New_Copy_Tree (Key_Expr),
- New_Copy_Tree (Expr));
- else
- Params := New_List (New_Copy_Tree (Lhs),
- New_Occurrence_Of (Loop_Id, Loc),
- New_Copy_Tree (Expr));
- end if;
+ -- Named or indexed aggregate. If a Key_Expression is present, it
+ -- serves as the additional parameter. Otherwise the key is given
+ -- by the loop parameter itself.
- Stats := New_List
- (Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (Entity (Add_Named_Subp), Loc),
- Parameter_Associations => Params));
+ else
+ Stats := New_List (
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of (Entity (Add_Named_Subp), Loc),
+ Parameter_Associations => New_List (
+ New_Copy_Tree (Lhs),
+ (if Present (Key_Expr)
+ then Key_Expr
+ else New_Occurrence_Of (Loop_Id, Loc)),
+ New_Copy_Tree (Expr))));
end if;
Loop_Stat := Make_Implicit_Loop_Statement
@@ -7438,8 +7471,8 @@ package body Exp_Aggr is
begin
Comp := First (Component_Associations (N));
while Present (Comp) loop
- if Nkind (Comp) = N_Iterated_Component_Association
- or else Nkind (Comp) = N_Iterated_Element_Association
+ if Nkind (Comp) in N_Iterated_Component_Association
+ | N_Iterated_Element_Association
then
Expand_Iterated_Component (Comp);
end if;
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 429f4c543b6..4b82a340219 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3836,62 +3836,47 @@ package body Sem_Aggr is
Choice : Node_Id;
Copy : Node_Id;
- Ent : Entity_Id;
Expr : Node_Id;
Key_Expr : Node_Id := Empty;
Id : Entity_Id;
- Id_Name : Name_Id;
- Typ : Entity_Id := Empty;
- Loop_Param_Id : Entity_Id := Empty;
+ Scop : Entity_Id;
+ Typ : Entity_Id;
begin
- Error_Msg_Ada_2022_Feature ("iterated component", Loc);
-
- -- If this is an Iterated_Element_Association then either a
- -- an Iterator_Specification or a Loop_Parameter specification
- -- is present.
-
- if Nkind (Comp) = N_Iterated_Element_Association then
- -- Create a temporary scope to avoid some modifications from
- -- escaping the Preanalyze call below. The original tree will
- -- be reanalyzed later.
-
- 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);
+ Error_Msg_Ada_2022_Feature ("iterated element", Loc);
- if Present (Loop_Parameter_Specification (Comp)) then
- Copy := Copy_Separate_Tree (Comp);
- Set_Parent (Copy, Parent (Comp));
-
- Preanalyze (Loop_Parameter_Specification (Copy));
+ -- Create a scope in which to introduce an index, to make it visible
+ -- for the analysis of element expression.
- if Present (Iterator_Specification (Copy)) then
- Loop_Param_Id :=
- Defining_Identifier (Iterator_Specification (Copy));
- else
- Loop_Param_Id :=
- Defining_Identifier (Loop_Parameter_Specification (Copy));
- end if;
+ Scop := New_Internal_Entity (E_Loop, Current_Scope, Sloc (Comp), 'L');
+ Set_Etype (Scop, Standard_Void_Type);
+ Set_Parent (Scop, Parent (Comp));
+ Push_Scope (Scop);
- Id_Name := Chars (Loop_Param_Id);
+ -- If this is an Iterated_Element_Association, then either an
+ -- Iterator_Specification or a Loop_Parameter specification
+ -- is present.
+ if Nkind (Comp) = N_Iterated_Element_Association then
+ if Present (Iterator_Specification (Comp)) then
+ Preanalyze (Iterator_Specification (Comp));
else
- Copy := Copy_Separate_Tree (Iterator_Specification (Comp));
-
- Preanalyze (Copy);
+ Preanalyze (Loop_Parameter_Specification (Comp));
+ end if;
- Loop_Param_Id := Defining_Identifier (Copy);
+ -- Note that analyzing Loop_Parameter_Specification (Comp) above
+ -- may have turned it into Iterator_Specification (Comp), so the
+ -- following statement cannot be merged with the above one.
- Id_Name := Chars (Loop_Param_Id);
+ if Present (Iterator_Specification (Comp)) then
+ Id := Defining_Identifier (Iterator_Specification (Comp));
+ else
+ Id := Defining_Identifier (Loop_Parameter_Specification (Comp));
end if;
-- Key expression must have the type of the key. We preanalyze
- -- a copy of the original expression, because it will be
- -- reanalyzed and copied as needed during expansion of the
- -- corresponding loop.
+ -- the expression, because it will be copied and reanalyzed as
+ -- needed during expansion of the corresponding loop.
Key_Expr := Key_Expression (Comp);
if Present (Key_Expr) then
@@ -3902,38 +3887,18 @@ package body Sem_Aggr is
& "(RM22 4.3.5(24))",
Comp);
else
- Preanalyze_And_Resolve
- (Copy_Separate_Tree (Key_Expr), Key_Type);
+ Preanalyze_And_Resolve (Key_Expr, Key_Type);
end if;
end if;
- End_Scope;
-
- Typ := Etype (Loop_Param_Id);
+ -- This is an N_Iterated_Component_Association. If there is iterator
+ -- specification, then its preanalysis will make the index visible.
elsif Present (Iterator_Specification (Comp)) then
- -- Create a temporary scope to avoid some modifications from
- -- escaping the Preanalyze call below. The original tree will
- -- be reanalyzed later.
-
- 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);
-
- Copy := Copy_Separate_Tree (Iterator_Specification (Comp));
-
- Loop_Param_Id :=
- Defining_Identifier (Iterator_Specification (Comp));
-
- Id_Name := Chars (Loop_Param_Id);
+ Preanalyze (Iterator_Specification (Comp));
+ Id := Defining_Identifier (Iterator_Specification (Comp));
- Preanalyze (Copy);
-
- End_Scope;
-
- Typ := Etype (Defining_Identifier (Copy));
+ -- Otherwise, analyze discrete choices and make the index visible
else
Choice := First (Discrete_Choices (Comp));
@@ -3967,24 +3932,21 @@ package body Sem_Aggr is
Typ := Entity (Choice);
elsif Is_Object_Reference (Choice) then
- declare
- I_Spec : constant Node_Id :=
- Make_Iterator_Specification (Sloc (N),
- Defining_Identifier =>
- Relocate_Node (Defining_Identifier (Comp)),
- Name => Copy,
- Reverse_Present => Reverse_Present (Comp),
- Iterator_Filter => Empty,
- Subtype_Indication => Empty);
-
- begin
- -- Recurse to expand association as iterator_spec
+ End_Scope;
- Set_Iterator_Specification (Comp, I_Spec);
- Set_Defining_Identifier (Comp, Empty);
- Resolve_Iterated_Association (Comp, Key_Type, Elmt_Type);
- return;
- end;
+ -- Recurse to expand association as Iterator_Specification
+
+ Set_Iterator_Specification (Comp,
+ Make_Iterator_Specification (Sloc (N),
+ Defining_Identifier =>
+ Relocate_Node (Defining_Identifier (Comp)),
+ Name => Copy,
+ Reverse_Present => Reverse_Present (Comp),
+ Iterator_Filter => Empty,
+ Subtype_Indication => Empty));
+ Set_Defining_Identifier (Comp, Empty);
+ Resolve_Iterated_Association (Comp, Key_Type, Elmt_Type);
+ return;
elsif Present (Key_Type) then
Analyze_And_Resolve (Choice, Key_Type);
@@ -3994,36 +3956,17 @@ package body Sem_Aggr is
Typ := Etype (Choice); -- assume unique for now
end if;
- Loop_Param_Id := Defining_Identifier (Comp);
+ Id := Defining_Identifier (Comp);
- Id_Name := Chars (Loop_Param_Id);
- end if;
-
- -- Create a scope in which to introduce an index, which is usually
- -- 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');
- Set_Etype (Ent, Standard_Void_Type);
- Set_Parent (Ent, Parent (Comp));
- Push_Scope (Ent);
-
- -- Insert and decorate the loop variable in the current scope.
- -- The expression has to be analyzed once the loop variable is
- -- directly visible. Mark the variable as referenced to prevent
- -- spurious warnings, given that subsequent uses of its name in the
- -- expression will reference the internal (synonym) loop variable.
-
- Enter_Name (Id);
+ Enter_Name (Id);
- pragma Assert (Present (Typ));
- Set_Etype (Id, Typ);
+ -- Decorate the index variable
- Mutate_Ekind (Id, E_Variable);
- Set_Is_Not_Self_Hidden (Id);
- Set_Scope (Id, Ent);
- Set_Referenced (Id);
+ Set_Etype (Id, Typ);
+ Mutate_Ekind (Id, E_Variable);
+ Set_Is_Not_Self_Hidden (Id);
+ Set_Scope (Id, Scop);
+ end if;
-- Check for violation of 4.3.5(27/5)
@@ -4032,12 +3975,12 @@ package body Sem_Aggr is
and then
(Is_Indexed_Aggregate (N, Add_Unnamed_Subp, New_Indexed_Subp)
or else Present (Add_Named_Subp))
- and then Base_Type (Key_Type) /= Base_Type (Typ)
+ and then Base_Type (Key_Type) /= Base_Type (Etype (Id))
then
Error_Msg_Node_2 := Key_Type;
Error_Msg_NE
("loop parameter type & must be same as key type & " &
- "(RM22 4.3.5(27))", Loop_Param_Id, Typ);
+ "(RM22 4.3.5(27))", Id, Etype (Id));
end if;
-- Analyze a copy of the expression, to verify legality. We use
-- PR ada/124201
-- { dg-do compile }
-- { dg-options "-gnat2022" }
with Ada.Containers.Indefinite_Ordered_Maps;
procedure Generic_Inst17 is
package Nested is
type Axis_Name is (X_Axis, Y_Axis, Z_Axis, E_Axis);
package Status_Group_Maps is new
Ada.Containers.Indefinite_Ordered_Maps (String, String);
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 use A'Image => ""]);
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_Inst17;
