[gcc r13-4969] ada: Fix premature finalization of return temporary

[gcc r13-4969] ada: Fix premature finalization of return temporary

[Marc Poulhi?s]

https://gcc.gnu.org/g:de77a81b2c974520183e6c2f205be54844f3d42e

commit r13-4969-gde77a81b2c974520183e6c2f205be54844f3d42e
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Sat Dec 10 00:51:10 2022 +0100

    ada: Fix premature finalization of return temporary
    
    Various parts of the expander and the code generator must have a consistent
    view on which temporaries generated for return statements must be finalized
    because they are regular temporaries, and which ones must not be since they
    are allocated on the return stack directly.  The Is_Related_To_Func_Return
    predicate is used for this purpose and needs to be tested consistently.
    
    gcc/ada/
    
            * exp_ch6.adb (Expand_Simple_Function_Return): Make sure that a
            captured function call also verifies Is_Related_To_Func_Return.
            Do not generate an actual subtype for special return objects.
            * exp_util.ads (Is_Related_To_Func_Return): Add commentary.

Diff:
---
 gcc/ada/exp_ch6.adb  | 16 ++++++++++++++--
 gcc/ada/exp_util.ads |  4 ++++
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index d90ee41712e..db1fd1d172b 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6435,12 +6435,21 @@ package body Exp_Ch6 is
       --  The result type of the function
 
       Utyp : constant Entity_Id := Underlying_Type (R_Type);
+      --  The underlying result type of the function
 
       Exp : Node_Id := Expression (N);
       pragma Assert (Present (Exp));
 
       Exp_Is_Function_Call : constant Boolean :=
-        Nkind (Exp) = N_Function_Call or else Is_Captured_Function_Call (Exp);
+        Nkind (Exp) = N_Function_Call
+          or else
+            (Is_Captured_Function_Call (Exp)
+              and then Is_Related_To_Func_Return (Entity (Prefix (Exp))));
+      --  If the expression is a captured function call, then we need to make
+      --  sure that the object doing the capture is properly recognized by the
+      --  Is_Related_To_Func_Return predicate; otherwise, if it is of a type
+      --  that needs finalization, Requires_Cleanup_Actions would return true
+      --  because of it and Build_Finalizer would finalize it prematurely.
 
       Exp_Typ : constant Entity_Id := Etype (Exp);
       --  The type of the expression (not necessarily the same as R_Type)
@@ -6624,7 +6633,8 @@ package body Exp_Ch6 is
          --  size. We create an actual subtype for this purpose. However we
          --  need not do it if the expression is a function call since this
          --  will be done in the called function and doing it here too would
-         --  cause a temporary with maximum size to be created.
+         --  cause a temporary with maximum size to be created. Likewise for
+         --  a special return object, since there is no copy in this case.
 
          declare
             Ubt  : constant Entity_Id := Underlying_Type (Base_Type (Exp_Typ));
@@ -6633,6 +6643,8 @@ package body Exp_Ch6 is
 
          begin
             if not Exp_Is_Function_Call
+              and then not (Is_Entity_Name (Exp)
+                             and then Is_Special_Return_Object (Entity (Exp)))
               and then Has_Defaulted_Discriminants (Ubt)
               and then not Is_Constrained (Ubt)
               and then not Has_Unchecked_Union (Ubt)
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 0d09d259f8e..b770d029cd9 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -825,6 +825,10 @@ package Exp_Util is
    --  Determine whether object Id is related to an expanded return statement.
    --  The case concerned is "return Id.all;".
 
+   --  This is effectively used to determine which temporaries generated for
+   --  return statements must be finalized because they are regular temporaries
+   --  and which ones must not be since they are allocated on the return stack.
+
    --  WARNING: There is a matching C declaration of this subprogram in fe.h
 
    function Is_Renamed_Object (N : Node_Id) return Boolean;