If an actual parameter for a formal subprogram parameter of a generic unit,
whose default is specified by a box, is omitted, then an implicit actual with
the name of the formal is used and resolved in the context of the instance.
If this context is a generic unit, and these implicit actuals are resolved to
global references, then these implicit actuals need to be retrofitted into the
unanalyzed copy of the generic unit, so that instances of this generic unit do
not resolve again the implicit actuals but inherit the global references.
This works fine for instances whose name is a direct name but not for those
whose name is an expanded name (in GNAT parlance). The patch also contains a
small cleanup for a related procedure.
Tested on x86-64/Linux, applied on the mainline.
2025-10-27 Eric Botcazou <[email protected]>
PR ada/25988
* sem_ch12.adb (Save_Global_References.Reset_Entity): Also call
Save_Global_Defaults for instances with an expanded name.
(Save_Global_References.Save_References): Minor code cleanup.
2025-10-27 Eric Botcazou <[email protected]>
* gnat.dg/specs/generic_inst3.ads: New test.
* gnat.dg/specs/generic_inst3_pkg1.ad[sb]: New helper.
* gnat.dg/specs/generic_inst3_pkg2.ads: Likewise.
* gnat.dg/specs/generic_inst3_pkg3.ads: Likewise.
* gnat.dg/specs/generic_inst3_pkg3-child.ads: Likewise.
--
Eric Botcazoudiff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 3575b04ad96..24d276ba48a 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -17639,6 +17639,8 @@ package body Sem_Ch12 is
Set_Etype (N2, E);
end if;
+ -- If the entity is global, save its type in the generic node
+
if Is_Global (E) then
Set_Global_Type (N, N2);
@@ -17659,12 +17661,24 @@ package body Sem_Ch12 is
Set_Etype (N, Empty);
end if;
+ -- If default actuals have been added to a generic instantiation
+ -- and they are global, save them in the generic node.
+
if Nkind (Parent (N)) in N_Generic_Instantiation
and then N = Name (Parent (N))
then
Save_Global_Defaults (Parent (N), Parent (N2));
end if;
+ if Nkind (Parent (N)) = N_Selected_Component
+ and then N = Selector_Name (Parent (N))
+ and then Nkind (Parent (Parent (N))) in N_Generic_Instantiation
+ and then Parent (N) = Name (Parent (Parent (N)))
+ then
+ Save_Global_Defaults
+ (Parent (Parent (N)), Parent (Parent (N2)));
+ end if;
+
elsif Nkind (Parent (N)) = N_Selected_Component
and then Nkind (Parent (N2)) = N_Expanded_Name
then
@@ -18488,12 +18502,13 @@ package body Sem_Ch12 is
elsif Nkind (N) = N_Pragma then
Save_References_In_Pragma (N);
+ -- Aspects
+
elsif Nkind (N) = N_Aspect_Specification then
declare
P : constant Node_Id := Parent (N);
- Expr : Node_Id;
- begin
+ begin
if Permits_Aspect_Specifications (P) then
-- The capture of global references within aspects
@@ -18505,15 +18520,11 @@ package body Sem_Ch12 is
if Requires_Delayed_Save (Original_Node (P)) then
null;
- -- Otherwise save all global references within the
- -- aspects
-
- else
- Expr := Expression (N);
+ -- Otherwise save all global references within the
+ -- expression of the aspect.
- if Present (Expr) then
- Save_Global_References (Expr);
- end if;
+ elsif Present (Expression (N)) then
+ Save_Global_References (Expression (N));
end if;
end if;
end;
@@ -18523,10 +18534,11 @@ package body Sem_Ch12 is
elsif Nkind (N) = N_Implicit_Label_Declaration then
null;
+ -- Other nodes
+
else
Save_References_In_Descendants (N);
end if;
-
end Save_References;
---------------------
with Generic_Inst3_Pkg1;
package Generic_Inst3 is new Generic_Inst3_Pkg1;
with Generic_Inst3_Pkg2; use Generic_Inst3_Pkg2;
with Generic_Inst3_Pkg3, Generic_Inst3_Pkg3.Child;
package body Generic_Inst3_Pkg1 is
package Pkg3 is new Generic_Inst3_Pkg3 (T);
use Pkg3;
package Child is new Pkg3.Child;
procedure Proc is null;
end Generic_Inst3_Pkg1;
-- { dg-excess-errors "no code generated" }
generic
package Generic_Inst3_Pkg1 is
procedure Proc;
end Generic_Inst3_Pkg1;
package Generic_Inst3_Pkg2 is
type T is new Integer;
procedure S_One (N: in out T) is null;
procedure S_Two (N: in out T) is null;
end Generic_Inst3_Pkg2;
generic
with procedure S_Two (N: in out Number) is <>;
package Generic_Inst3_Pkg3.Child is
procedure Two (N: in out Number) renames S_Two;
end Generic_Inst3_Pkg3.Child;
generic
type Number is private;
with procedure S_One (N: in out Number) is <>;
package Generic_Inst3_Pkg3 is
procedure One (N: in out Number) renames S_One;
end Generic_Inst3_Pkg3;
