From f56add9cb032cb4b22abbb33a7b867bfcbbc5f0d Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 19 Sep 2019 08:13:15 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_attr.adb | 10 ++++++++++ 2 files changed, 16 insertions(+) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2e302299660..b3e94dbf5dc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-09-19 Bob Duff + + * 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 * 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 4c6cba65a44..95de2e4fef4 100644 --- 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); -- 2.30.2