From: Eric Botcazou <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 f39c80337e7..2763aed4f9a 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 e43e360ec7b..968a7db4914 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 f4f30dcc85d..c303a6145df 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 22c3515a46d..7c875448dc2 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;
+
+ -- 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 Context_Id /= Current_Scope then
- Push_Scope (Context_Id);
- Analyze (Decl);
- Pop_Scope;
else
- Analyze (Decl);
+ Insert_Action (N, 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).
-
- if Nkind (Context) /= N_Extended_Return_Statement then
- Mark_Construct_As_Task_Master (Context);
- end if;
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 8101636610e..41b809f94aa 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 5e3823c3649..22adac2186b 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 f53fe30da69..6f28f1cc4cd 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;
--
2.53.0
