From 43a0f9e4eb35ee8a105f9daa1fb5f6de2f7a05be Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Sun, 28 Jun 2026 00:47:53 +0100 Subject: [PATCH] fix(arc): release string call/getter transient passed to Write/WriteLn MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A string-returning function, method or property getter used DIRECTLY as a Write/WriteLn argument — WriteLn(GetBar) — returns a fresh +1 string that _SysWriteStr only borrows. EmitWrite emitted the write call but never released that transient, leaking one string per call on BOTH backends. (A normal procedure's const-string parameter already released it; only the Write/WriteLn built-in path was missing the release. Assigning the result to a variable first never leaked.) EmitWrite now releases the string argument after the write when the argument expression OWNS its reference (ExprOwnsRef / NativeExprOwnsRef) — a call or concat result. Plain variables, literals and PChars are borrowed and are not released, so no double-free. Native stashes the pointer across the _SysWriteStr call and releases it after. E2E regression (both backends, --debug leak tracker): TE2ELeakCheckTests.TestDebug_WriteLnCallArg_NoLeak. --- .../pascal/blaise.codegen.native.x86_64.pas | 24 +++++++-- .../src/main/pascal/blaise.codegen.qbe.pas | 11 +++- .../src/test/pascal/cp.test.e2e.leakcheck.pas | 51 +++++++++++++++++++ 3 files changed, 82 insertions(+), 4 deletions(-) diff --git a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas index a162e79..4d36321 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -9685,9 +9685,27 @@ begin if K in [tyString, tyPChar] then begin Self.EmitExprToEax(ArgExpr); - Self.Emit(#9'movq %rax, %rsi'); - Self.Emit(Format(#9'movl %s, %%edi', [FdLit])); - Self.Emit(#9'callq _SysWriteStr'); + { A string argument that OWNS its reference (a call/concat result that + returned a fresh +1 string) is borrowed by _SysWriteStr and nothing + else holds it — release the transient after the write, or it leaks + once per Write/WriteLn. Stash the pointer across the call, then + release. Plain variables / literals / PChars are borrowed and are + not released. } + if (K = tyString) and NativeExprOwnsRef(ArgExpr) then + begin + Self.Emit(#9'pushq %rax'); + Self.Emit(#9'movq %rax, %rsi'); + Self.Emit(Format(#9'movl %s, %%edi', [FdLit])); + Self.Emit(#9'callq _SysWriteStr'); + Self.Emit(#9'popq %rdi'); + Self.Emit(#9'callq _StringRelease'); + end + else + begin + Self.Emit(#9'movq %rax, %rsi'); + Self.Emit(Format(#9'movl %s, %%edi', [FdLit])); + Self.Emit(#9'callq _SysWriteStr'); + end; end else if K = tyDouble then begin diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index 885d982..daf53ed 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -9551,7 +9551,16 @@ begin IsString := (ArgExpr.ResolvedType <> nil) and ArgExpr.ResolvedType.IsString(); ArgTemp := EmitExpr(ArgExpr); if IsString then - EmitLine(Format(' call $_SysWriteStr(w %s, l %s)', [FdLit, ArgTemp])) + begin + EmitLine(Format(' call $_SysWriteStr(w %s, l %s)', [FdLit, ArgTemp])); + { A string argument that OWNS its reference (a call/concat result that + returned a fresh +1 string) is borrowed by _SysWriteStr and nothing + else holds it — release the transient here, or it leaks once per + Write/WriteLn. Plain variables / literals are borrowed (ExprOwnsRef + false) and must not be released. } + if ExprOwnsRef(ArgExpr) then + EmitLine(Format(' call $_StringRelease(l %s)', [ArgTemp])); + end else if (ArgExpr.ResolvedType <> nil) and (ArgExpr.ResolvedType.Kind = tyBoolean) then EmitLine(Format(' call $_SysWriteBool(w %s, w %s)', [FdLit, ArgTemp])) diff --git a/compiler/src/test/pascal/cp.test.e2e.leakcheck.pas b/compiler/src/test/pascal/cp.test.e2e.leakcheck.pas index 13162c5..be8582d 100644 --- a/compiler/src/test/pascal/cp.test.e2e.leakcheck.pas +++ b/compiler/src/test/pascal/cp.test.e2e.leakcheck.pas @@ -68,6 +68,11 @@ type locals entirely, so every stored element leaked on BOTH backends. The fix releases each element at scope exit. } procedure TestDebug_StaticArrayOfInterface_NoLeak; + { A string-returning call/getter used DIRECTLY as a Write/WriteLn argument + (WriteLn(GetBar)) returns a fresh +1 string that _SysWriteStr only borrows. + EmitWrite previously never released it, leaking one string per call. The + fix releases the owned string transient after the write (both backends). } + procedure TestDebug_WriteLnCallArg_NoLeak; end; implementation @@ -752,6 +757,34 @@ const end. '''; + { A string-returning getter used directly as a WriteLn argument. The getter + returns a fresh +1 string (Copy result); WriteLn only borrows it, so the + caller must release it after the write. Three calls => three leaks before + the fix. } + SrcWriteLnCallArg = ''' + program P; + type + TFoo = class + private + function GetBar: String; + public + property Bar: String read GetBar; + end; + function TFoo.GetBar: String; + begin + Result := Copy('abcd', 1, 3); + end; + var + X: TFoo; + begin + X := TFoo.Create; + WriteLn(X.Bar); + WriteLn(X.Bar); + WriteLn(X.Bar); + X := nil; + end. + '''; + procedure TE2ELeakCheckTests.TestDebug_ReceiverFieldAccess_NoLeak; var Output: string; @@ -788,6 +821,24 @@ begin AssertTrue('no leak report (native), got: ' + Output, Pos('leak', Output) < 0); end; +procedure TE2ELeakCheckTests.TestDebug_WriteLnCallArg_NoLeak; +var + Output: string; + ExitCode: Integer; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end; + AssertTrue('compile+run (qbe)', + CompileAndRunWithRTLDebugOn(beQBE, SrcWriteLnCallArg, Output, ExitCode, True)); + AssertEquals('exit 0 (qbe)', 0, ExitCode); + AssertEquals('stdout (qbe)', 'bcd' + LE + 'bcd' + LE + 'bcd' + LE, Output); + AssertTrue('no leak report (qbe), got: ' + Output, Pos('leak', Output) < 0); + AssertTrue('compile+run (native)', + CompileAndRunWithRTLDebugOn(beNative, SrcWriteLnCallArg, Output, ExitCode, True)); + AssertEquals('exit 0 (native)', 0, ExitCode); + AssertEquals('stdout (native)', 'bcd' + LE + 'bcd' + LE + 'bcd' + LE, Output); + AssertTrue('no leak report (native), got: ' + Output, Pos('leak', Output) < 0); +end; + initialization RegisterTest(TE2ELeakCheckTests);