The problem is that we temporarily push onto the scope stack and install the 
declarations of a package that is already on the stack and whose declarations 
are already visible so, when the temporary condition is over, the declarations 
are uninstalled, thus making them definitively invisible.

It comes from the use of the idiom Scope_Within_Or_Same (Current_Scope, S) to 
detect whether S is open in the current scope, but that's not robust in the 
presence of transient scopes or during instantiation of generic units.

Tested on x86-64/Linux, applied on the mainline and 15 branch.


2026-01-21  Eric Botcazou  <[email protected]>

        PR ada/123580
        * sem_ch13.adb (Analyze_Aspects_At_Freeze_Point): Replace call to
        Scope_Within_Or_Same (Current_Scope, S) with In_Open_Scopes (S) to
        test whether S is open in the current scope.
        * sem_util.adb (From_Nested_Package): Likewise.


2026-01-21  Eric Botcazou  <[email protected]>

        * gnat.dg/generic_inst16.adb: New test.
        * gnat.dg/generic_inst16_pkg.ads: New helper.
        * gnat.dg/generic_inst16_pkg-child.ads: Likewise.
        * gnat.dg/generic_inst16_pkg-child-grandchild.ads: Likewise.
        * gnat.dg/generic_inst16_proc.ads: Likewise.
        * gnat.dg/generic_inst16_proc.adb: Likewise.

-- 
Eric Botcazou
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 9367d438e58..c569bd6dd37 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1527,9 +1527,7 @@ package body Sem_Ch13 is
       --  at the ends of certain declaration lists (like visible-part lists),
       --  not when this procedure is called at arbitrary freeze points.
 
-      if not Nonoverridable_Only
-        and then not Scope_Within_Or_Same (Current_Scope, Scope (E))
-      then
+      if not Nonoverridable_Only and then not In_Open_Scopes (Scope (E)) then
          if Is_Type (E) and then From_Nested_Package (E) then
             declare
                Pack : constant Entity_Id := Scope (E);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 8a7f1774aed..bce854fddb7 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -9868,7 +9868,7 @@ package body Sem_Util is
       return
         Ekind (Pack) = E_Package
           and then not Is_Frozen (Pack)
-          and then not Scope_Within_Or_Same (Current_Scope, Pack)
+          and then not In_Open_Scopes (Pack)
           and then In_Open_Scopes (Scope (Pack));
    end From_Nested_Package;
 
-- { dg-do link }

with Generic_Inst16_Pkg.Child.Grandchild;
with Generic_Inst16_Proc;

procedure Generic_Inst16 is
   package   P1 is new Generic_Inst16_Pkg.Child;
   procedure P2 is new Generic_Inst16_Proc (P1);
begin
   null;
end;
generic
package Generic_Inst16_Pkg.Child.Grandchild is

   type CT is new GPT with private;

   Zippo_CT1 : constant CT;
   Zippo_CT2 : constant CT;

private

   type CT is new PT with
      record
         Small_Pi : Natural := 314;
      end record;

   Zippo_CT1 : constant CT := (Zippo_PT with Small_Pi => 0);
   Zippo_CT2 : constant CT :=
     (Generic_Inst16_Pkg.Child.Zippo_PT with Small_Pi => 0);

end Generic_Inst16_Pkg.Child.Grandchild;
generic
package Generic_Inst16_Pkg.Child is

   type PT is new GPT with private;

   Zippo_PT : constant PT;
   
private
   
   type PT is new GPT with
      record
         Pos_Pi : Natural := 314159265;
      end record;

   Zippo_PT : constant PT := (Pos_Pi => 0);

end Generic_Inst16_Pkg.Child;
package Generic_Inst16_Pkg is

   type GPT is interface;

end Generic_Inst16_Pkg;
with Generic_Inst16_Pkg.Child.Grandchild;

procedure Generic_Inst16_Proc is
   package Inst_Grandchild is new Inst_Child.Grandchild;
begin
   null;
end;
with Generic_Inst16_Pkg.Child;

generic
   with package Inst_Child is new Generic_Inst16_Pkg.Child (<>);
procedure Generic_Inst16_Proc;

Reply via email to