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.
This commit is contained in:
Eric Botcazou
2026-01-30 11:58:58 +01:00
parent b61b3e19f9
commit a28bb06b3e
5 changed files with 59 additions and 6 deletions

View File

@@ -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;

View File

@@ -0,0 +1,5 @@
package Limited_With3.Child.Grandchild.Grandgrandchild is
function F return T is (Three);
end Limited_With3.Child.Grandchild.Grandgrandchild;

View File

@@ -0,0 +1,5 @@
package Limited_With3.Child.Grandchild is
function F return T is (Two);
end Limited_With3.Child.Grandchild;

View File

@@ -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;

View File

@@ -0,0 +1,4 @@
limited with Limited_With3.Child;
package Limited_With3 is
end Limited_With3;