From 9a975bfceb8c92e68ff21e488072f1fc8099cbfe Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 24 May 2018 13:05:08 +0000 Subject: [PATCH] [Ada] Memory leak mixing limited and nonlimited functions 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; 2018-05-24 Bob Duff 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. From-SVN: r260650 --- gcc/ada/ChangeLog | 8 ++++++ gcc/ada/exp_ch7.adb | 61 +++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 64 insertions(+), 5 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index efe7559504d..7640204749f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2018-05-24 Bob Duff + + * 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. + 2018-05-24 Hristian Kirtchev * sem_prag.adb (Analyze_Pragma): Use the full view of an internally diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 9d1919ab644..d27150fa91f 100644 --- a/gcc/ada/exp_ch7.adb +++ b/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)); -- 2.30.2