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 --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 854a9b1024fa172aef36d6d800160ec619fda1ba..756032f6a4cb386f93d40b8833053999518abb6d 100644 (file)
--- 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 (file)
index 0000000..fb862cd
--- /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 (file)
index 0000000..270c6a7
--- /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 (file)
index 0000000..71452f5
--- /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 (file)
index 0000000..1359763
--- /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;