diff mbox series

[COMMITTED] ada: Fix double finalization for dependent expression of case expression

Message ID 20240514082319.832938-1-poulhies@adacore.com
State New
Headers show
Series [COMMITTED] ada: Fix double finalization for dependent expression of case expression | expand

Commit Message

Marc Poulhiès May 14, 2024, 8:23 a.m. UTC
From: Eric Botcazou <ebotcazou@adacore.com>

The recent fix to Default_Initialize_Object, which has ensured that the
No_Initialization flag set on an object declaration, for example for the
temporary created by Expand_N_Case_Expression, is honored in all cases,
has also uncovered a latent issue in the machinery responsible for the
finalization of transient objects.

More specifically, the answer returned by the Is_Finalizable_Transient
predicate for an object of an access type is different when it is left
uninitialized (true) than when it is initialized to null (false), which
is incorrect; it must return false in both cases, because the only case
where an object can be finalized by the machinery through an access value
is when this value is a reference (N_Reference node) to the object.

This was already more or less the current state of the evolution of the
predicate, but this now explicitly states it in the code.

The change also sets the No_Initialization flag for the temporary created
by Expand_N_If_Expression for the sake of consistency.

gcc/ada/

	* exp_ch4.adb (Expand_N_If_Expression): Set No_Initialization on the
	declaration of the temporary in the by-reference case.
	* exp_util.adb (Initialized_By_Access): Delete.
	(Is_Allocated): Likewise.
	(Initialized_By_Reference): New predicate.
	(Is_Finalizable_Transient): If the transient object is of an access
	type, do not return true unless it is initialized by a reference.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch4.adb  |  1 +
 gcc/ada/exp_util.adb | 66 ++++++++++++++------------------------------
 2 files changed, 22 insertions(+), 45 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index fcbc82f5610..d8895d648d4 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5549,6 +5549,7 @@  package body Exp_Ch4 is
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Cnn,
                 Object_Definition   => New_Occurrence_Of (Ptr_Typ, Loc));
+            Set_No_Initialization (Decl);
 
             --  Generate:
             --    if Cond then
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index e411f32a519..103d59e4deb 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8234,11 +8234,6 @@  package body Exp_Util is
       Obj_Id  : constant Entity_Id := Defining_Identifier (Decl);
       Obj_Typ : constant Entity_Id := Base_Type (Etype (Obj_Id));
 
-      function Initialized_By_Access (Trans_Id : Entity_Id) return Boolean;
-      --  Determine whether transient object Trans_Id is initialized either
-      --  by a function call which returns an access type or simply renames
-      --  another pointer.
-
       function Initialized_By_Aliased_BIP_Func_Call
         (Trans_Id : Entity_Id) return Boolean;
       --  Determine whether transient object Trans_Id is initialized by a
@@ -8247,6 +8242,11 @@  package body Exp_Util is
       --  This case creates an aliasing between the returned value and the
       --  value denoted by BIPaccess.
 
+      function Initialized_By_Reference (Trans_Id : Entity_Id) return Boolean;
+      --  Determine whether transient object Trans_Id is initialized by a
+      --  reference to another object. This is the only case where we can
+      --  possibly finalize a transient object through an access value.
+
       function Is_Aliased
         (Trans_Id   : Entity_Id;
          First_Stmt : Node_Id) return Boolean;
@@ -8254,9 +8254,6 @@  package body Exp_Util is
       --  aliased through 'reference in the statement list starting from
       --  First_Stmt.
 
-      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;
@@ -8275,20 +8272,6 @@  package body Exp_Util is
       --  Return True if N is directly part of a build-in-place return
       --  statement.
 
-      ---------------------------
-      -- Initialized_By_Access --
-      ---------------------------
-
-      function Initialized_By_Access (Trans_Id : Entity_Id) return Boolean is
-         Expr : constant Node_Id := Expression (Parent (Trans_Id));
-
-      begin
-         return
-           Present (Expr)
-             and then Nkind (Expr) /= N_Reference
-             and then Is_Access_Type (Etype (Expr));
-      end Initialized_By_Access;
-
       ------------------------------------------
       -- Initialized_By_Aliased_BIP_Func_Call --
       ------------------------------------------
@@ -8386,6 +8369,18 @@  package body Exp_Util is
          return False;
       end Initialized_By_Aliased_BIP_Func_Call;
 
+      ------------------------------
+      -- Initialized_By_Reference --
+      ------------------------------
+
+      function Initialized_By_Reference (Trans_Id : Entity_Id) return Boolean
+      is
+         Expr : constant Node_Id := Expression (Parent (Trans_Id));
+
+      begin
+         return Present (Expr) and then Nkind (Expr) = N_Reference;
+      end Initialized_By_Reference;
+
       ----------------
       -- Is_Aliased --
       ----------------
@@ -8533,19 +8528,6 @@  package body Exp_Util is
          end if;
       end Is_Aliased;
 
-      ------------------
-      -- Is_Allocated --
-      ------------------
-
-      function Is_Allocated (Trans_Id : Entity_Id) return Boolean is
-         Expr : constant Node_Id := Expression (Parent (Trans_Id));
-      begin
-         return
-           Is_Access_Type (Etype (Trans_Id))
-             and then Present (Expr)
-             and then Nkind (Expr) = N_Allocator;
-      end Is_Allocated;
-
       --------------------------
       -- Is_Indexed_Container --
       --------------------------
@@ -8773,17 +8755,11 @@  package body Exp_Util is
 
           and then not Is_Aliased (Obj_Id, Decl)
 
-          --  Do not consider transient objects allocated on the heap since
-          --  they are attached to a finalization collection.
-
-          and then not Is_Allocated (Obj_Id)
-
-          --  If the transient object is a pointer, check that it is not
-          --  initialized by a function that returns a pointer or acts as a
-          --  renaming of another pointer.
+          --  If the transient object is of an access type, check that it is
+          --  initialized by a reference to another object.
 
-          and then not
-            (Is_Access_Type (Obj_Typ) and then Initialized_By_Access (Obj_Id))
+          and then (not Is_Access_Type (Obj_Typ)
+                     or else Initialized_By_Reference (Obj_Id))
 
           --  Do not consider transient objects which act as indirect aliases
           --  of build-in-place function results.