This happens with a container aggregate in the testcase, although this can
very likely happen with a record aggregate as well. The trick used in the
Save_Global_References procedure for aggregates loses the qualification of
the type of the formal for which the aggregate is the actual.
Tested on x86-64/Linux, applied on the mainline and 15 branch.
2025-12-26 Eric Botcazou <[email protected]>
PR ada/123302
* sem_ch12.adb (Save_Global_Reference.Save_References_In_Aggregate):
Recurse on the scope of the type to find one that is visible, in the
case of an actual in a subprogram call with a local type.
2025-12-26 Eric Botcazou <[email protected]>
* gnat.dg/aggr34.adb: New test.
* gnat.dg/aggr34_pkg1.ads, gnat.dg/aggr34_pkg1.adb: New helper.
* gnat.dg/aggr34_pkg2.ads, gnat.dg/aggr34_pkg2.adb: Likewise.
* gnat.dg/aggr34_pkg3.ads: Likewise.
--
Eric Botcazou-- { dg-do compile }
-- { dg-options "-gnat2022" }
package body Aggr34_Pkg1 is
procedure Proc is null;
end Aggr34_Pkg1;
with Aggr34_Pkg3;
with Aggr34_Pkg2;
generic
with package My_Config is new Aggr34_Pkg3;
package Aggr34_Pkg1 is
package My_Module_Basic_Config is new Aggr34_Pkg2 (My_Config);
procedure Proc;
end Aggr34_Pkg1;
-- { dg-do compile }
-- { dg-options "-gnat2022" }
package body Aggr34_Pkg2 is
procedure Disable_Prunt is
begin
My_Config.Set (["a", "b"]);
end Disable_Prunt;
end Aggr34_Pkg2;
-- PR ada/123302
-- { dg-do link }
-- { dg-options "-gnat2022" }
with Aggr34_Pkg3;
with Aggr34_Pkg1;
procedure Aggr34 is
package My_Pkg3 is new Aggr34_Pkg3;
package My_Pkg1 is new Aggr34_Pkg1 (My_Pkg3);
begin
My_Pkg1.Proc;
end;
with Aggr34_Pkg3;
generic
with package My_Config is new Aggr34_Pkg3;
package Aggr34_Pkg2 is
procedure Disable_Prunt;
end Aggr34_Pkg2;
with Ada.Containers.Indefinite_Vectors;
generic
package Aggr34_Pkg3 is
package Config_Data_Paths is new
Ada.Containers.Indefinite_Vectors (Positive, String);
procedure Set (Path : Config_Data_Paths.Vector) is null;
end Aggr34_Pkg3;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 3bff9394c83..d2478d24ec8 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -18064,7 +18064,6 @@ package body Sem_Ch12 is
----------------------------------
procedure Save_References_In_Aggregate (N : Node_Id) is
- Nam : Node_Id;
Qual : Node_Id := Empty;
Typ : Entity_Id := Empty;
@@ -18120,16 +18119,16 @@ package body Sem_Ch12 is
end;
end if;
- -- If the aggregate is an actual in a call, it has been
- -- resolved in the current context, to some local type. The
+ -- If the aggregate is an actual in a subprogram call, it has
+ -- been resolved in the current context to some local type. The
-- enclosing call may have been disambiguated by the aggregate,
-- and this disambiguation might fail at instantiation time
-- because the type to which the aggregate did resolve is not
-- preserved. In order to preserve some of this information,
-- wrap the aggregate in a qualified expression, using the id
-- of its type. For further disambiguation we qualify the type
- -- name with its scope (if visible and not hidden by a local
- -- homograph) because both id's will have corresponding
+ -- name with its scope recursively (if visible and not hidden
+ -- by a local homograph) because both will have corresponding
-- entities in an instance. This resolves most of the problems
-- with missing type information on aggregates in instances.
@@ -18139,24 +18138,40 @@ package body Sem_Ch12 is
and then Present (Typ)
and then Comes_From_Source (Typ)
then
- Nam := Make_Identifier (Loc, Chars (Typ));
+ declare
+ function Qualify_Name (S, E : Entity_Id) return Node_Id is
+ (if E = S
+ then Make_Identifier (Loc, Chars (E))
+ else Make_Selected_Component (Loc,
+ Prefix => Qualify_Name (S, Scope (E)),
+ Selector_Name =>
+ Make_Identifier (Loc, Chars (E))));
+ -- Return the qualified name of E up to scope S
+
+ Nam : Node_Id;
+ S : Entity_Id;
- if Is_Immediately_Visible (Scope (Typ))
- and then
- (not In_Open_Scopes (Scope (Typ))
- or else Current_Entity (Scope (Typ)) = Scope (Typ))
- then
- Nam :=
- Make_Selected_Component (Loc,
- Prefix =>
- Make_Identifier (Loc, Chars (Scope (Typ))),
- Selector_Name => Nam);
- end if;
+ begin
+ S := Scope (Typ);
+ while not Is_Immediately_Visible (S) loop
+ S := Scope (S);
+ exit when Is_Generic_Unit (S);
+ end loop;
- Qual :=
- Make_Qualified_Expression (Loc,
- Subtype_Mark => Nam,
- Expression => Relocate_Node (N));
+ if not Is_Generic_Unit (S)
+ and then (not In_Open_Scopes (S)
+ or else Current_Entity (S) = S)
+ then
+ Nam := Qualify_Name (S, Typ);
+ else
+ Nam := Make_Identifier (Loc, Chars (Typ));
+ end if;
+
+ Qual :=
+ Make_Qualified_Expression (Loc,
+ Subtype_Mark => Nam,
+ Expression => Relocate_Node (N));
+ end;
end if;
-- For a full aggregate, if the type is global and a derived
