https://gcc.gnu.org/g:9e10fc177be25e5430e72a5c55ce7a36c45562c3
commit r16-4664-g9e10fc177be25e5430e72a5c55ce7a36c45562c3 Author: Eric Botcazou <[email protected]> Date: Mon Oct 27 19:10:49 2025 +0100 Ada: Fix visibility problem for implicit actual of formal subprogram 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 instead. 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. gcc/ada/ 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. gcc/testsuite/ * gnat.dg/specs/generic_inst3.ads: New test. * gnat.dg/specs/generic_inst3_pkg1.ads: New helper. * gnat.dg/specs/generic_inst3_pkg1.adb: 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. Diff: --- gcc/ada/sem_ch12.adb | 34 +++++++++++++++------- gcc/testsuite/gnat.dg/specs/generic_inst3.ads | 3 ++ gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.adb | 14 +++++++++ gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.ads | 8 +++++ gcc/testsuite/gnat.dg/specs/generic_inst3_pkg2.ads | 9 ++++++ .../gnat.dg/specs/generic_inst3_pkg3-child.ads | 9 ++++++ gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3.ads | 11 +++++++ 7 files changed, 77 insertions(+), 11 deletions(-) diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 3575b04ad963..24d276ba48ae 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; --------------------- diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3.ads b/gcc/testsuite/gnat.dg/specs/generic_inst3.ads new file mode 100644 index 000000000000..4f31d61f0cc0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/generic_inst3.ads @@ -0,0 +1,3 @@ +with Generic_Inst3_Pkg1; + +package Generic_Inst3 is new Generic_Inst3_Pkg1; diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.adb b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.adb new file mode 100644 index 000000000000..02294c270e61 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.adb @@ -0,0 +1,14 @@ +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; diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.ads b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.ads new file mode 100644 index 000000000000..3fc9c76ef36b --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.ads @@ -0,0 +1,8 @@ +-- { dg-excess-errors "no code generated" } + +generic +package Generic_Inst3_Pkg1 is + + procedure Proc; + +end Generic_Inst3_Pkg1; diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg2.ads b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg2.ads new file mode 100644 index 000000000000..9187adb34c04 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg2.ads @@ -0,0 +1,9 @@ +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; diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3-child.ads b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3-child.ads new file mode 100644 index 000000000000..dd0284314259 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3-child.ads @@ -0,0 +1,9 @@ +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; diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3.ads b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3.ads new file mode 100644 index 000000000000..29cf00f228fb --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3.ads @@ -0,0 +1,11 @@ +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;
