TeamHeptaMirrors/gcc
1
0
Fork 1
mirror of https://github.com/gcc-mirror/gcc.git synced 2026-05-06 14:59:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

Ada: Fix bogus visibility error for iterated element association with key

Browse Source 
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.

gcc/ada/
	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.

gcc/testsuite/
	* gnat.dg/generic_inst17.adb: New test.
This commit is contained in:
Eric Botcazou
2026-02-26 22:13:22 +01:00
parent a8290fb163
commit ed2908e642
3 changed files with 189 additions and 171 deletions
Download Patch File Download Diff File Expand all files Collapse all files

149
gcc/ada/exp_aggr.adb
View File

@@ -7019,27 +7019,66 @@ package body Exp_Aggr is
procedure Expand_Iterated_Component (Comp : Node_Id) is procedure Expand_Iterated_Component (Comp : Node_Id) is
Expr : constant Node_Id := Expression (Comp); Expr : constant Node_Id := Expression (Comp);
Key_Expr : Node_Id := Empty; Key_Expr : Node_Id;
Loop_Id : Entity_Id; Loop_Id : Entity_Id;
L_Range : Node_Id; L_Range : Node_Id;
L_Iteration_Scheme : Node_Id; L_Iteration_Scheme : Node_Id;
Loop_Stat : Node_Id; Loop_Stat : Node_Id;
Params : List_Id;
Stats : List_Id; Stats : List_Id;
begin procedure Replace_Iteration_Variable (N : Node_Id; Var : Entity_Id);
if Nkind (Comp) = N_Iterated_Element_Association then -- Replace the iteration variable of N, a N_Iterator_Specification or
Key_Expr := Key_Expression (Comp); -- 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 -- Replace_Iteration_Variable --
-- structure has been previously analyzed. --------------------------------
procedure Replace_Iteration_Variable (N : Node_Id; Var : Entity_Id) is
Old_Var : constant Entity_Id := Defining_Identifier (N);
Map : Elist_Id;
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 if Present (Iterator_Specification (Comp)) then
-- Either an Iterator_Specification or a Loop_Parameter_
-- Specification is present.
L_Iteration_Scheme := L_Iteration_Scheme :=
Make_Iteration_Scheme (Loc, Make_Iteration_Scheme (Loc,
Iterator_Specification => Iterator_Specification (Comp)); Iterator_Specification => Iterator_Specification (Comp));
@@ -7047,8 +7086,8 @@ package body Exp_Aggr is
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => Chars (Defining_Identifier Chars => Chars (Defining_Identifier
(Iterator_Specification (Comp)))); (Iterator_Specification (Comp))));
Set_Defining_Identifier Replace_Iteration_Variable
(Iterator_Specification (L_Iteration_Scheme), Loop_Id); (Iterator_Specification (Comp), Loop_Id);
else else
L_Iteration_Scheme := L_Iteration_Scheme :=
@@ -7059,29 +7098,28 @@ package body Exp_Aggr is
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => Chars (Defining_Identifier Chars => Chars (Defining_Identifier
(Loop_Parameter_Specification (Comp)))); (Loop_Parameter_Specification (Comp))));
Set_Defining_Identifier Replace_Iteration_Variable
(Loop_Parameter_Specification (Loop_Parameter_Specification (Comp), Loop_Id);
(L_Iteration_Scheme), Loop_Id);
end if; end if;
else Key_Expr := Key_Expression (Comp);
-- Iterated_Component_Association.
else pragma Assert (Nkind (Comp) = N_Iterated_Component_Association);
if Present (Iterator_Specification (Comp)) then if Present (Iterator_Specification (Comp)) then
L_Iteration_Scheme :=
Make_Iteration_Scheme (Loc,
Iterator_Specification => Iterator_Specification (Comp));
Loop_Id := Loop_Id :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => Chars (Defining_Identifier Chars => Chars (Defining_Identifier
(Iterator_Specification (Comp)))); (Iterator_Specification (Comp))));
L_Iteration_Scheme := Replace_Iteration_Variable
Make_Iteration_Scheme (Loc, (Iterator_Specification (Comp), Loop_Id);
Iterator_Specification => Iterator_Specification (Comp));
Set_Defining_Identifier -- Loop_Parameter_Specification is parsed with a choice list
(Iterator_Specification (L_Iteration_Scheme), Loop_Id); -- where the range is the first (and only) choice.
else else
-- Loop_Parameter_Specification is parsed with a choice list.
-- where the range is the first (and only) choice.
Loop_Id := Loop_Id :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => Chars (Defining_Identifier (Comp))); Chars => Chars (Defining_Identifier (Comp)));
@@ -7095,44 +7133,39 @@ package body Exp_Aggr is
Reverse_Present => Reverse_Present (Comp), Reverse_Present => Reverse_Present (Comp),
Discrete_Subtype_Definition => L_Range)); Discrete_Subtype_Definition => L_Range));
end if; end if;
Key_Expr := Empty;
end if; end if;
-- Build insertion statement. For a positional aggregate, only the -- Build insertion statement. For a positional aggregate, only the
-- expression is needed. For a named aggregate, the loop variable, -- expression is needed. For a named aggregate, the loop variable,
-- whose type is that of the key, is an additional parameter for -- whose type is that of the key, is an additional parameter for
-- the insertion operation. -- 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) if Present (Add_Unnamed_Subp) and then No (Add_Named_Subp) then
and then No (Add_Named_Subp) Stats := New_List (
then Make_Procedure_Call_Statement (Loc,
Stats := New_List Name =>
(Make_Procedure_Call_Statement (Loc, New_Occurrence_Of (Entity (Add_Unnamed_Subp), Loc),
Name => New_Occurrence_Of (Entity (Add_Unnamed_Subp), Loc), Parameter_Associations => New_List (
Parameter_Associations => New_Copy_Tree (Lhs),
New_List (New_Copy_Tree (Lhs), New_Copy_Tree (Expr))));
New_Copy_Tree (Expr))));
-- 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.
else else
-- Named or indexed aggregate, for which a key is present, Stats := New_List (
-- possibly with a specified key_expression. Make_Procedure_Call_Statement (Loc,
Name =>
if Present (Key_Expr) then New_Occurrence_Of (Entity (Add_Named_Subp), Loc),
Params := New_List (New_Copy_Tree (Lhs), Parameter_Associations => New_List (
New_Copy_Tree (Key_Expr), New_Copy_Tree (Lhs),
New_Copy_Tree (Expr)); (if Present (Key_Expr)
else then Key_Expr
Params := New_List (New_Copy_Tree (Lhs), else New_Occurrence_Of (Loop_Id, Loc)),
New_Occurrence_Of (Loop_Id, Loc), New_Copy_Tree (Expr))));
New_Copy_Tree (Expr));
end if;
Stats := New_List
(Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Entity (Add_Named_Subp), Loc),
Parameter_Associations => Params));
end if; end if;
Loop_Stat := Make_Implicit_Loop_Statement Loop_Stat := Make_Implicit_Loop_Statement
@@ -7438,8 +7471,8 @@ package body Exp_Aggr is
begin begin
Comp := First (Component_Associations (N)); Comp := First (Component_Associations (N));
while Present (Comp) loop while Present (Comp) loop
if Nkind (Comp) = N_Iterated_Component_Association if Nkind (Comp) in N_Iterated_Component_Association
or else Nkind (Comp) = N_Iterated_Element_Association | N_Iterated_Element_Association
then then
Expand_Iterated_Component (Comp); Expand_Iterated_Component (Comp);
end if; end if;

169
gcc/ada/sem_aggr.adb
View File

@@ -3836,62 +3836,47 @@ package body Sem_Aggr is
Choice : Node_Id; Choice : Node_Id;
Copy : Node_Id; Copy : Node_Id;
Ent : Entity_Id;
Expr : Node_Id; Expr : Node_Id;
Key_Expr : Node_Id := Empty; Key_Expr : Node_Id := Empty;
Id : Entity_Id; Id : Entity_Id;
Id_Name : Name_Id; Scop : Entity_Id;
Typ : Entity_Id := Empty; Typ : Entity_Id;
Loop_Param_Id : Entity_Id := Empty;
begin begin
Error_Msg_Ada_2022_Feature ("iterated component", Loc); Error_Msg_Ada_2022_Feature ("iterated element", Loc);
-- If this is an Iterated_Element_Association then either a -- Create a scope in which to introduce an index, to make it visible
-- an Iterator_Specification or a Loop_Parameter specification -- for the analysis of element expression.
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);
-- If this is an Iterated_Element_Association, then either an
-- Iterator_Specification or a Loop_Parameter specification
-- is present. -- is present.
if Nkind (Comp) = N_Iterated_Element_Association then if Nkind (Comp) = N_Iterated_Element_Association then
-- Create a temporary scope to avoid some modifications from if Present (Iterator_Specification (Comp)) then
-- escaping the Preanalyze call below. The original tree will Preanalyze (Iterator_Specification (Comp));
-- 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);
if Present (Loop_Parameter_Specification (Comp)) then
Copy := Copy_Separate_Tree (Comp);
Set_Parent (Copy, Parent (Comp));
Preanalyze (Loop_Parameter_Specification (Copy));
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;
Id_Name := Chars (Loop_Param_Id);
else else
Copy := Copy_Separate_Tree (Iterator_Specification (Comp)); Preanalyze (Loop_Parameter_Specification (Comp));
end if;
Preanalyze (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.
Loop_Param_Id := Defining_Identifier (Copy); if Present (Iterator_Specification (Comp)) then
Id := Defining_Identifier (Iterator_Specification (Comp));
Id_Name := Chars (Loop_Param_Id); else
Id := Defining_Identifier (Loop_Parameter_Specification (Comp));
end if; end if;
-- Key expression must have the type of the key. We preanalyze -- Key expression must have the type of the key. We preanalyze
-- a copy of the original expression, because it will be -- the expression, because it will be copied and reanalyzed as
-- reanalyzed and copied as needed during expansion of the -- needed during expansion of the corresponding loop.
-- corresponding loop.
Key_Expr := Key_Expression (Comp); Key_Expr := Key_Expression (Comp);
if Present (Key_Expr) then if Present (Key_Expr) then
@@ -3902,38 +3887,18 @@ package body Sem_Aggr is
& "(RM22 4.3.5(24))", & "(RM22 4.3.5(24))",
Comp); Comp);
else else
Preanalyze_And_Resolve Preanalyze_And_Resolve (Key_Expr, Key_Type);
(Copy_Separate_Tree (Key_Expr), Key_Type);
end if; end if;
end if; end if;
End_Scope; -- This is an N_Iterated_Component_Association. If there is iterator
-- specification, then its preanalysis will make the index visible.
Typ := Etype (Loop_Param_Id);
elsif Present (Iterator_Specification (Comp)) then elsif Present (Iterator_Specification (Comp)) then
-- Create a temporary scope to avoid some modifications from Preanalyze (Iterator_Specification (Comp));
-- escaping the Preanalyze call below. The original tree will Id := Defining_Identifier (Iterator_Specification (Comp));
-- be reanalyzed later.
Ent := New_Internal_Entity -- Otherwise, analyze discrete choices and make the index visible
(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 (Copy);
End_Scope;
Typ := Etype (Defining_Identifier (Copy));
else else
Choice := First (Discrete_Choices (Comp)); Choice := First (Discrete_Choices (Comp));
@@ -3967,24 +3932,21 @@ package body Sem_Aggr is
Typ := Entity (Choice); Typ := Entity (Choice);
elsif Is_Object_Reference (Choice) then elsif Is_Object_Reference (Choice) then
declare End_Scope;
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_Specification
-- Recurse to expand association as iterator_spec
Set_Iterator_Specification (Comp, I_Spec); Set_Iterator_Specification (Comp,
Set_Defining_Identifier (Comp, Empty); Make_Iterator_Specification (Sloc (N),
Resolve_Iterated_Association (Comp, Key_Type, Elmt_Type); Defining_Identifier =>
return; Relocate_Node (Defining_Identifier (Comp)),
end; 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 elsif Present (Key_Type) then
Analyze_And_Resolve (Choice, Key_Type); Analyze_And_Resolve (Choice, Key_Type);
@@ -3994,37 +3956,18 @@ package body Sem_Aggr is
Typ := Etype (Choice); -- assume unique for now Typ := Etype (Choice); -- assume unique for now
end if; end if;
Loop_Param_Id := Defining_Identifier (Comp); Id := Defining_Identifier (Comp);
Id_Name := Chars (Loop_Param_Id); Enter_Name (Id);
-- Decorate the index variable
Set_Etype (Id, Typ);
Mutate_Ekind (Id, E_Variable);
Set_Is_Not_Self_Hidden (Id);
Set_Scope (Id, Scop);
end if; 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);
pragma Assert (Present (Typ));
Set_Etype (Id, Typ);
Mutate_Ekind (Id, E_Variable);
Set_Is_Not_Self_Hidden (Id);
Set_Scope (Id, Ent);
Set_Referenced (Id);
-- Check for violation of 4.3.5(27/5) -- Check for violation of 4.3.5(27/5)
if No (Key_Expr) if No (Key_Expr)
@@ -4032,12 +3975,12 @@ package body Sem_Aggr is
and then and then
(Is_Indexed_Aggregate (N, Add_Unnamed_Subp, New_Indexed_Subp) (Is_Indexed_Aggregate (N, Add_Unnamed_Subp, New_Indexed_Subp)
or else Present (Add_Named_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 then
Error_Msg_Node_2 := Key_Type; Error_Msg_Node_2 := Key_Type;
Error_Msg_NE Error_Msg_NE
("loop parameter type & must be same as key type & " & ("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; end if;
-- Analyze a copy of the expression, to verify legality. We use -- Analyze a copy of the expression, to verify legality. We use

42
gcc/testsuite/gnat.dg/generic_inst17.adb Normal file
View File

@@ -0,0 +1,42 @@
-- 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;