https://gcc.gnu.org/g:54916fe29160db42c3c4e3592bac2d5400892f17
commit r17-1194-g54916fe29160db42c3c4e3592bac2d5400892f17 Author: Eric Botcazou <[email protected]> Date: Fri Apr 10 12:44:47 2026 +0200 ada: Fix problematic call to function returning task in anonymous context The problem is that the task returned by the call to the function is never activated. This is fixed by creating a transient scope around the call, as is done for controlled types, after making transient scopes compatible with task types. gcc/ada/ChangeLog: PR ada/42413 * exp_ch4.adb (Process_Transients_In_Expression): Deal with a task activation chain present in the statement list. * exp_ch6.adb (Make_Build_In_Place_Call_In_Anonymous_Context): Also establish a transient scope if the result type has tasks. * exp_ch7.adb (Make_Transient_Block): Deal with Has_Master_Entity and Has_Activation_Chain_Entity set on the transient scope. * exp_ch9.ads (Make_Task_Activation_Call): New declaration from... * exp_ch9.adb (Make_Task_Activation_Call): ...here. (Build_Activation_Chain_Entity): Deal with transient scopes. (Build_Master_Entity): Likewise. (Find_Enclosing_Context): Likewise. * sem_elab.adb (Activation_Processor.Process_Activation): Deal with N_Expression_With_Actions nodes. * sem_util.adb (Current_Entity_In_Scope): Prevent transient scopes from being transparent for _Chain and _Master entities. Diff: --- gcc/ada/exp_ch4.adb | 16 +++++++--- gcc/ada/exp_ch6.adb | 17 +++++----- gcc/ada/exp_ch7.adb | 50 ++++++++++++++++++++++++----- gcc/ada/exp_ch9.adb | 88 +++++++++++++++++++++++++++++++--------------------- gcc/ada/exp_ch9.ads | 5 +++ gcc/ada/sem_elab.adb | 8 +++++ gcc/ada/sem_util.adb | 5 ++- 7 files changed, 133 insertions(+), 56 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index f39c80337e79..2763aed4f9a5 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -255,7 +255,8 @@ package body Exp_Ch4 is -- case expressions. Inspect and process actions list Stmts of expression -- Expr for transient objects. If such objects are found, the routine will -- generate code to finalize them when the enclosing context is elaborated - -- or evaluated. + -- or evaluated. Moreover, if the declaration of a _Chain entity is found, + -- the routine will append a call to Activate_Tasks on the entity to Stmts. -- This specific processing is required for these expressions because the -- management of transient objects for expressions implemented in Exp_Ch7 @@ -15226,10 +15227,15 @@ package body Exp_Ch4 is Decl := First (Stmts); while Present (Decl) loop - if Nkind (Decl) = N_Object_Declaration - and then Is_Finalizable_Transient (Decl, Expr) - then - Process_Transient_In_Expression (Decl); + if Nkind (Decl) = N_Object_Declaration then + if Is_Finalizable_Transient (Decl, Expr) then + Process_Transient_In_Expression (Decl); + + elsif Chars (Defining_Identifier (Decl)) = Name_uChain then + Insert_After_And_Analyze (Last (Stmts), + Make_Task_Activation_Call + (Sloc (Decl), Defining_Identifier (Decl))); + end if; end if; Next (Decl); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index e43e360ec7b8..968a7db49143 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -8932,20 +8932,21 @@ package body Exp_Ch6 is Warn_BIP (Func_Call); - -- If the build-in-place function returns a controlled object, then the - -- object needs to be finalized immediately after the context is exited, - -- which requires the creation of a transient scope and a named object. - -- If the build-in-place function returns a definite subtype, then an - -- object also needs to be created and an access value designating it - -- passed as an actual. + -- object needs to be created and an access value designating it needs + -- to be passed as an actual. + + -- If the build-in-place function returns either a controlled object or + -- an object that contains tasks, then the object needs to be finalized + -- immediately after the context is exited, which requires the creation + -- of a transient scope and a named object. -- Insert a temporary before the call initialized with function call to -- reuse the BIP machinery which takes care of adding the extra build-in -- place actuals. - if Needs_Fin or else Known_Size or else Has_Tasks then - if Needs_Fin then + if Known_Size or else Needs_Fin or else Has_Tasks then + if Needs_Fin or else Has_Tasks then Establish_Transient_Scope (Func_Call, Manage_Sec_Stack => not Known_Size); end if; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index f4f30dcc85d4..c303a6145df7 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -499,11 +499,11 @@ package body Exp_Ch7 is (Loc : Source_Ptr; Action : Node_Id; Par : Node_Id) return Node_Id; - -- Action is a single statement or object declaration. Par is the proper - -- parent of the generated block. Create a transient block whose name is - -- the current scope and the only handled statement is Action. If Action - -- involves controlled objects or secondary stack usage, the corresponding - -- cleanup actions are performed at the end of the block. + -- Action is a single statement. Par is the proper parent of the generated + -- block. Create a transient block whose name is the current scope and the + -- only handled statement is Action. If Action involves controlled objects + -- or task objects or secondary stack usage, corresponding cleanup actions + -- are performed at the end of the block. procedure Store_Actions_In_Scope (AK : Scope_Action_Kind; L : List_Id); -- Shared processing for the Store_xxx_Actions_In_Scope routines: attach @@ -8720,7 +8720,6 @@ package body Exp_Ch7 is -- Local variables - Decls : constant List_Id := New_List; Instrs : constant List_Id := New_List (Action); Trans_Id : constant Entity_Id := Current_Scope; @@ -8819,12 +8818,49 @@ package body Exp_Ch7 is Block := Make_Block_Statement (Loc, Identifier => New_Occurrence_Of (Trans_Id, Loc), - Declarations => Decls, + Declarations => New_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Instrs), Has_Created_Identifier => True); Set_Parent (Block, Par); + -- If the transient scope contains a _Master entity, mark it as being + -- a task master since Build_Master_Entity could not do it. + + Set_Is_Task_Master (Block, Has_Master_Entity (Trans_Id)); + + -- If the transient scope contains a _Chain entity, try to find its + -- declaration in the actions to be executed before the main action. + -- If found, generate a call to Activate_Tasks on the entity and, in + -- either case, set Is_Task_Allocation_Block to block the subsequent + -- generation of the same call by Build_Task_Activation_Call. + + if Has_Activation_Chain_Entity (Trans_Id) then + declare + Before_Actions : List_Id + renames Scope_Stack.Table (Scope_Stack.Last). + Actions_To_Be_Wrapped (Before); + Act : Node_Id; + + begin + Act := First (Before_Actions); + while Present (Act) loop + if Nkind (Act) = N_Object_Declaration + and then Chars (Defining_Identifier (Act)) = Name_uChain + then + Append_To (Before_Actions, + Make_Task_Activation_Call + (Loc, Defining_Identifier (Act))); + exit; + end if; + + Next (Act); + end loop; + + Set_Is_Task_Allocation_Block (Block); + end; + end if; + -- Insert actions stuck in the transient scopes as well as all freezing -- nodes needed by those actions. Do not insert cleanup actions here, -- they will be transferred to the newly created block. diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 22c3515a46d3..7c875448dc2f 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -34,6 +34,7 @@ with Elists; use Elists; with Errout; use Errout; with Exp_Ch3; use Exp_Ch3; with Exp_Ch6; use Exp_Ch6; +with Exp_Ch7; use Exp_Ch7; with Exp_Ch11; use Exp_Ch11; with Exp_Dbug; use Exp_Dbug; with Exp_Sel; use Exp_Sel; @@ -427,10 +428,12 @@ package body Exp_Ch9 is Context_Decls : out List_Id); -- Subsidiary routine to procedures Build_Activation_Chain_Entity and -- Build_Master_Entity. Given an arbitrary node in the tree, find the - -- nearest enclosing body, block, package, or return statement and return - -- its constituents. Context is the enclosing construct, Context_Id is - -- the scope of Context_Id and Context_Decls is the declarative list of - -- Context. + -- enclosing body, block, package, or return statement and return its + -- constituents. Context is the enclosing construct, Context_Id is the + -- scope of Context and Context_Decls is the list of declarations of + -- Context. When the current scope is transient and will give rise to + -- a block, Context is the node to be wrapped, Context_Id is the scope + -- and Context_Decls is No_List. function First_Protected_Operation (D : List_Id) return Node_Id; -- Given the declarations list for a protected body, find the @@ -454,11 +457,6 @@ package body Exp_Ch9 is -- Determine whether Id is a function or a procedure and is marked as a -- private primitive. - function Make_Task_Activation_Call - (Loc : Source_Ptr; - Chain : Entity_Id) return Node_Id; - -- Build a call to Activate_Tasks with Chain as the single parameter - function Make_Unlock_Statement (Prot_Type : E_Protected_Type_Id; Op_Spec : N_Subprogram_Specification_Id; @@ -1013,16 +1011,21 @@ package body Exp_Ch9 is Object_Definition => New_Occurrence_Of (RTE (RE_Activation_Chain), Sloc (N))); - Prepend_To (Context_Decls, Decl); + if Present (Context_Decls) then + Prepend_To (Context_Decls, Decl); - -- Ensure that _chain appears in the proper scope of the context + -- Ensure that _Chain appears in the proper scope of the context + + if Context_Id /= Current_Scope then + Push_Scope (Context_Id); + Analyze (Decl); + Pop_Scope; + else + Analyze (Decl); + end if; - if Context_Id /= Current_Scope then - Push_Scope (Context_Id); - Analyze (Decl); - Pop_Scope; else - Analyze (Decl); + Insert_Action (N, Decl); end if; Set_Has_Activation_Chain_Entity (Context_Id); @@ -3073,32 +3076,35 @@ package body Exp_Ch9 is Decl := Build_Master_Declaration (Sloc (N)); - -- The master is inserted at the start of the declarative list of the - -- context. + if Present (Context_Decls) then + -- The master is inserted at the start of the declarative list of the + -- context. - Prepend_To (Context_Decls, Decl); + Prepend_To (Context_Decls, Decl); - -- In certain cases where transient scopes are involved, the immediate - -- scope is not always the proper master scope. Ensure that the master - -- declaration and entity appear in the same context. + -- Ensure that _Master appears in the proper scope of the context - if Context_Id /= Current_Scope then - Push_Scope (Context_Id); - Analyze (Decl); - Pop_Scope; - else - Analyze (Decl); - end if; + if Context_Id /= Current_Scope then + Push_Scope (Context_Id); + Analyze (Decl); + Pop_Scope; + else + Analyze (Decl); + end if; - Set_Has_Master_Entity (Context_Id); + -- Mark its associated construct as being a task master, but masters + -- associated with return statements are already marked at this stage + -- (see Analyze_Subprogram_Body_Helper). - -- Mark its associated construct as being a task master, but masters - -- associated with return statements are already marked at this stage - -- (see Analyze_Subprogram_Body_Helper). + if Nkind (Context) /= N_Extended_Return_Statement then + Mark_Construct_As_Task_Master (Context); + end if; - if Nkind (Context) /= N_Extended_Return_Statement then - Mark_Construct_As_Task_Master (Context); + else + Insert_Action (N, Decl); end if; + + Set_Has_Master_Entity (Context_Id); end Build_Master_Entity; --------------------------------------- @@ -13008,6 +13014,18 @@ package body Exp_Ch9 is Context_Decls : out List_Id) is begin + -- First deal with a transient scope that will give rise to a block + + if Scope_Is_Transient + and then Nkind (Node_To_Be_Wrapped) not in N_Declaration + | N_Renaming_Declaration + then + Context := Node_To_Be_Wrapped; + Context_Id := Current_Scope; + Context_Decls := No_List; + return; + end if; + -- Traverse the parent chain looking for an enclosing body, block, -- package or return statement. diff --git a/gcc/ada/exp_ch9.ads b/gcc/ada/exp_ch9.ads index 8101636610ed..41b809f94aa1 100644 --- a/gcc/ada/exp_ch9.ads +++ b/gcc/ada/exp_ch9.ads @@ -308,6 +308,11 @@ package Exp_Ch9 is -- All the above declarations are inserted in the order shown to the front -- of Decls. + function Make_Task_Activation_Call + (Loc : Source_Ptr; + Chain : Entity_Id) return Node_Id; + -- Build a call to Activate_Tasks with Chain as the single parameter + function Make_Task_Create_Call (Task_Rec : Entity_Id) return Node_Id; -- Given the entity of the record type created for a task type, build -- the call to Create_Task diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 5e3823c36496..22adac2186b6 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -2936,6 +2936,14 @@ package body Sem_Elab is (List => Private_Declarations (Context), Task_Objs => Task_Objs); + -- Process all task objects in the actions when the activation + -- call appears in an EWA node. + + elsif Nkind (Context) = N_Expression_With_Actions then + Traverse_List + (List => Actions (Context), + Task_Objs => Task_Objs); + -- Otherwise the context must be a block or a body. Process all -- task objects found in the declarations. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index f53fe30da692..6f28f1cc4cd4 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6762,7 +6762,10 @@ package body Sem_Util is elsif Scope_Is_Transient then while Present (E) loop - exit when Scope (E) = CS or else Scope (E) = Scope (CS); + exit when Scope (E) = CS + or else (Scope (E) = Scope (CS) + and then N /= Name_uChain + and then N /= Name_uMaster); E := Homonym (E); end loop;
