[Ada] Memory leak with 'Range of a function call in a loop
diff mbox series

Message ID 20190919132819.GA41719@adacore.com
State New
Headers show
  • [Ada] Memory leak with 'Range of a function call in a loop
Related show

Commit Message

Pierre-Marie de Rodat Sept. 19, 2019, 1:28 p.m. UTC
If a for loop starts with "for X in F (...)'Range loop", where F is a
function returning an unconstrained array, then memory is leaked. This
patch fixes that bug.

Running these commands:

  gnatmake -q -f main.adb

On the following sources:

with Text_IO; use Text_IO;
package P is

   function Get_Objects return String;

end P;

package body P is
   function Get_Objects return String is
      return "xyzzy";
   end Get_Objects;

end P;

with Text_IO; use Text_IO;
pragma Warnings (Off, "an internal GNAT unit");
with System.Secondary_Stack;
pragma Warnings (On, "an internal GNAT unit");
with P; use P;

procedure Main is
   Max_Iterations : constant Integer := 1_000;

   procedure Leak_Call is
      for Id in Get_Objects'Range loop
      end loop;
   end Leak_Call;

   procedure SS_Info is new System.Secondary_Stack.SS_Info

   for Iteration in 1 .. Max_Iterations loop
   end loop;


end Main;

Should produce the following output:

  Secondary Stack information:
    Total size              :  10240 bytes
    Current allocated space :  0 bytes
    Number of Chunks        :  1
    Default size of Chunks  :  10240

Tested on x86_64-pc-linux-gnu, committed on trunk

2019-09-19  Bob Duff  <duff@adacore.com>


	* sem_attr.adb (Resolve_Attribute): Make sure the secondary
	stack is properly managed in the case of a 'Range attribute in a

diff mbox series

--- gcc/ada/sem_attr.adb
+++ gcc/ada/sem_attr.adb
@@ -11570,6 +11570,16 @@  package body Sem_Attr is
             if not Is_Entity_Name (P) or else not Is_Type (Entity (P)) then
                Resolve (P);
+               --  If the prefix is a function call returning on the secondary
+               --  stack, we must make sure to mark/release the stack.
+               if Nkind (P) = N_Function_Call
+                 and then Nkind (Parent (N)) = N_Loop_Parameter_Specification
+                 and then Requires_Transient_Scope (Etype (P))
+               then
+                  Set_Uses_Sec_Stack (Scope (Current_Scope));
+               end if;
             end if;
             Dims := Expressions (N);