From: Arnaud Charlet Date: Thu, 4 Aug 2011 09:01:16 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b37d5bc62b96ecbd96f409281f8741d40c4d3922;p=gcc.git [multiple changes] 2011-08-04 Hristian Kirtchev * 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 * 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 9a4c24bb71b..af7febfcdaf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2011-08-04 Hristian Kirtchev + + * 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 + + * 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 * 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 abe960b3a06..f79520edc22 100644 --- 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 988db9afaea..d31aea0ac98 100644 --- 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 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;