[multiple changes]

2014-07-17  Robert Dewar  <dewar@adacore.com>

	* s-imguns.ads: Minor reformatting.

2014-07-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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.

From-SVN: r212733

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 971d62c9719b5ca2d41bcbdb7ef5c3cd07a383aa..d2381cdfcd05e00a5f467b7b15a0a3f89c134a6e 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2014-07-17  Robert Dewar  <dewar@adacore.com>
+
+       * s-imguns.ads: Minor reformatting.
+
+2014-07-17  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * 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  <dewar@adacore.com>
 
        * aspects.ads, aspects.adb: Add entries for aspect Annotate.

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 2f6ae985249d507556a0eff6f94b6fc65e6b0913..08b47f6d70b2259f2415cee4a49921e6ae9bc14b 100644 (file)
--- 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 c6f733a739d35cc67a7616b7909fdb239db7d49d..134f916e36842e8f2a1ddf07cf5e4aba933119e6 100644 (file)
--- 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 7ac496c202ddc941d5e6fbd9081a1ec26ddb408e..b57d6f52b6438f32e2971abe31ea6cac29ccec7f 100644 (file)
--- 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 623e99228d833980a7751547ce4ef0fa473be3ae..e90ad18e775a964e2a26d4094bef20364b8e2571 100644 (file)
--- 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;