This patch fixes a memory leak. If a build-in-place function with a result
whose size is not known at the call site is called, and that function calls a
non-build-in-place function that allocates on the secondary stack, the
secondary stack was not necessarily cleaned up, which caused a memory leak.
The following program should print:
"Current allocated space : 0 bytes"
(among other things) in the loop.
./bip_leak-main > log
grep 'Current allocated' log
Current allocated space : 0 bytes
Current allocated space : 0 bytes
Current allocated space : 0 bytes
with Ada.Finalization;
package BIP_Leak is
subtype Limited_Controlled is Ada.Finalization.Limited_Controlled;
type Nonlim_Controlled is new Ada.Finalization.Controlled with null record;
type Needs_Fin is record
X : Nonlim_Controlled;
end record;
type Lim_Controlled is new Limited_Controlled with null record;
function Return_Lim_Controlled (Source : Boolean)
return Lim_Controlled;
procedure Dump_SS;
end BIP_Leak;
with Ada.Text_IO;
pragma Warnings (Off);
with System.Secondary_Stack;
pragma Warnings (On);
package body BIP_Leak is
function Transform (X : Needs_Fin) return Lim_Controlled is
begin
return (Limited_Controlled with null record);
end;
function Return_Needs_Fin (I : Boolean) return Needs_Fin is
THR : Needs_Fin;
begin
return THR;
end;
function Return_Lim_Controlled (Source : Boolean)
return Lim_Controlled is
begin
return Transform (Return_Needs_Fin (Source));
end Return_Lim_Controlled;
procedure Dump_SS_Instance is
new System.Secondary_Stack.SS_Info (Ada.Text_IO.Put_Line);
procedure Dump_SS renames Dump_SS_Instance;
end BIP_Leak;
procedure BIP_Leak.Main is
begin
for Count in 1 .. 350_000 loop
declare
Msg : constant Lim_Controlled := Return_Lim_Controlled (True);
begin
if Count mod 100_000 = 0 then
Dump_SS;
end if;
end;
end loop;
end BIP_Leak.Main;
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-24 Bob Duff <d...@adacore.com>
gcc/ada/
* exp_ch7.adb (Expand_Cleanup_Actions): Create a mark unconditionally
for build-in-place functions with a caller-unknown-size result.
(Create_Finalizer): For build-in-place functions with a
caller-unknown-size result, check at run time whether we need to
release the secondary stack.--- gcc/ada/exp_ch7.adb
+++ gcc/ada/exp_ch7.adb
@@ -1777,10 +1777,49 @@ package body Exp_Ch7 is
Set_At_End_Proc (HSS, Empty);
end if;
- -- Release the secondary stack mark
+ -- Release the secondary stack
if Present (Mark_Id) then
- Append_To (Finalizer_Stmts, Build_SS_Release_Call (Loc, Mark_Id));
+ declare
+ Release : Node_Id :=
+ Build_SS_Release_Call (Loc, Mark_Id);
+ begin
+ -- If this is a build-in-place function, then we need to
+ -- release the secondary stack, unless we are returning on the
+ -- secondary stack. We wrap the release call in:
+ -- if BIP_Alloc_Form /= Secondary_Stack then ...
+ -- If we are returning on the secondary stack, then releasing
+ -- is the caller's responsibility (or caller's caller, or ...).
+
+ if Nkind (N) = N_Subprogram_Body then
+ declare
+ Spec_Id : constant Entity_Id :=
+ Unique_Defining_Entity (N);
+ BIP_SS : constant Boolean :=
+ Is_Build_In_Place_Function (Spec_Id)
+ and then Needs_BIP_Alloc_Form (Spec_Id);
+ begin
+ if BIP_SS then
+ Release :=
+ Make_If_Statement (Loc,
+ Condition =>
+ Make_Op_Ne (Loc,
+ Left_Opnd =>
+ New_Occurrence_Of
+ (Build_In_Place_Formal
+ (Spec_Id, BIP_Alloc_Form), Loc),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc,
+ UI_From_Int (BIP_Allocation_Form'Pos
+ (Secondary_Stack)))),
+
+ Then_Statements => New_List (Release));
+ end if;
+ end;
+ end if;
+
+ Append_To (Finalizer_Stmts, Release);
+ end;
end if;
-- Protect the statements with abort defer/undefer. This is only when
@@ -4327,10 +4366,22 @@ package body Exp_Ch7 is
and then Is_Task_Allocation_Block (N);
Is_Task_Body : constant Boolean :=
Nkind (Original_Node (N)) = N_Task_Body;
+
+ -- We mark the secondary stack if it is used in this construct, and
+ -- we're not returning a function result on the secondary stack, except
+ -- that a build-in-place function that might or might not return on the
+ -- secondary stack always needs a mark. A run-time test is required in
+ -- the case where the build-in-place function has a BIP_Alloc extra
+ -- parameter (see Create_Finalizer).
+
Needs_Sec_Stack_Mark : constant Boolean :=
- Uses_Sec_Stack (Scop)
- and then
- not Sec_Stack_Needed_For_Return (Scop);
+ (Uses_Sec_Stack (Scop)
+ and then
+ not Sec_Stack_Needed_For_Return (Scop))
+ or else
+ (Is_Build_In_Place_Function (Scop)
+ and then Needs_BIP_Alloc_Form (Scop));
+
Needs_Custom_Cleanup : constant Boolean :=
Nkind (N) = N_Block_Statement
and then Present (Cleanup_Actions (N));
