This is again an issue with multiple levels of nested instances, and it arises
because the qualified name of the problematic child generic unit is used (this
works fine with the direct name), exposing the rather questionable processing
implemented for instances in Find_Expanded_Name.
The patch replaces this processing with the straightforward decoding of the
renaming scheme used in Sem_Ch12.
Tested on x86-64/Linux, applied on the mainline.
2025-10-29 Eric Botcazou <[email protected]>
PR ada/16214
* sem_ch8.adb (Find_Expanded_Name): Consolidate and streamline the
processing required for references to instances within themselves.
2025-10-29 Eric Botcazou <[email protected]>
* gnat.dg/specs/generic_inst6.ads: New test.
* gnat.dg/specs/generic_inst6_pkg1-child.ads: New helper.
* gnat.dg/specs/generic_inst6_pkg1-child-grand1.ads: Likewise.
* gnat.dg/specs/generic_inst6_pkg1-child-grand2.ads: Likewise.
* gnat.dg/specs/generic_inst6_pkg1.ads: Likewise.
* gnat.dg/specs/generic_inst6_pkg2.ads: Likewise.
* gnat.dg/specs/generic_inst6_pkg3.ads: Likewise.
--
Eric Botcazoudiff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 86344b59c7e..e9d00d0d4a2 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -7225,6 +7225,8 @@ package body Sem_Ch8 is
begin
while Present (Id) loop
+ -- The immediate case is when Id is an entity of the prefix
+
if Scope (Id) = P_Name then
Candidate := Id;
Is_New_Candidate := True;
@@ -7250,6 +7252,53 @@ package body Sem_Ch8 is
end if;
end if;
+ -- If the name of a generic child unit appears within an instance
+ -- of itself, then it is resolved to the renaming of the name of
+ -- the instance built in Sem_Ch12, so we get to the generic parent
+ -- through the renaming.
+
+ elsif Ekind (Id) in E_Function | E_Package | E_Procedure
+ and then Present (Renamed_Entity (Id))
+ and then Is_Generic_Instance (Renamed_Entity (Id))
+ and then In_Open_Scopes (Renamed_Entity (Id))
+ then
+ declare
+ Gen_Inst : constant Entity_Id := Renamed_Entity (Id);
+ Gen_Par : constant Entity_Id :=
+ Generic_Parent
+ (Specification (Unit_Declaration_Node (Gen_Inst)));
+
+ begin
+ -- The easy case is when Gen_Par is an entity of the prefix
+
+ if Scope (Gen_Par) = P_Name then
+ Is_New_Candidate := True;
+
+ -- Now the prefix may also be within an instance of itself,
+ -- but we do not need to go through the renaming for it, as
+ -- this was done on entry to the procedure.
+
+ elsif Is_Generic_Instance (P_Name)
+ and then In_Open_Scopes (P_Name)
+ then
+ declare
+ Gen_Par_P : constant Entity_Id :=
+ Generic_Parent
+ (Specification (Unit_Declaration_Node (P_Name)));
+
+ begin
+ if Scope (Gen_Par) = Gen_Par_P then
+ Is_New_Candidate := True;
+ else
+ Is_New_Candidate := False;
+ end if;
+ end;
+
+ else
+ Is_New_Candidate := False;
+ end if;
+ end;
+
-- Ada 2005 (AI-217): Handle shadow entities associated with
-- types declared in limited-withed nested packages. We don't need
-- to handle E_Incomplete_Subtype entities because the entities
@@ -7284,22 +7333,6 @@ package body Sem_Ch8 is
Candidate := Get_Full_View (Id);
Is_New_Candidate := True;
- -- An unusual case arises with a fully qualified name for an
- -- entity local to a generic child unit package, within an
- -- instantiation of that package. The name of the unit now
- -- denotes the renaming created within the instance. This is
- -- only relevant in an instance body, see below.
-
- elsif Is_Generic_Instance (Scope (Id))
- and then In_Open_Scopes (Scope (Id))
- and then In_Instance_Body
- and then Ekind (Scope (Id)) = E_Package
- and then Ekind (Id) = E_Package
- and then Renamed_Entity (Id) = Scope (Id)
- and then Is_Immediately_Visible (P_Name)
- then
- Is_New_Candidate := True;
-
else
Is_New_Candidate := False;
end if;
@@ -7434,55 +7467,6 @@ package body Sem_Ch8 is
end if;
else
- -- Within the instantiation of a child unit, the prefix may
- -- denote the parent instance, but the selector has the name
- -- of the original child. That is to say, when A.B appears
- -- within an instantiation of generic child unit B, the scope
- -- stack includes an instance of A (P_Name) and an instance
- -- of B under some other name. We scan the scope to find this
- -- child instance, which is the desired entity.
- -- Note that the parent may itself be a child instance, if
- -- the reference is of the form A.B.C, in which case A.B has
- -- already been rewritten with the proper entity.
-
- if In_Open_Scopes (P_Name)
- and then Is_Generic_Instance (P_Name)
- then
- declare
- Gen_Par : constant Entity_Id :=
- Generic_Parent (Specification
- (Unit_Declaration_Node (P_Name)));
- S : Entity_Id := Current_Scope;
- P : Entity_Id;
-
- begin
- for J in reverse 0 .. Scope_Stack.Last loop
- S := Scope_Stack.Table (J).Entity;
-
- exit when S = Standard_Standard;
-
- if Ekind (S) in E_Function | E_Package | E_Procedure
- then
- P :=
- Generic_Parent (Specification
- (Unit_Declaration_Node (S)));
-
- -- Check that P is a generic child of the generic
- -- parent of the prefix.
-
- if Present (P)
- and then Chars (P) = Chars (Selector)
- and then Scope (P) = Gen_Par
- then
- Id := S;
- goto Found;
- end if;
- end if;
-
- end loop;
- end;
- end if;
-
-- If this is a selection from Ada, System or Interfaces, then
-- we assume a missing with for the corresponding package.
@@ -7589,7 +7573,6 @@ package body Sem_Ch8 is
end if;
end if;
- <<Found>>
if Comes_From_Source (N)
and then Is_Remote_Access_To_Subprogram_Type (Id)
and then Ekind (Id) = E_Access_Subprogram_Type
-- { dg-do compile }
with Generic_Inst6_Pkg1.Child.Grand2;
with Generic_Inst6_Pkg3;
package Generic_Inst6 is new Generic_Inst6_Pkg3.Grand2;
generic
package Generic_Inst6_Pkg1.Child.Grand1 is
end Generic_Inst6_Pkg1.Child.Grand1;
with Generic_Inst6_Pkg1.Child.Grand1;
generic
package Generic_Inst6_Pkg1.Child.Grand2 is
package My_Grand1 is new Generic_Inst6_Pkg1.Child.Grand1;
end Generic_Inst6_Pkg1.Child.Grand2;
generic
package Generic_Inst6_Pkg1.Child is
end Generic_Inst6_Pkg1.Child;
with Generic_Inst6_Pkg1;
package Generic_Inst6_Pkg2 is new Generic_Inst6_Pkg1;
generic
package Generic_Inst6_Pkg1 is
end Generic_Inst6_Pkg1;
with Generic_Inst6_Pkg1.Child;
with Generic_Inst6_Pkg2;
package Generic_Inst6_Pkg3 is new Generic_Inst6_Pkg2.Child;
