sem_ch10.adb (Build_Limited_Views): A type declared with a private type extension...

2005-07-04  Ed Schonberg  <schonberg@adacore.com>
	    Javier Miranda  <miranda@adacore.com>

	* sem_ch10.adb (Build_Limited_Views): A type declared with a private
	type extension needs a limited view.
	Remove previous restriction on private types available through the
	limited-view (only tagged private types were previously allowed).
	(Install_Withed_Unit): In the code that implements the
	legality rule given in AI-377, exclude a child unit with the name
	Standard, because it is a homonym of the Standard environment package.

From-SVN: r101586

diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 333d2067b42e18fb1d5477a8e7a763c5b9802b33..3d3f15327824638eafb006d88a514f17bd12d5bc 100644 (file)
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -3714,7 +3714,8 @@ package body Sem_Ch10 is
       --  instance I1 of a generic unit G1 has an explicit child unit I1.G2,
       --  G1 has a generic child also named G2, and the context includes with_
       --  clauses for both I1.G2 and for G1.G2, making an implicit declaration
-      --  of I1.G2 visible as well.
+      --  of I1.G2 visible as well. If the child unit is named Standard, do
+      --  not apply the check to the Standard package itself.
 
       if Is_Child_Unit (Uname)
         and then Is_Visible_Child_Unit (Uname)
@@ -3728,7 +3729,9 @@ package body Sem_Ch10 is
 
          begin
             U2 := Homonym (Uname);
-            while Present (U2) loop
+            while Present (U2)
+              and U2 /= Standard_Standard
+           loop
                P2 := Scope (U2);
                Decl2  := Unit_Declaration_Node (P2);
 
@@ -4057,13 +4060,15 @@ package body Sem_Ch10 is
 
                Set_Non_Limited_View (Lim_Typ, Comp_Typ);
 
-            elsif Nkind (Decl) = N_Private_Type_Declaration
-              and then Tagged_Present (Decl)
-            then
+            elsif Nkind (Decl) = N_Private_Type_Declaration then
                Comp_Typ := Defining_Identifier (Decl);
 
                if not Analyzed_Unit then
-                  Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope);
+                  if Tagged_Present (Decl) then
+                     Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope);
+                  else
+                     Decorate_Incomplete_Type (Comp_Typ, Scope);
+                  end if;
                end if;
 
                Lim_Typ  := New_Internal_Shadow_Entity
@@ -4075,8 +4080,33 @@ package body Sem_Ch10 is
                Set_Parent (Lim_Typ, Parent (Comp_Typ));
                Set_From_With_Type (Lim_Typ);
 
-               Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope);
+               if Tagged_Present (Decl) then
+                  Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope);
+               else
+                  Decorate_Incomplete_Type (Lim_Typ, Scope);
+               end if;
+
+               Set_Non_Limited_View (Lim_Typ, Comp_Typ);
+
+            elsif Nkind (Decl) = N_Private_Extension_Declaration then
+               Comp_Typ := Defining_Identifier (Decl);
 
+               if not Analyzed_Unit then
+                  Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope);
+               end if;
+
+               --  Create shadow entity for type
+
+               Lim_Typ := New_Internal_Shadow_Entity
+                 (Kind       => Ekind (Comp_Typ),
+                  Sloc_Value => Sloc (Comp_Typ),
+                  Id_Char    => 'Z');
+
+               Set_Chars  (Lim_Typ, Chars (Comp_Typ));
+               Set_Parent (Lim_Typ, Parent (Comp_Typ));
+               Set_From_With_Type (Lim_Typ);
+
+               Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope);
                Set_Non_Limited_View (Lim_Typ, Comp_Typ);
 
             elsif Nkind (Decl) = N_Package_Declaration then