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

When a loop iterator has a block declaration containing statements that invoke
functions whose result is returned on the secondary stack (such as a
string-returning function), the compiler fails to generate code to release the
allocated memory when the loop terminates.

After this patch the following test works fine.

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
pragma Warnings (Off);
with System.Secondary_Stack;
pragma Warnings (On);

procedure Small is
   procedure Info is new System.Secondary_Stack.Ss_Info (Put_Line);

   US : Unbounded_String;
begin
   Info;
   for J in 1 .. 100_000 loop
      Leaky_Block : declare
      begin
         if (J mod 20000) = 0 then
            Info;
         end if;

         Ada.Text_IO.Put_Line (To_String (US));  --  Test

         if (J mod 20000) = 0 then
            Info;
         end if;
      end Leaky_Block;
   end loop;
   Info;
end;

Command:
  gnatmake small.adb; small | grep "Current allocated space :" | uniq
Output:
  Current allocated space :  0 bytes

2018-07-17  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* exp_ch7.adb (Make_Transient_Block): When determining whether an
	enclosing scope already handles the secondary stack, take into account
	transient blocks nested in a block that do not manage the secondary
	stack and are located within a loop.

From-SVN: r262779

2 files changed, 41 insertions, 0 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4f747f2..af38e50 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-07-17  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch7.adb (Make_Transient_Block): When determining whether an
+	enclosing scope already handles the secondary stack, take into account
+	transient blocks nested in a block that do not manage the secondary
+	stack and are located within a loop.
+
 2018-07-17  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_util.adb (Enclosing_Subprogram): Protected entries and task
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 2f3092d9..781456f 100644
--- 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