ada: Fix premature finalization for nested return within extended one

The return object is incorrectly finalized when the nested return is taken,
because the special flag attached to the return object is not updated.

gcc/ada/

	* exp_ch6.adb (Build_Flag_For_Function): New function made up of the
	code building the special flag for return object present...
	(Expand_N_Extended_Return_Statement): ...in there.  Replace the code
	with a call to Build_Flag_For_Function.  Add assertion for the flag.
	(Expand_Non_Function_Return): For a nested return, if the return
	object needs finalization actions, update the special flag.

1 files changed, 98 insertions, 50 deletions

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index d480240..a2b5cdc 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -194,6 +194,10 @@ package body Exp_Ch6 is
    --  the activation Chain. Note: Master_Actual can be Empty, but only if
    --  there are no tasks.
 
+   function Build_Flag_For_Function (Func_Id : Entity_Id) return Entity_Id;
+   --  Generate code to declare a boolean flag initialized to False in the
+   --  function Func_Id and return the entity for the flag.
+
    function Caller_Known_Size
      (Func_Call   : Node_Id;
       Result_Subt : Entity_Id) return Boolean;
@@ -909,6 +913,53 @@ package body Exp_Ch6 is
       end if;
    end BIP_Suffix_Kind;
 
+   -----------------------------
+   -- Build_Flag_For_Function --
+   -----------------------------
+
+   function Build_Flag_For_Function (Func_Id : Entity_Id) return Entity_Id is
+      Flag_Decl : Node_Id;
+      Flag_Id   : Entity_Id;
+      Func_Bod  : Node_Id;
+      Loc       : Source_Ptr;
+
+   begin
+      --  Recover the function body
+
+      Func_Bod := Unit_Declaration_Node (Func_Id);
+
+      if Nkind (Func_Bod) = N_Subprogram_Declaration then
+         Func_Bod := Parent (Parent (Corresponding_Body (Func_Bod)));
+      end if;
+
+      if Nkind (Func_Bod) = N_Function_Specification then
+         Func_Bod := Parent (Func_Bod); -- one more level for child units
+      end if;
+
+      pragma Assert (Nkind (Func_Bod) = N_Subprogram_Body);
+
+      Loc := Sloc (Func_Bod);
+
+      --  Create a flag to track the function state
+
+      Flag_Id := Make_Temporary (Loc, 'F');
+
+      --  Insert the flag at the beginning of the function declarations,
+      --  generate:
+      --    Fnn : Boolean := False;
+
+      Flag_Decl :=
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Flag_Id,
+            Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc),
+            Expression        => New_Occurrence_Of (Standard_False, Loc));
+
+      Prepend_To (Declarations (Func_Bod), Flag_Decl);
+      Analyze (Flag_Decl);
+
+      return Flag_Id;
+   end Build_Flag_For_Function;
+
    ---------------------------
    -- Build_In_Place_Formal --
    ---------------------------
@@ -5615,49 +5666,14 @@ package body Exp_Ch6 is
       --  perform the appropriate cleanup should it fail to return. The state
       --  of the function itself is tracked through a flag which is coupled
       --  with the scope finalizer. There is one flag per each return object
-      --  in case of multiple returns.
-
-      if Needs_Finalization (Etype (Ret_Obj_Id)) then
-         declare
-            Flag_Decl : Node_Id;
-            Flag_Id   : Entity_Id;
-            Func_Bod  : Node_Id;
-
-         begin
-            --  Recover the function body
-
-            Func_Bod := Unit_Declaration_Node (Func_Id);
-
-            if Nkind (Func_Bod) = N_Subprogram_Declaration then
-               Func_Bod := Parent (Parent (Corresponding_Body (Func_Bod)));
-            end if;
-
-            if Nkind (Func_Bod) = N_Function_Specification then
-               Func_Bod := Parent (Func_Bod); -- one more level for child units
-            end if;
-
-            pragma Assert (Nkind (Func_Bod) = N_Subprogram_Body);
-
-            --  Create a flag to track the function state
-
-            Flag_Id := Make_Temporary (Loc, 'F');
-            Set_Status_Flag_Or_Transient_Decl (Ret_Obj_Id, Flag_Id);
+      --  in case of multiple extended returns. Note that the flag has already
+      --  been created if the extended return contains a nested return.
 
-            --  Insert the flag at the beginning of the function declarations,
-            --  generate:
-            --    Fnn : Boolean := False;
-
-            Flag_Decl :=
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Flag_Id,
-                  Object_Definition =>
-                    New_Occurrence_Of (Standard_Boolean, Loc),
-                  Expression        =>
-                    New_Occurrence_Of (Standard_False, Loc));
-
-            Prepend_To (Declarations (Func_Bod), Flag_Decl);
-            Analyze (Flag_Decl);
-         end;
+      if Needs_Finalization (Etype (Ret_Obj_Id))
+        and then No (Status_Flag_Or_Transient_Decl (Ret_Obj_Id))
+      then
+         Set_Status_Flag_Or_Transient_Decl
+           (Ret_Obj_Id, Build_Flag_For_Function (Func_Id));
       end if;
 
       --  Build a simple_return_statement that returns the return object when
@@ -5722,6 +5738,8 @@ package body Exp_Ch6 is
                            Status_Flag_Or_Transient_Decl (Ret_Obj_Id);
 
             begin
+               pragma Assert (Present (Flag_Id));
+
                --  Generate:
                --    Fnn := True;
 
@@ -6387,14 +6405,44 @@ package body Exp_Ch6 is
       --  return of the previously declared return object.
 
       elsif Kind = E_Return_Statement then
-         Rewrite (N,
-           Make_Simple_Return_Statement (Loc,
-             Expression =>
-               New_Occurrence_Of (First_Entity (Scope_Id), Loc)));
-         Set_Comes_From_Extended_Return_Statement (N);
-         Set_Return_Statement_Entity (N, Scope_Id);
-         Expand_Simple_Function_Return (N);
-         return;
+         declare
+            Ret_Obj_Id : constant Entity_Id := First_Entity (Scope_Id);
+
+            Flag_Id : Entity_Id;
+
+         begin
+            --  Apply the same processing as Expand_N_Extended_Return_Statement
+            --  if the returned object needs finalization actions. Note that we
+            --  are invoked before Expand_N_Extended_Return_Statement but there
+            --  may be multiple nested returns within the extended one.
+
+            if Needs_Finalization (Etype (Ret_Obj_Id)) then
+               if Present (Status_Flag_Or_Transient_Decl (Ret_Obj_Id)) then
+                  Flag_Id := Status_Flag_Or_Transient_Decl (Ret_Obj_Id);
+               else
+                  Flag_Id :=
+                    Build_Flag_For_Function (Return_Applies_To (Scope_Id));
+                  Set_Status_Flag_Or_Transient_Decl (Ret_Obj_Id, Flag_Id);
+               end if;
+
+               --  Generate:
+               --    Fnn := True;
+
+               Insert_Action (N,
+                 Make_Assignment_Statement (Loc,
+                   Name       =>
+                     New_Occurrence_Of (Flag_Id, Loc),
+                   Expression => New_Occurrence_Of (Standard_True, Loc)));
+            end if;
+
+            Rewrite (N,
+              Make_Simple_Return_Statement (Loc,
+                Expression => New_Occurrence_Of (Ret_Obj_Id, Loc)));
+            Set_Comes_From_Extended_Return_Statement (N);
+            Set_Return_Statement_Entity (N, Scope_Id);
+            Expand_Simple_Function_Return (N);
+            return;
+         end;
       end if;
 
       pragma Assert (Is_Entry (Scope_Id));