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

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

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.

From-SVN: r275938

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2e30229966002cfea25837fa5dfdc4fd75e18599..b3e94dbf5dc307f9002aba019ae0031299deb5d6 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+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
+       loop.
+
 2019-09-19  Raphael Amiard  <amiard@adacore.com>
 
        * libgnat/a-cfhase.ads (Set): Add comments to public primitives.

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 4c6cba65a4439a171208d32e024c9557bb7cab9c..95de2e4fef4ee1855834994b690a5963b6c69570 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/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);