-- Transient Blocks and Finalization Management --
--------------------------------------------------
- function Find_Node_To_Be_Wrapped (N : Node_Id) return Node_Id;
- -- N is a node which may generate a transient scope. Loop over the parent
- -- pointers of N until we find the appropriate node to wrap. If it returns
- -- Empty, it means that no transient scope is needed in this context.
+ function Find_Transient_Context (N : Node_Id) return Node_Id;
+ -- Locate a suitable context for arbitrary node N which may need to be
+ -- serviced by a transient scope. Return Empty if no suitable context is
+ -- available.
procedure Insert_Actions_In_Scope_Around
(N : Node_Id;
-- Examine the scope stack looking for the nearest enclosing transient
-- scope. Return Empty if no such scope exists.
- function Is_OK_Construct (Constr : Node_Id) return Boolean;
- -- Determine whether arbitrary node Constr is a suitable construct which
- -- requires handling by a transient scope.
-
function Is_Package_Or_Subprogram (Id : Entity_Id) return Boolean;
-- Determine whether arbitrary Id denotes a package or subprogram [body]
return Empty;
end Find_Enclosing_Transient_Scope;
- ---------------------
- -- Is_OK_Construct --
- ---------------------
-
- function Is_OK_Construct (Constr : Node_Id) return Boolean is
- begin
- -- Nothing to do when there is no construct to consider
-
- if No (Constr) then
- return False;
-
- -- Nothing to do when the construct is an iteration scheme or an Ada
- -- 2012 iterator because the expression is one of the bounds, and the
- -- expansion will create an explicit declaration for it (see routine
- -- Analyze_Iteration_Scheme).
-
- elsif Nkind_In (Constr, N_Iteration_Scheme,
- N_Iterator_Specification)
- then
- return False;
-
- -- Nothing to do in formal verification mode when the construct is
- -- pragma Check, because the pragma remains unexpanded.
-
- elsif GNATprove_Mode
- and then Nkind (Constr) = N_Pragma
- and then Get_Pragma_Id (Constr) = Pragma_Check
- then
- return False;
- end if;
-
- return True;
- end Is_OK_Construct;
-
------------------------------
-- Is_Package_Or_Subprogram --
------------------------------
-- Local variables
- Scop_Id : constant Entity_Id := Find_Enclosing_Transient_Scope;
- Constr : Node_Id;
+ Trans_Id : constant Entity_Id := Find_Enclosing_Transient_Scope;
+ Context : Node_Id;
-- Start of processing for Establish_Transient_Scope
-- Do not create a new transient scope if there is an existing transient
-- scope on the stack.
- if Present (Scop_Id) then
+ if Present (Trans_Id) then
-- If the transient scope was requested for purposes of managing the
-- secondary stack, then the existing scope must perform this task.
if Manage_Sec_Stack then
- Set_Uses_Sec_Stack (Scop_Id);
+ Set_Uses_Sec_Stack (Trans_Id);
end if;
return;
-- scopes. Locate the proper construct which must be serviced by a new
-- transient scope.
- Constr := Find_Node_To_Be_Wrapped (N);
+ Context := Find_Transient_Context (N);
- if Is_OK_Construct (Constr) then
- Create_Transient_Scope (Constr);
+ if Present (Context) then
+ if Nkind (Context) = N_Assignment_Statement then
- -- Otherwise there is no suitable construct which requires handling by
- -- a transient scope. If the transient scope was requested for purposes
- -- of managing the secondary stack, delegate the work to an enclosing
- -- scope.
+ -- An assignment statement with suppressed controlled semantics
+ -- does not need a transient scope because finalization is not
+ -- desirable at this point. Note that No_Ctrl_Actions is also
+ -- set for non-controlled assignments to suppress dispatching
+ -- _assign.
- elsif Manage_Sec_Stack then
- Delegate_Sec_Stack_Management;
+ if No_Ctrl_Actions (Context)
+ and then Needs_Finalization (Etype (Name (Context)))
+ then
+ -- When a controlled component is initialized by a function
+ -- call, the result on the secondary stack is always assigned
+ -- to the component. Signal the nearest suitable scope that it
+ -- is safe to manage the secondary stack.
+
+ if Manage_Sec_Stack and then Within_Init_Proc then
+ Delegate_Sec_Stack_Management;
+ end if;
+
+ -- Otherwise the assignment is a normal transient context and thus
+ -- requires a transient scope.
+
+ else
+ Create_Transient_Scope (Context);
+ end if;
+
+ -- General case
+
+ else
+ Create_Transient_Scope (Context);
+ end if;
end if;
end Establish_Transient_Scope;
end if;
end Expand_N_Package_Declaration;
- -----------------------------
- -- Find_Node_To_Be_Wrapped --
- -----------------------------
+ ----------------------------
+ -- Find_Transient_Context --
+ ----------------------------
- function Find_Node_To_Be_Wrapped (N : Node_Id) return Node_Id is
+ function Find_Transient_Context (N : Node_Id) return Node_Id is
Curr : Node_Id;
Prev : Node_Id;
begin
Curr := N;
Prev := Empty;
- loop
+ while Present (Curr) loop
case Nkind (Curr) is
-- Declarations
| N_Entry_Body_Formal_Part
| N_Exit_Statement
| N_If_Statement
- | N_Iteration_Scheme
| N_Terminate_Alternative
=>
pragma Assert (Present (Prev));
return Prev;
- -- Assignment statements are usually wrapped in a transient block
- -- except when they are generated as part of controlled aggregate
- -- where the wrapping should take place more globally. Note that
- -- No_Ctrl_Actions is set also for non-controlled assignments, in
- -- order to disable the use of dispatching _assign, thus the test
- -- for a controlled type.
-
when N_Assignment_Statement =>
- if No_Ctrl_Actions (Curr)
- and then Needs_Finalization (Etype (Name (Curr)))
- then
- return Empty;
- else
- return Curr;
- end if;
-
- -- An entry of procedure call is usually wrapped except when it
- -- acts as the alternative of a conditional or timed entry call.
- -- In that case wrap the context of the alternative.
+ return Curr;
when N_Entry_Call_Statement
| N_Procedure_Call_Statement
=>
+ -- When an entry or procedure call acts as the alternative of a
+ -- conditional or timed entry call, the proper context is that
+ -- of the alternative.
+
if Nkind (Parent (Curr)) = N_Entry_Call_Alternative
and then Nkind_In (Parent (Parent (Curr)),
N_Conditional_Entry_Call,
N_Timed_Entry_Call)
then
return Parent (Parent (Curr));
+
+ -- General case for entry or procedure calls
+
else
return Curr;
end if;
- when N_Pragma
- | N_Raise_Statement
- =>
- return Curr;
+ when N_Pragma =>
+
+ -- Pragma Check is not a valid transient context in GNATprove
+ -- mode because the pragma must remain unchanged.
+
+ if GNATprove_Mode
+ and then Get_Pragma_Id (Curr) = Pragma_Check
+ then
+ return Empty;
+
+ -- General case for pragmas
+
+ else
+ return Curr;
+ end if;
- -- A return statement is not wrapped when the associated function
- -- would require wrapping.
+ when N_Raise_Statement =>
+ return Curr;
when N_Simple_Return_Statement =>
+
+ -- A return statement is not a valid transient context when the
+ -- function itself requires transient scope management because
+ -- the result will be reclaimed too early.
+
if Requires_Transient_Scope (Etype
(Return_Applies_To (Return_Statement_Entity (Curr))))
then
return Empty;
+
+ -- General case for return statements
+
else
return Curr;
end if;
return Curr;
end if;
- -- If the construct is within the iteration scheme of a loop, it
- -- requires a declaration followed by an assignment, in order to
- -- have a usable statement to wrap.
+ -- An iteration scheme or an Ada 2012 iterator specification is
+ -- not a valid context because Analyze_Iteration_Scheme already
+ -- employs special processing for them.
+
+ when N_Iteration_Scheme
+ | N_Iterator_Specification
+ =>
+ return Empty;
when N_Loop_Parameter_Specification =>
- return Parent (Curr);
+
+ -- An iteration scheme is not a valid context because routine
+ -- Analyze_Iteration_Scheme already employs special processing.
+
+ if Nkind (Parent (Curr)) = N_Iteration_Scheme then
+ return Empty;
+ else
+ return Parent (Curr);
+ end if;
-- Termination
Prev := Curr;
Curr := Parent (Curr);
end loop;
- end Find_Node_To_Be_Wrapped;
+
+ return Empty;
+ end Find_Transient_Context;
----------------------------------
-- Has_New_Controlled_Component --
projects / gcc.git / commitdiff