From: Arnaud Charlet <charlet@adacore.com>
Date: Sat, 19 Sep 2020 08:02:00 +0000 (-0400)
Subject: [Ada] Premature finalization on build in place return and case expression
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=13209acd6488700a9c754e0ecff7d654941698ef;p=gcc.git

[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.
---

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 7a976336a45..8ef178f433a 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 6b474d80f82..d3e7a2cd189 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.