From: Eric Botcazou <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch6.adb | 15 +++++++--------
gcc/ada/exp_ch6.ads | 3 ++-
2 files changed, 9 insertions(+), 9 deletions(-)
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index f41dca311d1..6bf8d3ba145 100644
--- 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 b32ac77e5b4..15804eaf0ac 100644
--- 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
--
2.51.0
