[COMMITTED] ada: Fix too late finalization and secondary stack release in iterator loops

[COMMITTED] ada: Fix too late finalization and secondary stack release in iterator loops

[Marc Poulhiès]

From: Eric Botcazou <ebotcazou@adacore.com>

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.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch4.adb | 26 --------------------------
 gcc/ada/sem_ch5.adb | 19 ++++++++++++++-----
 2 files changed, 14 insertions(+), 31 deletions(-)

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 7b6e997e3e7..fdaeb50512f 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 fa36a5a0741..72e7d186baa 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
-- 
2.40.0