sem_ch7.adb (Install_Parent_Private_Declarations): If the private declarations of a parent unit are made visible when...

2008-03-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch7.adb (Install_Parent_Private_Declarations): If the private
	declarations of a parent unit are made visible when compiling a child
	instance, the parent is not a hidden open scope, even though it may
	contain other pending instance.
	
	* sem_ch8.adb (Restore_Scope_Stack): If an entry on the stack is a
	hidden open scope for some child instance, it does affect the
	visibility status of other stach entries.
	(Analyze_Object_Renaming): Check that a class-wide object cannot be
	renamed as an object of a specific type.

From-SVN: r133578

2 files changed, 37 insertions, 8 deletions

diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 11f24ce..2e95a1f 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -939,6 +939,7 @@ package body Sem_Ch7 is
          Inst_Par := Inst_Id;
          Gen_Par :=
            Generic_Parent (Specification (Unit_Declaration_Node (Inst_Par)));
+
          while Present (Gen_Par) and then Is_Child_Unit (Gen_Par) loop
             Inst_Node := Get_Package_Instantiation_Node (Inst_Par);
 
@@ -963,11 +964,18 @@ package body Sem_Ch7 is
                --  happens when a generic child is instantiated, and the
                --  instance is a child of the parent instance.
 
-               --  Installing the use clauses of the parent instance twice is
-               --  both unnecessary and wrong, because it would cause the
-               --  clauses to be chained to themselves in the use clauses list
-               --  of the scope stack entry. That in turn would cause
-               --  End_Use_Clauses to get into an endless look upon scope exit.
+               --  Installing the use clauses of the parent instance twice
+               --  is both unnecessary and wrong, because it would cause the
+               --  clauses to be chained to themselves in the use clauses
+               --  list of the scope stack entry. That in turn would cause
+               --  an endless loop from End_Use_Clauses upon sccope exit.
+
+               --  The parent is now fully visible. It may be a hidden open
+               --  scope if we are currently compiling some child instance
+               --  declared within it, but while the current instance is being
+               --  compiled the parent is immediately visible. In particular
+               --  its entities must remain visible if a stack save/restore
+               --  takes place through a call to Rtsfind.
 
                if Present (Gen_Par) then
                   if not In_Private_Part (Inst_Par) then
@@ -975,6 +983,7 @@ package body Sem_Ch7 is
                      Set_Use (Private_Declarations
                                 (Specification
                                    (Unit_Declaration_Node (Inst_Par))));
+                     Set_Is_Hidden_Open_Scope (Inst_Par, False);
                   end if;
 
                --  If we've reached the end of the generic instance parents,
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 609f557..b732d50 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -747,6 +747,19 @@ package body Sem_Ch8 is
 
          Resolve (Nam, T);
 
+         --  Check that a class-wide object is not being renamed as an object
+         --  of a specific type. The test for access types is needed to exclude
+         --  cases where the renamed object is a dynamically tagged access
+         --  result, such as occurs in certain expansions.
+
+         if (Is_Class_Wide_Type (Etype (Nam))
+              or else (Is_Dynamically_Tagged (Nam)
+                        and then not Is_Access_Type (T)))
+           and then not Is_Class_Wide_Type (T)
+         then
+            Error_Msg_N ("dynamically tagged expression not allowed!", Nam);
+         end if;
+
       --  Ada 2005 (AI-230/AI-254): Access renaming
 
       else pragma Assert (Present (Access_Definition (N)));
@@ -1046,7 +1059,7 @@ package body Sem_Ch8 is
          Generate_Reference (Old_P, Name (N));
 
          --  If the renaming is in the visible part of a package, then we set
-         --  In_Package_Spec for the renamed package, to prevent giving
+         --  Renamed_In_Spec for the renamed package, to prevent giving
          --  warnings about no entities referenced. Such a warning would be
          --  overenthusiastic, since clients can see entities in the renamed
          --  package via the visible package renaming.
@@ -6583,6 +6596,13 @@ package body Sem_Ch8 is
             then
                Full_Vis := True;
 
+            --  if S is the scope of some instance (which has already been
+            --  seen on the stack) it does not affect the visibility of
+            --  other scopes.
+
+            elsif Is_Hidden_Open_Scope (S) then
+               null;
+
             elsif (Ekind (S) = E_Procedure
                     or else Ekind (S) = E_Function)
               and then Has_Completion (S)