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

6 files changed, 145 insertions, 81 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8546e6f..d0c9c6c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+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.
+
 2009-06-23  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch10.adb (Remove_Limited_With_Clause): Clean up code that handles
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 51536ae..bc68b86 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -51,6 +51,7 @@ with Sem_Aux;  use Sem_Aux;
 with Sem_Cat;  use Sem_Cat;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
+with Sem_Ch10; use Sem_Ch10;
 with Sem_Dist; use Sem_Dist;
 with Sem_Elim; use Sem_Elim;
 with Sem_Eval; use Sem_Eval;
@@ -1345,15 +1346,32 @@ package body Sem_Attr is
                E := Prefix (E);
             end loop;
 
-            if From_With_Type (Etype (E)) then
+            Typ := Etype (E);
+
+            if From_With_Type (Typ) then
                Error_Attr_P
                  ("prefix of % attribute cannot be an incomplete type");
 
             else
-               if Is_Access_Type (Etype (E)) then
-                  Typ := Directly_Designated_Type (Etype (E));
-               else
-                  Typ := Etype (E);
+               if Is_Access_Type (Typ) then
+                  Typ := Directly_Designated_Type (Typ);
+               end if;
+
+               if Is_Class_Wide_Type (Typ) then
+                  Typ := Root_Type (Typ);
+               end if;
+
+               --  A legal use of a shadow entity occurs only when the unit
+               --  where the non-limited view resides is imported via a regular
+               --  with clause in the current body. Such references to shadow
+               --  entities may occur in subprogram formals.
+
+               if Is_Incomplete_Type (Typ)
+                 and then From_With_Type (Typ)
+                 and then Present (Non_Limited_View (Typ))
+                 and then Is_Legal_Shadow_Entity_In_Body (Typ)
+               then
+                  Typ := Non_Limited_View (Typ);
                end if;
 
                if Ekind (Typ) = E_Incomplete_Type
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 --
    -----------------------
diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads
index 066ceec..9bf19ed 100644
--- a/gcc/ada/sem_ch10.ads
+++ b/gcc/ada/sem_ch10.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -43,6 +43,11 @@ package Sem_Ch10 is
    --  its private part, compiling a private child unit, or compiling the
    --  private declarations of a public child unit.
 
+   function Is_Legal_Shadow_Entity_In_Body (T : Entity_Id) return Boolean;
+   --  Assuming that type T is an incomplete type coming from a limited with
+   --  view, determine whether the package where T resides is imported through
+   --  a regular with clause in the current package body.
+
    procedure Remove_Context (N : Node_Id);
    --  Removes the entities from the context clause of the given compilation
    --  unit from the visibility chains. This is done on exit from a unit as
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index df1a500..7479d75 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -840,8 +840,8 @@ package body Sem_Ch3 is
       Desig_Type := Entity (Subtype_Mark (N));
 
       Set_Directly_Designated_Type
-                             (Anon_Type, Desig_Type);
-      Set_Etype              (Anon_Type, Anon_Type);
+                (Anon_Type, Desig_Type);
+      Set_Etype (Anon_Type, Anon_Type);
 
       --  Make sure the anonymous access type has size and alignment fields
       --  set, as required by gigi. This is necessary in the case of the
@@ -873,11 +873,6 @@ package body Sem_Ch3 is
 
       Set_Is_Public (Anon_Type, Is_Public (Scope (Anon_Type)));
 
-      --  Ada 2005 (AI-50217): Propagate the attribute that indicates that the
-      --  designated type comes from the limited view.
-
-      Set_From_With_Type (Anon_Type, From_With_Type (Desig_Type));
-
       --  Ada 2005 (AI-231): Propagate the access-constant attribute
 
       Set_Is_Access_Constant (Anon_Type, Constant_Present (N));
@@ -960,7 +955,7 @@ package body Sem_Ch3 is
       --  introduce semantic dependencies.
 
       elsif Nkind (Related_Nod) = N_Function_Specification
-        and then not From_With_Type (Anon_Type)
+        and then not From_With_Type (Desig_Type)
       then
          if Present (Enclosing_Prot_Type) then
             Build_Itype_Reference (Anon_Type, Parent (Enclosing_Prot_Type));
@@ -12046,11 +12041,10 @@ package body Sem_Ch3 is
       elsif Chars (Parent_Subp) = Name_Op_Eq
         and then Is_Dispatching_Operation (Parent_Subp)
         and then Etype (Parent_Subp) = Standard_Boolean
+        and then not Is_Limited_Type (Etype (First_Formal (Parent_Subp)))
         and then
-          not Is_Limited_Type (Etype (First_Formal (Parent_Subp)))
-        and then
-          Etype (First_Formal (Parent_Subp))
-          = Etype (Next_Formal (First_Formal (Parent_Subp)))
+          Etype (First_Formal (Parent_Subp)) =
+            Etype (Next_Formal (First_Formal (Parent_Subp)))
       then
          Set_Derived_Name;
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e1a934b..e2c6103 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -57,6 +57,7 @@ with Sem_Cat;  use Sem_Cat;
 with Sem_Ch4;  use Sem_Ch4;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
+with Sem_Ch10; use Sem_Ch10;
 with Sem_Ch13; use Sem_Ch13;
 with Sem_Disp; use Sem_Disp;
 with Sem_Dist; use Sem_Dist;
@@ -9619,16 +9620,20 @@ package body Sem_Res is
             --------------------------
 
             function Full_Designated_Type (T : Entity_Id) return Entity_Id is
-               Desig : constant Entity_Id := Designated_Type (T);
+               Desig : Entity_Id := Designated_Type (T);
+
             begin
-               if From_With_Type (Desig)
-                 and then Is_Incomplete_Type (Desig)
+               --  Detect a legal use of a shadow entity
+
+               if Is_Incomplete_Type (Desig)
+                 and then From_With_Type (Desig)
                  and then Present (Non_Limited_View (Desig))
+                 and then Is_Legal_Shadow_Entity_In_Body (Desig)
                then
-                  return Non_Limited_View (Desig);
-               else
-                  return Desig;
+                  Desig := Non_Limited_View (Desig);
                end if;
+
+               return Available_View (Desig);
             end Full_Designated_Type;
 
             --  Local Declarations