[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
This commit is contained in:
Bob Duff 2019-09-19 08:13:15 +00:00 committed by Pierre-Marie de Rodat
parent 9415fcdad1
commit f56add9cb0
2 changed files with 16 additions and 0 deletions

View File

@ -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.

View File

@ -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);