ada: Fix missing activation of task returned through class-wide type

This fixes an old issue whereby a task returned through the class-wide type
of a limited record type is not activated by the caller, because it is not
moved onto the activation chain that the caller passes to the function.

gcc/ada/ChangeLog:

	* exp_ch6.ads (Needs_BIP_Task_Actuals): Adjust description.
	* exp_ch6.adb (Expand_N_Extended_Return_Statement): Move activation
	chain for every build-in-place function with task formal parameters
	when the type of the return object might have tasks.

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index f41dca311d1d49127e745e438e054a623871f1e2..6bf8d3ba145d6c24fef2e5ba1a2b5b104bb1ebee 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5908,8 +5908,6 @@ package body Exp_Ch6 is
       Loc          : constant Source_Ptr := Sloc (N);
       Func_Id      : constant Entity_Id :=
                        Return_Applies_To (Return_Statement_Entity (N));
-      Is_BIP_Func  : constant Boolean   :=
-                       Is_Build_In_Place_Function (Func_Id);
       Ret_Obj_Id   : constant Entity_Id :=
                        First_Entity (Return_Statement_Entity (N));
       Ret_Obj_Decl : constant Node_Id   := Parent (Ret_Obj_Id);
@@ -6024,12 +6022,13 @@ package body Exp_Ch6 is
          --  master. But Move_Activation_Chain updates their master to be that
          --  of the caller, so they will not be terminated unless the return
          --  statement completes unsuccessfully due to exception, abort, goto,
-         --  or exit. As a formality, we test whether the function requires the
-         --  result to be built in place, though that's necessarily true for
-         --  the case of result types with task parts.
-
-         if Is_BIP_Func and then Has_Task (Ret_Typ) then
+         --  or exit. Note that we test that the function is both BIP and has
+         --  implicit task formal parameters, because not all functions whose
+         --  result type contains tasks have them (see Needs_BIP_Task_Actuals).
 
+         if Is_Build_In_Place_Function (Func_Id)
+           and then Needs_BIP_Task_Actuals (Func_Id)
+         then
             --  The return expression is an aggregate for a complex type which
             --  contains tasks. This particular case is left unexpanded since
             --  the regular expansion would insert all temporaries and
@@ -6042,7 +6041,7 @@ package body Exp_Ch6 is
             --  Do not move the activation chain if the return object does not
             --  contain tasks.
 
-            if Has_Task (Etype (Ret_Obj_Id)) then
+            if Might_Have_Tasks (Etype (Ret_Obj_Id)) then
                Append_To (Stmts, Move_Activation_Chain (Func_Id));
             end if;
          end if;

diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index b32ac77e5b49ba5b79daf9790dca64de036e948b..15804eaf0acc58921196326fc6b1009d15d4f56a 100644 (file)
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -305,7 +305,8 @@ package Exp_Ch6 is
    --  BIP_Collection parameter (see type BIP_Formal_Kind).
 
    function Needs_BIP_Task_Actuals (Func_Id : Entity_Id) return Boolean;
-   --  Return True if the function returns an object of a type that has tasks.
+   --  Ada 2005 (AI-318-02): Return True if the function needs implicit
+   --  BIP_Task_Master and BIP_Activation_Chain parameters.
 
    function Unqual_BIP_Iface_Function_Call (Expr : Node_Id) return Node_Id;
    --  Return the inner BIP function call removing any qualification from Expr