From 59c4d2e5a7169d5afa49facd0329bc2f9fe91b1a Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sat, 10 Feb 2024 00:03:42 +0100 Subject: [PATCH] ada: Fix double finalization for dependent expression of case expression 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. --- gcc/ada/exp_ch4.adb | 1 + gcc/ada/exp_util.adb | 66 ++++++++++++++------------------------------ 2 files changed, 22 insertions(+), 45 deletions(-) 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. -- 2.43.5