[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
This commit is contained in:
Arnaud Charlet 2014-07-17 09:00:19 +02:00
parent 52d9ba4d30
commit 8a5e4b2a8a
5 changed files with 49 additions and 11 deletions

View File

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

View File

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

View File

@ -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;

View File

@ -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 --
---------------------------

View File

@ -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;