OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2015-05-12  Ed Schonberg  <schonberg@adacore.com>

	* a-coormu.ads, a-coormu.adb: Add Indexing aspect, Reference_Type,
	and Reference_Control_Type to support element iterators over
	ordered multisets.
	* a-ciormu.ads, a-ciormu.adb: Ditto for
	indefinite_ordered_multisets.

2015-05-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_N_Expression_With_Actions): Force
	the evaluation of the EWA expression.  Code cleanup.
	(Process_Transient_Object): Code cleanup.
	* exp_util.adb (Is_Aliased): Controlled transient objects found
	within EWA nodes are not aliased.
	(Is_Finalizable_Transient): Iterators are not finalizable transients.

From-SVN: r223076
This commit is contained in:
Arnaud Charlet 2015-05-12 17:11:29 +02:00
parent 7858300e04
commit 4b17187f23
7 changed files with 373 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gcc/ada/ChangeLog
View File

@ -1,3 +1,20 @@
2015-05-12 Ed Schonberg <schonberg@adacore.com>
* a-coormu.ads, a-coormu.adb: Add Indexing aspect, Reference_Type,
and Reference_Control_Type to support element iterators over
ordered multisets.
* a-ciormu.ads, a-ciormu.adb: Ditto for
indefinite_ordered_multisets.
2015-05-12 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Expand_N_Expression_With_Actions): Force
the evaluation of the EWA expression. Code cleanup.
(Process_Transient_Object): Code cleanup.
* exp_util.adb (Is_Aliased): Controlled transient objects found
within EWA nodes are not aliased.
(Is_Finalizable_Transient): Iterators are not finalizable transients.
2015-05-12 Robert Dewar <dewar@adacore.com>
* sem_prag.adb (Process_Atomic_Independent_Shared_Volatile):

56
gcc/ada/a-ciormu.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -353,6 +353,45 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
return Node.Color;
end Color;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Constant_Reference");
-- Note: in predefined container units, the creation of a reference
-- increments the busy bit of the container, and its finalization
-- decrements it. In the absence of control machinery, this tampering
-- protection is missing.
declare
T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
pragma Unreferenced (T);
begin
return R : constant Constant_Reference_Type :=
(Element => Position.Node.Element,
Control => (Container => Container'Unrestricted_Access))
do
null;
end return;
end;
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1730,6 +1769,14 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
raise Program_Error with "attempt to stream set cursor";
end Read;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
---------------------
-- Replace_Element --
---------------------
@ -2055,4 +2102,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
raise Program_Error with "attempt to stream set cursor";
end Write;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Write;
end Ada.Containers.Indefinite_Ordered_Multisets;

41
gcc/ada/a-ciormu.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -52,8 +52,9 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
-- otherwise, it returns True.
type Set is tagged private
with Default_Iterator => Iterate,
Iterator_Element => Element_Type;
with Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
pragma Preelaborable_Initialization (Set);
@ -128,6 +129,15 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
-- change the value of the element while Process is executing (to "tamper
-- with elements") will raise Program_Error.
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with Implicit_Dereference => Element;
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type;
pragma Inline (Constant_Reference);
procedure Assign (Target : in out Set; Source : Set);
function Copy (Source : Set) return Set;
@ -469,6 +479,19 @@ private
type Set_Access is access all Set;
for Set_Access'Storage_Size use 0;
-- In all predefined libraries the following type is controlled, for proper
-- management of tampering checks. For performance reason we omit this
-- machinery for multisets, which are used in a number of our tools.
type Reference_Control_Type is record
Container : Set_Access;
end record;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is record
Control : Reference_Control_Type;
end record;
type Cursor is record
Container : Set_Access;
Node : Node_Access;
@ -500,6 +523,18 @@ private
for Set'Read use Read;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
Empty_Set : constant Set :=
(Controlled with Tree => (First => null,
Last => null,

56
gcc/ada/a-coormu.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -321,6 +321,45 @@ package body Ada.Containers.Ordered_Multisets is
return Node.Color;
end Color;
------------------------
-- Constant_Reference --
------------------------
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
end if;
pragma Assert (Vet (Position.Container.Tree, Position.Node),
"bad cursor in Constant_Reference");
-- Note: in predefined container units, the creation of a reference
-- increments the busy bit of the container, and its finalization
-- decrements it. In the absence of control machinery, this tampering
-- protection is missing.
declare
T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
pragma Unreferenced (T);
begin
return R : constant Constant_Reference_Type :=
(Element => Position.Node.Element'Unrestricted_Access,
Control => (Container => Container'Unrestricted_Access))
do
null;
end return;
end;
end Constant_Reference;
--------------
-- Contains --
--------------
@ -1638,6 +1677,14 @@ package body Ada.Containers.Ordered_Multisets is
raise Program_Error with "attempt to stream set cursor";
end Read;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Read;
---------------------
-- Replace_Element --
---------------------
@ -1937,4 +1984,11 @@ package body Ada.Containers.Ordered_Multisets is
raise Program_Error with "attempt to stream set cursor";
end Write;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type)
is
begin
raise Program_Error with "attempt to stream reference";
end Write;
end Ada.Containers.Ordered_Multisets;

41
gcc/ada/a-coormu.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -51,8 +51,9 @@ package Ada.Containers.Ordered_Multisets is
-- otherwise, it returns True.
type Set is tagged private
with Default_Iterator => Iterate,
Iterator_Element => Element_Type;
with Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
pragma Preelaborable_Initialization (Set);
@ -127,6 +128,15 @@ package Ada.Containers.Ordered_Multisets is
-- change the value of the element while Process is executing (to "tamper
-- with elements") will raise Program_Error.
type Constant_Reference_Type
(Element : not null access constant Element_Type) is private
with Implicit_Dereference => Element;
function Constant_Reference
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type;
pragma Inline (Constant_Reference);
procedure Assign (Target : in out Set; Source : Set);
function Copy (Source : Set) return Set;
@ -473,6 +483,19 @@ private
type Set_Access is access all Set;
for Set_Access'Storage_Size use 0;
-- In all predefined libraries the following type is controlled, for proper
-- management of tampering checks. For performance reason we omit this
-- machinery for multisets, which are used in a number of our tools.
type Reference_Control_Type is record
Container : Set_Access;
end record;
type Constant_Reference_Type
(Element : not null access constant Element_Type) is record
Control : Reference_Control_Type;
end record;
type Cursor is record
Container : Set_Access;
Node : Node_Access;
@ -504,6 +527,18 @@ private
for Set'Read use Read;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Constant_Reference_Type);
for Constant_Reference_Type'Read use Read;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Item : Constant_Reference_Type);
for Constant_Reference_Type'Write use Write;
Empty_Set : constant Set :=
(Controlled with Tree => (First => null,
Last => null,

217
gcc/ada/exp_ch4.adb
View File

@ -5090,7 +5090,6 @@ package body Exp_Ch4 is
--------------------------------------
procedure Expand_N_Expression_With_Actions (N : Node_Id) is
function Process_Action (Act : Node_Id) return Traverse_Result;
-- Inspect and process a single action of an expression_with_actions for
-- transient controlled objects. If such objects are found, the routine
@ -5129,14 +5128,57 @@ package body Exp_Ch4 is
-- Local variables
Act : Node_Id;
Acts : constant List_Id := Actions (N);
Expr : constant Node_Id := Expression (N);
Act : Node_Id;
-- Start of processing for Expand_N_Expression_With_Actions
begin
-- Process the actions as described above
-- Do not evaluate the expression when it denotes an entity because the
-- expression_with_actions node will be replaced by the reference.
Act := First (Actions (N));
if Is_Entity_Name (Expr) then
null;
-- Do not evaluate the expression when there are no actions because the
-- expression_with_actions node will be replaced by the expression.
elsif No (Acts) or else Is_Empty_List (Acts) then
null;
-- Force the evaluation of the expression by capturing its value in a
-- temporary. This ensures that aliases of transient controlled objects
-- do not leak to the expression of the expression_with_actions node:
-- do
-- Trans_Id : Ctrl_Typ : ...;
-- Alias : ... := Trans_Id;
-- in ... Alias ... end;
-- In the example above, Trans_Id cannot be finalized at the end of the
-- actions list because this may affect the alias and the final value of
-- the expression_with_actions. Forcing the evaluation encapsulates the
-- reference to the Alias within the actions list:
-- do
-- Trans_Id : Ctrl_Typ : ...;
-- Alias : ... := Trans_Id;
-- Val : constant Boolean := ... Alias ...;
-- <finalize Trans_Id>
-- in Val end;
-- It is now safe to finalize the transient controlled object at the end
-- of the actions list.
else
Force_Evaluation (Expr);
end if;
-- Process all transient controlled objects found within the actions of
-- the EWA node.
Act := First (Acts);
while Present (Act) loop
Process_Single_Action (Act);
Next (Act);
@ -5151,7 +5193,7 @@ package body Exp_Ch4 is
-- tree in cases like this. This raises a whole lot of issues of whether
-- we have problems elsewhere, which will be addressed in the future???
if Is_Empty_List (Actions (N)) then
if Is_Empty_List (Acts) then
Rewrite (N, Relocate_Node (Expression (N)));
end if;
end Expand_N_Expression_With_Actions;
@ -11406,9 +11448,10 @@ package body Exp_Ch4 is
-- problems for coverage analysis.
Rewrite (Right,
Make_Expression_With_Actions (LocR,
Expression => Relocate_Node (Right),
Actions => Actlist));
Make_Expression_With_Actions (LocR,
Expression => Relocate_Node (Right),
Actions => Actlist));
Set_Actions (N, No_List);
Analyze_And_Resolve (Right, Standard_Boolean);
@ -12620,72 +12663,28 @@ package body Exp_Ch4 is
(Decl : Node_Id;
Rel_Node : Node_Id)
is
Loc : constant Source_Ptr := Sloc (Decl);
Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
Obj_Typ : constant Node_Id := Etype (Obj_Id);
Desig_Typ : Entity_Id;
Expr : Node_Id;
Fin_Stmts : List_Id;
Ptr_Id : Entity_Id;
Temp_Id : Entity_Id;
Temp_Ins : Node_Id;
Loc : constant Source_Ptr := Sloc (Decl);
Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
Obj_Typ : constant Node_Id := Etype (Obj_Id);
Desig_Typ : Entity_Id;
Expr : Node_Id;
Hook_Id : Entity_Id;
Hook_Insert : Node_Id;
Ptr_Id : Entity_Id;
Hook_Context : constant Node_Id := Find_Hook_Context (Rel_Node);
-- Node on which to insert the hook pointer (as an action): the
-- innermost enclosing non-transient scope.
-- The node on which to insert the hook as an action. This is usually
-- the innermost enclosing non-transient construct.
Finalization_Context : Node_Id;
-- Node after which to insert finalization actions
Finalize_Always : Boolean;
-- If False, call to finalizer includes a test of whether the hook
-- pointer is null.
Fin_Context : Node_Id;
-- The node after which to insert the finalization actions of the
-- transient controlled object.
begin
-- Step 0: determine where to attach finalization actions in the tree
-- Special case for Boolean EWAs: capture expression in a temporary,
-- whose declaration will serve as the context around which to insert
-- finalization code. The finalization thus remains local to the
-- specific condition being evaluated.
if Is_Boolean_Type (Etype (Rel_Node)) then
-- In this case, the finalization context is chosen so that we know
-- at finalization point that the hook pointer is never null, so no
-- need for a test, we can call the finalizer unconditionally, except
-- in the case where the object is created in a specific branch of a
-- conditional expression.
Finalize_Always :=
not Within_Case_Or_If_Expression (Rel_Node)
and then not Nkind_In
(Original_Node (Rel_Node), N_Case_Expression,
N_If_Expression);
declare
Loc : constant Source_Ptr := Sloc (Rel_Node);
Temp : constant Entity_Id := Make_Temporary (Loc, 'E', Rel_Node);
begin
Append_To (Actions (Rel_Node),
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
Constant_Present => True,
Object_Definition =>
New_Occurrence_Of (Etype (Rel_Node), Loc),
Expression => Expression (Rel_Node)));
Finalization_Context := Last (Actions (Rel_Node));
Analyze (Last (Actions (Rel_Node)));
Set_Expression (Rel_Node, New_Occurrence_Of (Temp, Loc));
Analyze (Expression (Rel_Node));
end;
Fin_Context := Last (Actions (Rel_Node));
else
Finalize_Always := False;
Finalization_Context := Hook_Context;
Fin_Context := Hook_Context;
end if;
-- Step 1: Create the access type which provides a reference to the
@ -12715,23 +12714,23 @@ package body Exp_Ch4 is
-- Step 2: Create a temporary which acts as a hook to the transient
-- controlled object. Generate:
-- Temp : Ptr_Id := null;
-- Hook : Ptr_Id := null;
Temp_Id := Make_Temporary (Loc, 'T');
Hook_Id := Make_Temporary (Loc, 'T');
Insert_Action (Hook_Context,
Make_Object_Declaration (Loc,
Defining_Identifier => Temp_Id,
Defining_Identifier => Hook_Id,
Object_Definition => New_Occurrence_Of (Ptr_Id, Loc)));
-- Mark the temporary as created for the purposes of exporting the
-- transient controlled object out of the expression_with_action or if
-- expression. This signals the machinery in Build_Finalizer to treat
-- this case specially.
-- Mark the hook as created for the purposes of exporting the transient
-- controlled object out of the expression_with_action or if expression.
-- This signals the machinery in Build_Finalizer to treat this case in
-- a special manner.
Set_Status_Flag_Or_Transient_Decl (Temp_Id, Decl);
Set_Status_Flag_Or_Transient_Decl (Hook_Id, Decl);
-- Step 3: Hook the transient object to the temporary
-- Step 3: Associate the transient object to the hook
-- This must be inserted right after the object declaration, so that
-- the assignment is executed if, and only if, the object is actually
@ -12747,7 +12746,9 @@ package body Exp_Ch4 is
if Is_Access_Type (Obj_Typ) then
Expr :=
Unchecked_Convert_To (Ptr_Id, New_Occurrence_Of (Obj_Id, Loc));
Unchecked_Convert_To
(Typ => Ptr_Id,
Expr => New_Occurrence_Of (Obj_Id, Loc));
else
Expr :=
Make_Attribute_Reference (Loc,
@ -12756,9 +12757,9 @@ package body Exp_Ch4 is
end if;
-- Generate:
-- Temp := Ptr_Id (Obj_Id);
-- Hook := Ptr_Id (Obj_Id);
-- <or>
-- Temp := Obj_Id'Unrestricted_Access;
-- Hook := Obj_Id'Unrestricted_Access;
-- When the transient object is initialized by an aggregate, the hook
-- must capture the object after the last component assignment takes
@ -12767,25 +12768,25 @@ package body Exp_Ch4 is
if Ekind (Obj_Id) = E_Variable
and then Present (Last_Aggregate_Assignment (Obj_Id))
then
Temp_Ins := Last_Aggregate_Assignment (Obj_Id);
Hook_Insert := Last_Aggregate_Assignment (Obj_Id);
-- Otherwise the hook seizes the related object immediately
else
Temp_Ins := Decl;
Hook_Insert := Decl;
end if;
Insert_After_And_Analyze (Temp_Ins,
Insert_After_And_Analyze (Hook_Insert,
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Temp_Id, Loc),
Name => New_Occurrence_Of (Hook_Id, Loc),
Expression => Expr));
-- Step 4: Finalize the transient controlled object after the context
-- has been evaluated/elaborated. Generate:
-- Step 4: Finalize the hook after the context has been evaluated or
-- elaborated. Generate:
-- if Temp /= null then
-- [Deep_]Finalize (Temp.all);
-- Temp := null;
-- if Hook /= null then
-- [Deep_]Finalize (Hook.all);
-- Hook := null;
-- end if;
-- When the node is part of a return statement, there is no need to
@ -12795,29 +12796,29 @@ package body Exp_Ch4 is
-- insert the finalization code after the return statement as this will
-- render it unreachable.
if Nkind (Finalization_Context) /= N_Simple_Return_Statement then
Fin_Stmts := New_List (
Make_Final_Call
(Obj_Ref =>
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Temp_Id, Loc)),
Typ => Desig_Typ),
if Nkind (Fin_Context) = N_Simple_Return_Statement then
null;
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Temp_Id, Loc),
Expression => Make_Null (Loc)));
-- Otherwise finalize the hook
if not Finalize_Always then
Fin_Stmts := New_List (
Make_Implicit_If_Statement (Decl,
Condition =>
Make_Op_Ne (Loc,
Left_Opnd => New_Occurrence_Of (Temp_Id, Loc),
Right_Opnd => Make_Null (Loc)),
Then_Statements => Fin_Stmts));
end if;
else
Insert_Action_After (Fin_Context,
Make_Implicit_If_Statement (Decl,
Condition =>
Make_Op_Ne (Loc,
Left_Opnd => New_Occurrence_Of (Hook_Id, Loc),
Right_Opnd => Make_Null (Loc)),
Insert_Actions_After (Finalization_Context, Fin_Stmts);
Then_Statements => New_List (
Make_Final_Call
(Obj_Ref =>
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Hook_Id, Loc)),
Typ => Desig_Typ),
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Hook_Id, Loc),
Expression => Make_Null (Loc)))));
end if;
end Process_Transient_Object;

83
gcc/ada/exp_util.adb
View File

@ -4713,7 +4713,6 @@ package body Exp_Util is
is
Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
Obj_Typ : constant Entity_Id := Base_Type (Etype (Obj_Id));
Desig : Entity_Id := Obj_Typ;
function Initialized_By_Access (Trans_Id : Entity_Id) return Boolean;
-- Determine whether transient object Trans_Id is initialized either
@ -4916,31 +4915,61 @@ package body Exp_Util is
-- Start of processing for Is_Aliased
begin
Stmt := First_Stmt;
while Present (Stmt) loop
if Nkind (Stmt) = N_Object_Declaration then
Expr := Expression (Stmt);
-- A controlled transient object is not considered aliased when it
-- appears inside an expression_with_actions node even when there are
-- explicit aliases of it:
if Present (Expr)
and then Nkind (Expr) = N_Reference
and then Nkind (Prefix (Expr)) = N_Identifier
and then Entity (Prefix (Expr)) = Trans_Id
then
return True;
-- do
-- Trans_Id : Ctrl_Typ ...; -- controlled transient object
-- Alias : ... := Trans_Id; -- object is aliased
-- Val : constant Boolean :=
-- ... Alias ...; -- aliasing ends
-- <finalize Trans_Id> -- object safe to finalize
-- in Val end;
-- Expansion ensures that all aliases are encapsulated in the actions
-- list and do not leak to the expression by forcing the evaluation
-- of the expression.
if Nkind (Rel_Node) = N_Expression_With_Actions then
return False;
-- Otherwise examine the statements after the controlled transient
-- object and look for various forms of aliasing.
else
Stmt := First_Stmt;
while Present (Stmt) loop
if Nkind (Stmt) = N_Object_Declaration then
Expr := Expression (Stmt);
-- Aliasing of the form:
-- Obj : ... := Trans_Id'reference;
if Present (Expr)
and then Nkind (Expr) = N_Reference
and then Nkind (Prefix (Expr)) = N_Identifier
and then Entity (Prefix (Expr)) = Trans_Id
then
return True;
end if;
elsif Nkind (Stmt) = N_Object_Renaming_Declaration then
Ren_Obj := Find_Renamed_Object (Stmt);
-- Aliasing of the form:
-- Obj : ... renames ... Trans_Id ...;
if Present (Ren_Obj) and then Ren_Obj = Trans_Id then
return True;
end if;
end if;
elsif Nkind (Stmt) = N_Object_Renaming_Declaration then
Ren_Obj := Find_Renamed_Object (Stmt);
Next (Stmt);
end loop;
if Present (Ren_Obj) and then Ren_Obj = Trans_Id then
return True;
end if;
end if;
Next (Stmt);
end loop;
return False;
return False;
end if;
end Is_Aliased;
------------------
@ -5041,6 +5070,10 @@ package body Exp_Util is
return False;
end Is_Iterated_Container;
-- Local variables
Desig : Entity_Id := Obj_Typ;
-- Start of processing for Is_Finalizable_Transient
begin
@ -5083,6 +5116,12 @@ package body Exp_Util is
and then not Is_Tag_To_Class_Wide_Conversion (Obj_Id)
-- Do not consider iterators because those are treated as normal
-- controlled objects and are processed by the usual finalization
-- machinery. This avoids the double finalization of an iterator.
and then not Is_Iterator (Desig)
-- Do not consider containers in the context of iterator loops. Such
-- transient objects must exist for as long as the loop is around,
-- otherwise any operation carried out by the iterator will fail.