sem_attr.adb: Add with and use clauses for Sem_Ch10.

2009-06-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_attr.adb: Add with and use clauses for Sem_Ch10.
	(Check_Not_Incomplete_Type): Minor reformatting. Retrieve the root type
	when dealing with class-wide types. Detect a legal shadow entity and
	retrieve its non-limited view.

	* sem_ch10.adb (Has_With_Clause): Move the spec and body of the
	subprogram to top package level from Intall_Limited_Withed_Unit.
	(Install_Limited_Withed_Unit): Remove spec and body of Has_With_Clause.
	Add check which prevents the installation of a limited view if the
	non-limited view is already visible through a with clause.
	(Is_Legal_Shadow_Entity_In_Body): New routine. Detect a residual, but
	legal shadow entity which may occur in subprogram formals of anonymous
	access type.

	* sem_ch10.ads (Is_Legal_Shadow_Entity_In_Body): New routine.

	* sem_ch3.adb (Access_Definition): Remove the propagation of flag
	From_With_Type from the designated type to the generated anonymous
	access type. Remove associated comment.

	* sem_res.adb Add with and use clauses for Sem_Ch10.
	(Full_Designated_Type): Detect a legal shadow entity and retrieve its
	non-limited view. Since the shadow entity may replace a regular
	incomplete type, return the available full view.

From-SVN: r148844

1 files changed, 72 insertions, 57 deletions

diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 8ae44ff..72a0c67 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -108,6 +108,13 @@ package body Sem_Ch10 is
    --  has not yet been rewritten as a package declaration, and the entity has
    --  to be retrieved from the Instance_Spec of the unit.
 
+   function Has_With_Clause
+     (C_Unit     : Node_Id;
+      Pack       : Entity_Id;
+      Is_Limited : Boolean := False) return Boolean;
+   --  Determine whether compilation unit C_Unit contains a with clause for
+   --  package Pack. Use flag Is_Limited to designate desired clause kind.
+
    procedure Implicit_With_On_Parent (Child_Unit : Node_Id; N : Node_Id);
    --  If the main unit is a child unit, implicit withs are also added for
    --  all its ancestors.
@@ -2802,6 +2809,49 @@ package body Sem_Ch10 is
       end if;
    end Get_Parent_Entity;
 
+   ---------------------
+   -- Has_With_Clause --
+   ---------------------
+
+   function Has_With_Clause
+     (C_Unit     : Node_Id;
+      Pack       : Entity_Id;
+      Is_Limited : Boolean := False) return Boolean
+   is
+      Item : Node_Id;
+      Nam  : Entity_Id;
+
+   begin
+      if Present (Context_Items (C_Unit)) then
+         Item := First (Context_Items (C_Unit));
+         while Present (Item) loop
+            if Nkind (Item) = N_With_Clause then
+
+               --  Retrieve the entity of the imported compilation unit
+
+               if Nkind (Name (Item)) = N_Selected_Component then
+                  Nam := Entity (Selector_Name (Name (Item)));
+               else
+                  Nam := Entity (Name (Item));
+               end if;
+
+               if Nam = Pack
+                 and then
+                   ((Is_Limited and then Limited_Present (Item))
+                       or else
+                    (not Is_Limited and then not Limited_Present (Item)))
+               then
+                  return True;
+               end if;
+            end if;
+
+            Next (Item);
+         end loop;
+      end if;
+
+      return False;
+   end Has_With_Clause;
+
    -----------------------------
    -- Implicit_With_On_Parent --
    -----------------------------
@@ -3558,12 +3608,6 @@ package body Sem_Ch10 is
                   Install_Limited_Withed_Unit (Item);
                end if;
             end if;
-
-         --  All items other than Limited_With clauses are ignored (they were
-         --  installed separately early on by Install_Context_Clause).
-
-         else
-            null;
          end if;
 
          Next (Item);
@@ -3913,14 +3957,6 @@ package body Sem_Ch10 is
       --  Determine whether any package in the ancestor chain starting with
       --  C_Unit has a limited with clause for package Pack.
 
-      function Has_With_Clause
-        (C_Unit     : Node_Id;
-         Pack       : Entity_Id;
-         Is_Limited : Boolean := False) return Boolean;
-      --  Determine whether compilation unit C_Unit contains a with clause
-      --  for package Pack. Use flag Is_Limited to designate desired clause
-      --  kind. This is a subsidiary routine to Has_Limited_With_Clause.
-
       function Is_Visible_Through_Renamings (P : Entity_Id) return Boolean;
       --  Check if some package installed though normal with-clauses has a
       --  renaming declaration of package P. AARM 10.1.2(21/2).
@@ -4253,49 +4289,6 @@ package body Sem_Ch10 is
          return False;
       end Has_Limited_With_Clause;
 
-      ---------------------
-      -- Has_With_Clause --
-      ---------------------
-
-      function Has_With_Clause
-        (C_Unit     : Node_Id;
-         Pack       : Entity_Id;
-         Is_Limited : Boolean := False) return Boolean
-      is
-         Item : Node_Id;
-         Nam  : Entity_Id;
-
-      begin
-         if Present (Context_Items (C_Unit)) then
-            Item := First (Context_Items (C_Unit));
-            while Present (Item) loop
-               if Nkind (Item) = N_With_Clause then
-
-                  --  Retrieve the entity of the imported compilation unit
-
-                  if Nkind (Name (Item)) = N_Selected_Component then
-                     Nam := Entity (Selector_Name (Name (Item)));
-                  else
-                     Nam := Entity (Name (Item));
-                  end if;
-
-                  if Nam = Pack
-                    and then
-                      ((Is_Limited and then Limited_Present (Item))
-                          or else
-                       (not Is_Limited and then not Limited_Present (Item)))
-                  then
-                     return True;
-                  end if;
-               end if;
-
-               Next (Item);
-            end loop;
-         end if;
-
-         return False;
-      end Has_With_Clause;
-
       ----------------------------------
       -- Is_Visible_Through_Renamings --
       ----------------------------------
@@ -4423,6 +4416,15 @@ package body Sem_Ch10 is
          P := Defining_Identifier (P);
       end if;
 
+      --  Do not install the limited-view if the context of the unit is already
+      --  available through a regular with clause.
+
+      if Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body
+        and then Has_With_Clause (Cunit (Current_Sem_Unit), P)
+      then
+         return;
+      end if;
+
       --  Do not install the limited-view if the full-view is already visible
       --  through renaming declarations.
 
@@ -4907,6 +4909,19 @@ package body Sem_Ch10 is
         and then Present (Parent_Spec (Lib_Unit));
    end Is_Child_Spec;
 
+   ------------------------------------
+   -- Is_Legal_Shadow_Entity_In_Body --
+   ------------------------------------
+
+   function Is_Legal_Shadow_Entity_In_Body (T : Entity_Id) return Boolean is
+      C_Unit : constant Node_Id := Cunit (Current_Sem_Unit);
+
+   begin
+      return Nkind (Unit (C_Unit)) = N_Package_Body
+        and then Has_With_Clause (C_Unit,
+                   Cunit_Entity (Get_Source_Unit (Non_Limited_View (T))));
+   end Is_Legal_Shadow_Entity_In_Body;
+
    -----------------------
    -- Load_Needed_Body --
    -----------------------