[COMMITTED] ada: Fix finalization issues in extended return statements

[COMMITTED] ada: Fix finalization issues in extended return statements

[Marc Poulhiès]

From: Eric Botcazou <ebotcazou@adacore.com>

The first issue pertains to return objects of (class-wide) interface types,
which need to be adjusted if the type is not inherently limited.  The second
issue is for return objects of non-class-wide types that are initialized by
a function call, which can use a direct renaming only if the object doing
the capture of the function call is flagged by Is_Related_To_Func_Return.
The third one is that, in the second case, we may need to reassign the tag.

gcc/ada/

	* exp_ch3.adb (Expand_N_Object_Declaration): For a special return
	object of an interface type that is not inherently limited, make
	a call to the Adjust primitive after doing the copy.  For a special
	return object of a non-class-wide type initialized by a function
	call, use a direct renaming only if the object doing the capture
	is flagged by Is_Related_To_Func_Return.  For a special return
	object using a direct renaming, reassign the tag, if need be.
	* exp_ch6.adb (Expand_Simple_Function_Return): Fix comment.
	* exp_util.adb (Is_Related_To_Func_Return): Accept both regular and
	renaming object declarations for return objects.

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

---
 gcc/ada/exp_ch3.adb  | 34 ++++++++++++++++++++++++++++++++--
 gcc/ada/exp_ch6.adb  |  2 +-
 gcc/ada/exp_util.adb |  3 ++-
 3 files changed, 35 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index def63ed0513..7dbf82671aa 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7480,7 +7480,19 @@ package body Exp_Ch3 is
             --  creating the object (via allocator) and initializing it.
 
             if Is_Special_Return_Object (Def_Id) then
-               null;
+
+               --  If the type needs finalization and is not inherently
+               --  limited, then the target is adjusted after the copy
+               --  and attached to the finalization list.
+
+               if Needs_Finalization (Typ)
+                 and then not Is_Limited_View (Typ)
+               then
+                  Adj_Call :=
+                    Make_Adjust_Call (
+                      Obj_Ref => New_Occurrence_Of (Def_Id, Loc),
+                      Typ     => Base_Typ);
+               end if;
 
             elsif Tagged_Type_Expansion then
                declare
@@ -7908,9 +7920,20 @@ package body Exp_Ch3 is
                 --  This avoids an extra copy and, in the case where Typ needs
                 --  finalization, a pair of Adjust/Finalize calls (see below).
 
+                --  However, in the case of a special return object, we need to
+                --  make sure that the object Rnn 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 this and Build_Finalizer would
+                --  finalize it prematurely (see Expand_Simple_Function_Return
+                --  for the same test in the case of a simple return).
+
                 and then
                   ((not Is_Library_Level_Entity (Def_Id)
                      and then Is_Captured_Function_Call (Expr_Q)
+                     and then (not Is_Special_Return_Object (Def_Id)
+                                or else Is_Related_To_Func_Return
+                                          (Entity (Prefix (Expr_Q))))
                      and then not Is_Class_Wide_Type (Typ))
 
                    --  If the initializing expression is a variable with the
@@ -8554,7 +8577,8 @@ package body Exp_Ch3 is
 
       --  If we can rename the initialization expression, we need to make sure
       --  that we use the proper type in the case of a return object that lives
-      --  on the secondary stack. See other cases below for a similar handling.
+      --  on the secondary stack (see other cases below for a similar handling)
+      --  and that the tag is assigned in the case of any return object.
 
       elsif Rewrite_As_Renaming then
          if Is_Secondary_Stack_Return_Object (Def_Id) then
@@ -8577,6 +8601,12 @@ package body Exp_Ch3 is
             end;
          end if;
 
+         if Is_Special_Return_Object (Def_Id)
+           and then Present (Tag_Assign)
+         then
+            Insert_Action_After (Init_After, Tag_Assign);
+         end if;
+
       --  If this is the return object of a function returning on the secondary
       --  stack, convert the declaration to a renaming of the dereference of ah
       --  allocator for the secondary stack.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index db1fd1d172b..b97d69b81b6 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6449,7 +6449,7 @@ package body Exp_Ch6 is
       --  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.
+      --  because of this 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)
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 3c68f917ca9..c8829cac85a 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -9196,7 +9196,8 @@ package body Exp_Util is
           and then Nkind (Unqual_Conv (Expr)) = N_Explicit_Dereference
           and then (Nkind (Parent (Expr)) = N_Simple_Return_Statement
                      or else
-                       (Nkind (Parent (Expr)) = N_Object_Renaming_Declaration
+                       (Nkind (Parent (Expr)) in N_Object_Declaration
+                                               | N_Object_Renaming_Declaration
                          and then
                         Is_Return_Object (Defining_Entity (Parent (Expr)))));
    end Is_Related_To_Func_Return;
-- 
2.34.1