diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 971d62c9719..d2381cdfcd0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2014-07-17 Robert Dewar + + * s-imguns.ads: Minor reformatting. + +2014-07-17 Hristian Kirtchev + + * exp_ch7.adb (Build_Finalization_Master): Move all local + variables to the proper code section. When looking for an existing + finalization master, inspect the ultimate ancestor type of the + full view. + * sem_util.ads, sem_util.adb (Root_Type_Of_Full_View): New routine. + 2014-07-17 Robert Dewar * aspects.ads, aspects.adb: Add entries for aspect Annotate. diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 2f6ae985249..08b47f6d70b 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -767,9 +767,6 @@ package body Exp_Ch7 is Ins_Node : Node_Id := Empty; Encl_Scope : Entity_Id := Empty) is - Desig_Typ : constant Entity_Id := Directly_Designated_Type (Typ); - Ptr_Typ : Entity_Id := Root_Type (Base_Type (Typ)); - function In_Deallocation_Instance (E : Entity_Id) return Boolean; -- Determine whether entity E is inside a wrapper package created for -- an instance of Ada.Unchecked_Deallocation. @@ -799,13 +796,19 @@ package body Exp_Ch7 is return False; end In_Deallocation_Instance; + -- Local variables + + Desig_Typ : constant Entity_Id := Directly_Designated_Type (Typ); + + Ptr_Typ : constant Entity_Id := Root_Type_Of_Full_View (Base_Type (Typ)); + -- A finalization master created for a named access type is associated + -- with the full view (if applicable) as a consequence of freezing. The + -- full view criteria does not apply to anonymous access types because + -- those cannot have a private and a full view. + -- Start of processing for Build_Finalization_Master begin - if Is_Private_Type (Ptr_Typ) and then Present (Full_View (Ptr_Typ)) then - Ptr_Typ := Full_View (Ptr_Typ); - end if; - -- Certain run-time configurations and targets do not provide support -- for controlled types. diff --git a/gcc/ada/s-imguns.ads b/gcc/ada/s-imguns.ads index c6f733a739d..134f916e368 100644 --- a/gcc/ada/s-imguns.ads +++ b/gcc/ada/s-imguns.ads @@ -30,7 +30,7 @@ ------------------------------------------------------------------------------ -- This package contains the routines for supporting the Image attribute for --- modular integer types up to Size Unsigned'Size, and also for conversion +-- modular integer types up to size Unsigned'Size, and also for conversion -- operations required in Text_IO.Modular_IO for such types. with System.Unsigned_Types; @@ -43,9 +43,9 @@ package System.Img_Uns is S : in out String; P : out Natural); pragma Inline (Image_Unsigned); - -- Computes Unsigned'Image (V) and stores the result in S (1 .. P) - -- setting the resulting value of P. The caller guarantees that S - -- is long enough to hold the result, and that S'First is 1. + -- Computes Unsigned'Image (V) and stores the result in S (1 .. P) setting + -- the resulting value of P. The caller guarantees that S is long enough to + -- hold the result, and that S'First is 1. procedure Set_Image_Unsigned (V : System.Unsigned_Types.Unsigned; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7ac496c202d..b57d6f52b64 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -15355,6 +15355,24 @@ package body Sem_Util is and then not Is_Constrained (Etype (Subp)); end Returns_Unconstrained_Type; + ---------------------------- + -- Root_Type_Of_Full_View -- + ---------------------------- + + function Root_Type_Of_Full_View (T : Entity_Id) return Entity_Id is + Rtyp : constant Entity_Id := Root_Type (T); + + begin + -- The root type of the full view may itself be a private type. Keep + -- looking for the ultimate derivation parent. + + if Is_Private_Type (Rtyp) and then Present (Full_View (Rtyp)) then + return Root_Type_Of_Full_View (Full_View (Rtyp)); + else + return Rtyp; + end if; + end Root_Type_Of_Full_View; + --------------------------- -- Safe_To_Capture_Value -- --------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 623e99228d8..e90ad18e775 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1697,6 +1697,11 @@ package Sem_Util is function Returns_Unconstrained_Type (Subp : Entity_Id) return Boolean; -- Return true if Subp is a function that returns an unconstrained type + function Root_Type_Of_Full_View (T : Entity_Id) return Entity_Id; + -- Similar to attribute Root_Type, but this version always follows the + -- Full_View of a private type (if available) while searching for the + -- ultimate derivation ancestor. + function Safe_To_Capture_Value (N : Node_Id; Ent : Entity_Id;