diff options
author | Arnaud Charlet <charlet@adacore.com> | 2020-09-19 04:02:00 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-11-24 05:16:03 -0500 |
commit | 13209acd6488700a9c754e0ecff7d654941698ef (patch) | |
tree | 491e09d48ac48e7439c503ce3a8eb2e237f4f1cd | |
parent | 2afd55a57d48106c3fab218ddeaa0a539aa3f000 (diff) | |
download | gcc-13209acd6488700a9c754e0ecff7d654941698ef.zip gcc-13209acd6488700a9c754e0ecff7d654941698ef.tar.gz gcc-13209acd6488700a9c754e0ecff7d654941698ef.tar.bz2 |
[Ada] Premature finalization on build in place return and case expression
gcc/ada/
* exp_util.adb (Is_Finalizable_Transient): Take into account return
statements containing N_Expression_With_Actions. Also clean up a
condition to make it more readable.
* exp_ch6.adb: Fix typo.
-rw-r--r-- | gcc/ada/exp_ch6.adb | 2 | ||||
-rw-r--r-- | gcc/ada/exp_util.adb | 39 |
2 files changed, 37 insertions, 4 deletions
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 7a97633..8ef178f 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5499,7 +5499,7 @@ package body Exp_Ch6 is (Expression (Original_Node (Ret_Obj_Decl))) -- It is a BIP object declaration that displaces the pointer - -- to the object to reference a convered interface type. + -- to the object to reference a converted interface type. or else Present (Unqual_BIP_Iface_Function_Call diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 6b474d8..d3e7a2cd 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7854,6 +7854,10 @@ package body Exp_Util is -- is in the process of being iterated in the statement list starting -- from First_Stmt. + function Is_Part_Of_BIP_Return_Statement (N : Node_Id) return Boolean; + -- Return True if N is directly part of a build-in-place return + -- statement. + --------------------------- -- Initialized_By_Access -- --------------------------- @@ -8183,6 +8187,35 @@ package body Exp_Util is return False; end Is_Iterated_Container; + ------------------------------------- + -- Is_Part_Of_BIP_Return_Statement -- + ------------------------------------- + + function Is_Part_Of_BIP_Return_Statement (N : Node_Id) return Boolean is + Subp : constant Entity_Id := Current_Subprogram; + Context : Node_Id; + begin + -- First check if N is part of a BIP function + + if No (Subp) + or else not Is_Build_In_Place_Function (Subp) + then + return False; + end if; + + -- Then check whether N is a complete part of a return statement + -- Should we consider other node kinds to go up the tree??? + + Context := N; + loop + case Nkind (Context) is + when N_Expression_With_Actions => Context := Parent (Context); + when N_Simple_Return_Statement => return True; + when others => return False; + end case; + end loop; + end Is_Part_Of_BIP_Return_Statement; + -- Local variables Desig : Entity_Id := Obj_Typ; @@ -8201,6 +8234,7 @@ package body Exp_Util is and then Needs_Finalization (Desig) and then Requires_Transient_Scope (Desig) and then Nkind (Rel_Node) /= N_Simple_Return_Statement + and then not Is_Part_Of_BIP_Return_Statement (Rel_Node) -- Do not consider a transient object that was already processed @@ -8220,9 +8254,8 @@ package body Exp_Util is -- initialized by a function that returns a pointer or acts as a -- renaming of another pointer. - and then - (not Is_Access_Type (Obj_Typ) - or else not Initialized_By_Access (Obj_Id)) + and then not + (Is_Access_Type (Obj_Typ) and then Initialized_By_Access (Obj_Id)) -- Do not consider transient objects which act as indirect aliases -- of build-in-place function results. |