[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
Series
  • [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
  main

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
   begin
      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
   begin
      for Id in Get_Objects'Range loop
         null;
      end loop;
   end Leak_Call;

   procedure SS_Info is new System.Secondary_Stack.SS_Info
(Text_IO.Put_Line);

begin
   for Iteration in 1 .. Max_Iterations loop
      Leak_Call;
   end loop;

   SS_Info;

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>

gcc/ada/

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

Patch
diff mbox series

--- gcc/ada/sem_attr.adb
+++ gcc/ada/sem_attr.adb
@@ -11570,6 +11570,16 @@  package body Sem_Attr is
          begin
             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);