[Ada] Secondary stack leak in statements block located in a loop

[gcc.git] / gcc / ada / exp_ch7.adb

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 2f3092d98b10e5faba053e7f23eef2aeebcaf306..781456fdfea94dc90ea87b1a1e4c50c0c78170d1 100644 (file)
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -8695,9 +8695,33 @@ package body Exp_Ch7 is
       Action : Node_Id;
       Par    : Node_Id) return Node_Id
    is
+      function Within_Loop_Statement (N : Node_Id) return Boolean;
+      --  Return True when N appears within a loop and no block is containing N
+
       function Manages_Sec_Stack (Id : Entity_Id) return Boolean;
       --  Determine whether scoping entity Id manages the secondary stack
 
+      ---------------------------
+      -- Within_Loop_Statement --
+      ---------------------------
+
+      function Within_Loop_Statement (N : Node_Id) return Boolean is
+         Par : Node_Id := Parent (N);
+
+      begin
+         while not (Nkind_In (Par,
+                              N_Loop_Statement,
+                              N_Handled_Sequence_Of_Statements,
+                              N_Package_Specification)
+                      or else Nkind (Par) in N_Proper_Body)
+         loop
+            pragma Assert (Present (Par));
+            Par := Parent (Par);
+         end loop;
+
+         return Nkind (Par) = N_Loop_Statement;
+      end Within_Loop_Statement;
+
       -----------------------
       -- Manages_Sec_Stack --
       -----------------------
@@ -8780,6 +8804,16 @@ package body Exp_Ch7 is
             elsif Ekind (Scop) = E_Loop then
                exit;
 
+            --  Ditto when the block appears without a block that does not
+            --  manage the secondary stack and is located within a loop.
+
+            elsif Ekind (Scop) = E_Block
+              and then not Manages_Sec_Stack (Scop)
+              and then Present (Block_Node (Scop))
+              and then Within_Loop_Statement (Block_Node (Scop))
+            then
+               exit;
+
             --  The transient block does not need to manage the secondary stack
             --  when there is an enclosing construct which already does that.
             --  This optimization saves on SS_Mark and SS_Release calls but may