https://gcc.gnu.org/g:a28bb06b3e20a26579e06dc1b5bd6344ce4f88f0
commit r16-7186-ga28bb06b3e20a26579e06dc1b5bd6344ce4f88f0 Author: Eric Botcazou <[email protected]> Date: Fri Jan 30 11:58:58 2026 +0100 Ada: Fix spurious visibility error from limited_with clause in hierarchy The problem is that the compiler installs the limited view of a package that is already installed by the virtue of being an ancestor of the main unit. gcc/ada/ PR ada/123867 * sem_ch10.adb (Analyze_Compilation_Unit): Output info message when -gnatdi is specified. (Install_Parents): Likewise. Set the Is_Visible_Lib_Unit flag on the unit. (Install_Private_With_Clauses): Do not output info message here. (Remove_Parents): Output info message when -gnatdi is specified and clear the Is_Visible_Lib_Unit flag on the unit. gcc/testsuite/ * gnat.dg/specs/limited_with3.ads: New test. * gnat.dg/specs/limited_with3-child.ads: New helper. * gnat.dg/specs/limited_with3-child-grandchild.ads: Likewise. * gnat.dg/specs/limited_with3-child-grandchild-grandgrandchild.ads: Likewise. Diff: --- gcc/ada/sem_ch10.adb | 44 +++++++++++++++++++--- ...ited_with3-child-grandchild-grandgrandchild.ads | 5 +++ .../specs/limited_with3-child-grandchild.ads | 5 +++ .../gnat.dg/specs/limited_with3-child.ads | 7 ++++ gcc/testsuite/gnat.dg/specs/limited_with3.ads | 4 ++ 5 files changed, 59 insertions(+), 6 deletions(-) diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 854a9b1024fa..756032f6a4cb 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1134,6 +1134,20 @@ package body Sem_Ch10 is -- Now analyze the unit (package, subprogram spec, body) itself + if Debug_Flag_I then + if Nkind (Unit_Node) in N_Package_Declaration + | N_Package_Renaming_Declaration + | N_Subprogram_Declaration + | N_Generic_Declaration + or else (Nkind (Unit_Node) = N_Subprogram_Body + and then Acts_As_Spec (Unit_Node)) + then + Write_Str ("install unit "); + Write_Name (Chars (Defining_Entity (Unit_Node))); + Write_Eol; + end if; + end if; + Analyze (Unit_Node); if Warn_On_Redundant_Constructs then @@ -4675,6 +4689,18 @@ package body Sem_Ch10 is end if; end if; + if Debug_Flag_I then + Write_Str ("install parent unit "); + Write_Name (Chars (P_Name)); + Write_Eol; + end if; + + -- Skip this for predefined units because of the rtsfind mechanism + + if not In_Predefined_Unit (P_Name) then + Set_Is_Visible_Lib_Unit (P_Name); + end if; + -- This is the recursive call that ensures all parents are loaded if Is_Child_Spec (P) then @@ -4747,12 +4773,6 @@ package body Sem_Ch10 is Item : Node_Id; begin - if Debug_Flag_I then - Write_Str ("install private with clauses of "); - Write_Name (Chars (P)); - Write_Eol; - end if; - if Nkind (Parent (Decl)) = N_Compilation_Unit then Item := First (Context_Items (Parent (Decl))); while Present (Item) loop @@ -7319,6 +7339,18 @@ package body Sem_Ch10 is -- in the reverse order of their installation. Remove_Parents (P); + + if Debug_Flag_I then + Write_Str ("remove parent unit "); + Write_Name (Chars (P_Name)); + Write_Eol; + end if; + + -- Skip this for predefined units because of the rtsfind mechanism + + if not In_Predefined_Unit (P_Name) then + Set_Is_Visible_Lib_Unit (P_Name, False); + end if; end if; end Remove_Parents; diff --git a/gcc/testsuite/gnat.dg/specs/limited_with3-child-grandchild-grandgrandchild.ads b/gcc/testsuite/gnat.dg/specs/limited_with3-child-grandchild-grandgrandchild.ads new file mode 100644 index 000000000000..fb862cd4b911 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/limited_with3-child-grandchild-grandgrandchild.ads @@ -0,0 +1,5 @@ +package Limited_With3.Child.Grandchild.Grandgrandchild is + + function F return T is (Three); + +end Limited_With3.Child.Grandchild.Grandgrandchild; diff --git a/gcc/testsuite/gnat.dg/specs/limited_with3-child-grandchild.ads b/gcc/testsuite/gnat.dg/specs/limited_with3-child-grandchild.ads new file mode 100644 index 000000000000..270c6a7ef147 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/limited_with3-child-grandchild.ads @@ -0,0 +1,5 @@ +package Limited_With3.Child.Grandchild is + + function F return T is (Two); + +end Limited_With3.Child.Grandchild; diff --git a/gcc/testsuite/gnat.dg/specs/limited_with3-child.ads b/gcc/testsuite/gnat.dg/specs/limited_with3-child.ads new file mode 100644 index 000000000000..71452f561516 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/limited_with3-child.ads @@ -0,0 +1,7 @@ +package Limited_With3.Child is + + type T is (One, Two, Three); + + function F return T is (One); + +end Limited_With3.Child; diff --git a/gcc/testsuite/gnat.dg/specs/limited_with3.ads b/gcc/testsuite/gnat.dg/specs/limited_with3.ads new file mode 100644 index 000000000000..13597635da58 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/limited_with3.ads @@ -0,0 +1,4 @@ +limited with Limited_With3.Child; + +package Limited_With3 is +end Limited_With3;
