[multiple changes]

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.

From-SVN: r177338

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9a4c24bb71bd51526045bc6d018e27c74002b2aa..af7febfcdafe445948cf744c2df97bd3a8e59a2a 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+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.
+
 2011-08-04  Tristan Gingold  <gingold@adacore.com>
 
        * s-taprop-vxworks.adb (Enter_Task): Use System.Float_Control.Reset

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index abe960b3a065f925f37a070fcc3677d2f031085b..f79520edc2245b9cb4a8dd00813eab532162a4da 100644 (file)
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1562,38 +1562,23 @@ package body Exp_Ch7 is
 
             --  If the package spec has private declarations, the finalizer
             --  body must be added to the end of the list in order to have
-            --  visibility of all private controlled objects. The spec is
-            --  inserted at the top of the visible declarations.
+            --  visibility of all private controlled objects.
 
             if For_Package_Spec then
-               Prepend_To (Decls, Fin_Spec);
-
                if Present (Priv_Decls) then
+                  Append_To (Priv_Decls, Fin_Spec);
                   Append_To (Priv_Decls, Fin_Body);
                else
+                  Append_To (Decls, Fin_Spec);
                   Append_To (Decls, Fin_Body);
                end if;
 
-            --  For package bodies, the finalizer body is added to the
-            --  declarative region of the body and finalizer spec goes
-            --  on the visible declarations of the package spec.
+            --  For package bodies, both the finalizer spec and body are
+            --  inserted at the end of the package declarations.
 
             else
-               declare
-                  Spec_Nod  : Node_Id;
-                  Vis_Decls : List_Id;
-
-               begin
-                  Spec_Nod := Spec_Id;
-                  while Nkind (Spec_Nod) /= N_Package_Specification loop
-                     Spec_Nod := Parent (Spec_Nod);
-                  end loop;
-
-                  Vis_Decls := Visible_Declarations (Spec_Nod);
-
-                  Prepend_To (Vis_Decls, Fin_Spec);
-                  Append_To  (Decls, Fin_Body);
-               end;
+               Append_To (Decls, Fin_Spec);
+               Append_To (Decls, Fin_Body);
             end if;
 
             --  Push the name of the package

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 988db9afaea904474131f323547e54673d9d0ad4..d31aea0ac98f722be8d585dba2ed4e8b0f68a047 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -13647,7 +13647,8 @@ package body Sem_Ch3 is
                      Type_Conformant (Subp, Act_Subp,
                                       Skip_Controlling_Formals => True)))
             then
-               pragma Assert (not Is_Ancestor (Parent_Base, Generic_Actual));
+               pragma Assert (not Is_Ancestor (Parent_Base, Generic_Actual,
+                                               Use_Full_View => True));
 
                --  Remember that we need searching for all pending primitives
 

diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index e5b8b3587608e2de625989bad5872e6ff1c4c6ea..20f1c47e810e345d0a97066aeec8ac5114c9007f 100644 (file)
--- 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;