[COMMITTED] ada: Fix wrong finalization for loop on indexed container
Commit Message
From: Eric Botcazou <ebotcazou@adacore.com>
The problem is that a transient temporary created for the constant indexing
of the container is finalized almost immediately after its creation.
gcc/ada/
* exp_util.adb (Is_Finalizable_Transient.Is_Indexed_Container):
New predicate to detect a temporary created to hold the result of
a constant indexing on a container.
(Is_Finalizable_Transient.Is_Iterated_Container): Adjust a couple
of obsolete comments.
(Is_Finalizable_Transient): Return False if Is_Indexed_Container
returns True on the object.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_util.adb | 102 +++++++++++++++++++++++++++++++++++++++++--
1 file changed, 99 insertions(+), 3 deletions(-)
@@ -8323,6 +8323,13 @@ package body Exp_Util is
function Is_Allocated (Trans_Id : Entity_Id) return Boolean;
-- Determine whether transient object Trans_Id is allocated on the heap
+ function Is_Indexed_Container
+ (Trans_Id : Entity_Id;
+ First_Stmt : Node_Id) return Boolean;
+ -- Determine whether transient object Trans_Id denotes a container which
+ -- is in the process of being indexed in the statement list starting
+ -- from First_Stmt.
+
function Is_Iterated_Container
(Trans_Id : Entity_Id;
First_Stmt : Node_Id) return Boolean;
@@ -8597,6 +8604,91 @@ package body Exp_Util is
and then Nkind (Expr) = N_Allocator;
end Is_Allocated;
+ --------------------------
+ -- Is_Indexed_Container --
+ --------------------------
+
+ function Is_Indexed_Container
+ (Trans_Id : Entity_Id;
+ First_Stmt : Node_Id) return Boolean
+ is
+ Aspect : Node_Id;
+ Call : Node_Id;
+ Index : Entity_Id;
+ Param : Node_Id;
+ Stmt : Node_Id;
+ Typ : Entity_Id;
+
+ begin
+ -- It is not possible to iterate over containers in non-Ada 2012 code
+
+ if Ada_Version < Ada_2012 then
+ return False;
+ end if;
+
+ Typ := Etype (Trans_Id);
+
+ -- Handle access type created for the reference below
+
+ if Is_Access_Type (Typ) then
+ Typ := Designated_Type (Typ);
+ end if;
+
+ -- Look for aspect Constant_Indexing. It may be part of a type
+ -- declaration for a container, or inherited from a base type
+ -- or parent type.
+
+ Aspect := Find_Value_Of_Aspect (Typ, Aspect_Constant_Indexing);
+
+ if Present (Aspect) then
+ Index := Entity (Aspect);
+
+ -- Examine the statements following the container object and
+ -- look for a call to the default indexing routine where the
+ -- first parameter is the transient. Such a call appears as:
+
+ -- It : Access_To_Constant_Reference_Type :=
+ -- Constant_Indexing (Tran_Id.all, ...)'reference;
+
+ Stmt := First_Stmt;
+ while Present (Stmt) loop
+
+ -- Detect an object declaration which is initialized by a
+ -- controlled function call.
+
+ if Nkind (Stmt) = N_Object_Declaration
+ and then Present (Expression (Stmt))
+ and then Nkind (Expression (Stmt)) = N_Reference
+ and then Nkind (Prefix (Expression (Stmt))) = N_Function_Call
+ then
+ Call := Prefix (Expression (Stmt));
+
+ -- The call must invoke the default indexing routine of
+ -- the container and the transient object must appear as
+ -- the first actual parameter. Skip any calls whose names
+ -- are not entities.
+
+ if Is_Entity_Name (Name (Call))
+ and then Entity (Name (Call)) = Index
+ and then Present (Parameter_Associations (Call))
+ then
+ Param := First (Parameter_Associations (Call));
+
+ if Nkind (Param) = N_Explicit_Dereference
+ and then Entity (Prefix (Param)) = Trans_Id
+ then
+ return True;
+ end if;
+ end if;
+ end if;
+
+ Next (Stmt);
+ end loop;
+ end if;
+
+ return False;
+ end Is_Indexed_Container;
+
---------------------------
-- Is_Iterated_Container --
---------------------------
@@ -8621,7 +8713,7 @@ package body Exp_Util is
Typ := Etype (Trans_Id);
- -- Handle access type created for secondary stack use
+ -- Handle access type created for the reference below
if Is_Access_Type (Typ) then
Typ := Designated_Type (Typ);
@@ -8647,7 +8739,7 @@ package body Exp_Util is
while Present (Stmt) loop
-- Detect an object declaration which is initialized by a
- -- secondary stack function call.
+ -- controlled function call.
if Nkind (Stmt) = N_Object_Declaration
and then Present (Expression (Stmt))
@@ -8766,7 +8858,11 @@ package body Exp_Util is
-- transient objects must exist for as long as the loop is around,
-- otherwise any operation carried out by the iterator will fail.
- and then not Is_Iterated_Container (Obj_Id, Decl);
+ and then not Is_Iterated_Container (Obj_Id, Decl)
+
+ -- Likewise for indexed containers in the context of iterator loops
+
+ and then not Is_Indexed_Container (Obj_Id, Decl);
end Is_Finalizable_Transient;
---------------------------------