2011-08-04 Hristian Kirtchev <kirtchev@adacore.com>

	* exp_ch7.adb (Create_Finalizer): Remove local variables Spec_Nod and
	Vis_Decls. When creating a library-level finalizer for a package spec,
	both the declaration and body of the finalizer are inserted either in
	the visible or private declarations of the package spec.

2011-08-04  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Derive_Subprograms): Complete assertion to request the
	use of the full-view of a type when invoking Is_Ancestor.
	* sem_type.adb (Is_Ancestor): For consistency, when the traversal of
	the full-view of private parents is requested, then use also the
	full-view of the parent of the first derivation.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177338 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 23 insertions, 8 deletions

diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index e5b8b358760..20f1c47e810 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -2656,7 +2656,23 @@ package body Sem_Type is
          return True;
 
       else
-         Par := Etype (BT2);
+         --  Obtain the parent of the base type of T2 (use the full view if
+         --  allowed).
+
+         if Use_Full_View
+           and then Is_Private_Type (BT2)
+           and then Present (Full_View (BT2))
+         then
+            --  No climbing needed if its full view is the root type
+
+            if Full_View (BT2) = Root_Type (Full_View (BT2)) then
+               return False;
+            end if;
+
+            Par := Etype (Full_View (BT2));
+         else
+            Par := Etype (BT2);
+         end if;
 
          loop
             --  If there was a error on the type declaration, do not recurse
@@ -2677,10 +2693,14 @@ package body Sem_Type is
             then
                return True;
 
-            --  Climb to the ancestor type
+            --  Root type found
 
-            elsif Etype (Par) /= Par then
+            elsif Par = Root_Type (Par) then
+               return False;
+
+            --  Continue climbing
 
+            else
                --  Use the full-view of private types (if allowed)
 
                if Use_Full_View
@@ -2691,11 +2711,6 @@ package body Sem_Type is
                else
                   Par := Etype (Par);
                end if;
-
-            --  For all other cases return False, not an Ancestor
-
-            else
-               return False;
             end if;
          end loop;
       end if;