[Ada] Visibility error in the presence of private limited with clauses

[Arnaud Charlet]

This patch fixes a visibility error when compiling a unit DDP, when an
ancestor P of DDP has a private limited with clause on a descendant of P that
is itself an ancestor of DDP.

The following must compile quietly:
   
      gcc -c -gnat05 bg-el-lc.adb

---
package body BG.El.LC is
   overriding procedure Bind (E : access One_Port; K : in AKind) is
   begin
      null;
   end Bind;
end BG.El.LC;
---
package BG.El.LC is
   type Component is abstract new Element with null record;

private

   type One_Port is new Component with null record;

   overriding procedure Bind (E : access One_Port; K : in AKind);

end BG.El.LC;
---
with Ada.Strings.Bounded;
private
    package BG.El is

   type Element is abstract tagged private;

   type AKind is (A, B);

   procedure Bind (E : access Element; K : in AKind) is abstract;

private

   type Element is abstract tagged null record;
end BG.El;
---
limited private with BG.El;
package BG is

   type Object is abstract tagged limited private;

   procedure Bind (Graph : in out Object) is abstract;

private
   type Object is abstract tagged limited null record;
end BG;

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-10-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Is_Ancestor_Unit): Make global, for use elsewhere.
	(Install_Private_with_Clauses): if clause is private and limited,
	do not install the limited view if the library unit is an ancestor
	of the unit being compiled.  This unusual configuration occurs
	when compiling a unit DDP, when an ancestor P of DDP has a
	private limited with clause on a descendant of P that is itself
	an ancestor of DDP.

-------------- next part --------------
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb	(revision 192066)
+++ sem_ch10.adb	(working copy)
@@ -164,6 +164,11 @@
    --  an enclosing scope. Iterate over context to find child units of U_Name
    --  or of some ancestor of it.
 
+   function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean;
+   --  When compiling a unit Q descended from some parent unit P, a limited
+   --  with_clause in the context of P that names some other ancestor of Q
+   --  must not be installed because the ancestor is immediately visible.
+
    function Is_Child_Spec (Lib_Unit : Node_Id) return Boolean;
    --  Lib_Unit is a library unit which may be a spec or a body. Is_Child_Spec
    --  returns True if Lib_Unit is a library spec which is a child spec, i.e.
@@ -3521,11 +3526,6 @@
       --  units. The shadow entities are created when the inserted clause is
       --  analyzed. Implements Ada 2005 (AI-50217).
 
-      function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean;
-      --  When compiling a unit Q descended from some parent unit P, a limited
-      --  with_clause in the context of P that names some other ancestor of Q
-      --  must not be installed because the ancestor is immediately visible.
-
       ---------------------
       -- Check_Renamings --
       ---------------------
@@ -3794,22 +3794,6 @@
          end if;
       end Expand_Limited_With_Clause;
 
-      ----------------------
-      -- Is_Ancestor_Unit --
-      ----------------------
-
-      function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean is
-         E1 : constant Entity_Id := Defining_Entity (Unit (U1));
-         E2 : Entity_Id;
-      begin
-         if Nkind_In (Unit (U2), N_Package_Body, N_Subprogram_Body) then
-            E2 := Defining_Entity (Unit (Library_Unit (U2)));
-            return Is_Ancestor_Package (E1, E2);
-         else
-            return False;
-         end if;
-      end Is_Ancestor_Unit;
-
    --  Start of processing for Install_Limited_Context_Clauses
 
    begin
@@ -4061,8 +4045,17 @@
             if Nkind (Item) = N_With_Clause
               and then Private_Present (Item)
             then
+               --  If the unit is an ancestor of the current one, it is the
+               --  case of a private limited with clause on a child unit, and
+               --  the compilation of one of its descendants, In that case the
+               --  limited view is errelevant.
+
                if Limited_Present (Item) then
-                  if not Limited_View_Installed (Item) then
+                  if not Limited_View_Installed (Item)
+                    and then
+                      not Is_Ancestor_Unit (Library_Unit (Item),
+                                            Cunit (Current_Sem_Unit))
+                  then
                      Install_Limited_Withed_Unit (Item);
                   end if;
                else
@@ -5269,6 +5262,22 @@
             (C_Unit, Cunit_Entity (Get_Source_Unit (Non_Limited_View (T))));
    end Is_Legal_Shadow_Entity_In_Body;
 
+   ----------------------
+   -- Is_Ancestor_Unit --
+   ----------------------
+
+   function Is_Ancestor_Unit (U1 : Node_Id; U2 : Node_Id) return Boolean is
+      E1 : constant Entity_Id := Defining_Entity (Unit (U1));
+      E2 : Entity_Id;
+   begin
+      if Nkind_In (Unit (U2), N_Package_Body, N_Subprogram_Body) then
+         E2 := Defining_Entity (Unit (Library_Unit (U2)));
+         return Is_Ancestor_Package (E1, E2);
+      else
+         return False;
+      end if;
+   end Is_Ancestor_Unit;
+
    -----------------------
    -- Load_Needed_Body --
    -----------------------