aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2023-06-01 15:43:41 +0200
committerMarc Poulhiès <poulhies@adacore.com>2023-06-27 14:05:50 +0200
commitfb36f0187808d8486b9eb7442aacf13e7e2d3ed9 (patch)
tree662c6e712015994af331d11cbc070397c190d9af
parent1f8d6836261e0089454277d79b1d2ae2f940746b (diff)
downloadgcc-fb36f0187808d8486b9eb7442aacf13e7e2d3ed9.zip
gcc-fb36f0187808d8486b9eb7442aacf13e7e2d3ed9.tar.gz
gcc-fb36f0187808d8486b9eb7442aacf13e7e2d3ed9.tar.bz2
ada: Fix too late finalization and secondary stack release in iterator loops
Sem_Ch5 contains an entire machinery to deal with finalization actions and secondary stack releases around iterator loops, so this removes a recent fix that was made in a narrower case and instead refines the condition under which this machinery is triggered. As a side effect, given that finalization and secondary stack management are still entangled in this machinery, this also fixes the counterpart of a leak for the former, which is a finalization occurring too late. gcc/ada/ * exp_ch4.adb (Expand_N_Quantified_Expression): Revert the latest change as it is subsumed by the machinery in Sem_Ch5. * sem_ch5.adb (Prepare_Iterator_Loop): Also wrap the loop statement in a block in the name contains a function call that returns on the secondary stack.
-rw-r--r--gcc/ada/exp_ch4.adb26
-rw-r--r--gcc/ada/sem_ch5.adb19
2 files changed, 14 insertions, 31 deletions
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 7b6e997..fdaeb505 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -11116,32 +11116,6 @@ package body Exp_Ch4 is
Freeze_Before (P, Etype (Var));
end;
- -- For an expression of the form "for all/some X of F(...) => ...",
- -- where F(...) is a function call that returns on the secondary stack,
- -- we need to mark an enclosing scope as Uses_Sec_Stack. We must do
- -- this before expansion, which can obscure the tree. Note that we
- -- might be inside another quantified expression. Skip blocks and
- -- loops that were generated by expansion.
-
- if Present (Iterator_Specification (N))
- and then Nkind (Name (Iterator_Specification (N))) = N_Function_Call
- and then Needs_Secondary_Stack
- (Etype (Name (Iterator_Specification (N))))
- then
- declare
- Source_Scope : Entity_Id := Current_Scope;
- begin
- while Ekind (Source_Scope) in E_Block | E_Loop
- and then not Comes_From_Source (Source_Scope)
- loop
- Source_Scope := Scope (Source_Scope);
- end loop;
-
- Set_Uses_Sec_Stack (Source_Scope);
- Check_Restriction (No_Secondary_Stack, N);
- end;
- end if;
-
-- Create the declaration of the flag which tracks the status of the
-- quantified expression. Generate:
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index fa36a5a..72e7d18 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -91,9 +91,14 @@ package body Sem_Ch5 is
function Has_Sec_Stack_Call (N : Node_Id) return Boolean;
-- N is the node for an arbitrary construct. This function searches the
- -- construct N to see if any expressions within it contain function
- -- calls that use the secondary stack, returning True if any such call
- -- is found, and False otherwise.
+ -- construct N to see if it contains a function call that returns on the
+ -- secondary stack, returning True if any such call is found, and False
+ -- otherwise.
+
+ -- ??? The implementation invokes Sem_Util.Requires_Transient_Scope so it
+ -- will return True if N contains a function call that needs finalization,
+ -- in addition to the above specification. See Analyze_Loop_Statement for
+ -- a similar comment about this entanglement.
procedure Preanalyze_Range (R_Copy : Node_Id);
-- Determine expected type of range or domain of iteration of Ada 2012
@@ -3626,9 +3631,13 @@ package body Sem_Ch5 is
Cont_Typ := Etype (Nam_Copy);
-- The iterator loop is traversing an array. This case does not
- -- require any transformation.
+ -- require any transformation, unless the name contains a call
+ -- that returns on the secondary stack since we need to release
+ -- the space allocated there.
- if Is_Array_Type (Cont_Typ) then
+ if Is_Array_Type (Cont_Typ)
+ and then not Has_Sec_Stack_Call (Nam_Copy)
+ then
null;
-- Otherwise unconditionally wrap the loop statement within