mirror of
https://github.com/gcc-mirror/gcc.git
synced 2026-05-06 14:59:39 +02:00
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:
@@ -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;
|
||||
|
||||
|
||||
@@ -0,0 +1,5 @@
|
||||
package Limited_With3.Child.Grandchild.Grandgrandchild is
|
||||
|
||||
function F return T is (Three);
|
||||
|
||||
end Limited_With3.Child.Grandchild.Grandgrandchild;
|
||||
@@ -0,0 +1,5 @@
|
||||
package Limited_With3.Child.Grandchild is
|
||||
|
||||
function F return T is (Two);
|
||||
|
||||
end Limited_With3.Child.Grandchild;
|
||||
7
gcc/testsuite/gnat.dg/specs/limited_with3-child.ads
Normal file
7
gcc/testsuite/gnat.dg/specs/limited_with3-child.ads
Normal 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;
|
||||
4
gcc/testsuite/gnat.dg/specs/limited_with3.ads
Normal file
4
gcc/testsuite/gnat.dg/specs/limited_with3.ads
Normal file
@@ -0,0 +1,4 @@
|
||||
limited with Limited_With3.Child;
|
||||
|
||||
package Limited_With3 is
|
||||
end Limited_With3;
|
||||
Reference in New Issue
Block a user