From: Eric Botcazou Date: Thu, 26 Feb 2026 21:13:22 +0000 (+0100) Subject: Ada: Fix bogus visibility error for iterated element association with key X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=ed2908e642dbe4f04c94de6d196f3176a159ca4f;p=thirdparty%2Fgcc.git Ada: Fix bogus visibility error for iterated element association with key 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. --- diff --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 diff --git a/gcc/testsuite/gnat.dg/generic_inst17.adb b/gcc/testsuite/gnat.dg/generic_inst17.adb new file mode 100644 index 00000000000..4d49a0b631d --- /dev/null +++ b/gcc/testsuite/gnat.dg/generic_inst17.adb @@ -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;