fix(codegen-native): elide class-assignment AddRef when RHS owns +1

A function or method returning a class leaves its Result at refcount +1: the
callee's `Result := x` AddRef'd and the epilogue did not release Result. The
caller's assignment therefore consumes that transferred reference and must NOT
AddRef again. The native backend's plain class-variable assignment emitted
_ClassAddRef unconditionally, so `C := MakeIt()` (any object-returning call)
leaked exactly one reference per call.

Guard the AddRef with NativeExprOwnsRef, mirroring the tyString/tyDynArray
branches directly above it and the QBE backend's ExprOwnsRef elision (the QBE
path has always been leak-free here). Eliding is safe even for a borrowed return
(`Result := G`): the callee's Result assignment still AddRef'd, so the
transient genuinely owns +1 — verified no use-after-free when the source object
outlives the assignment.

Found via a TList<TCreature> + `L[I].HitPoints := ...` program reporting leaks
under --debug; reduced to a non-generic `C := MakeIt(); C := nil` minimal case.

NOTE: this fixes the assignment-site half. Object-returning call results used as
a field/method *receiver* or as a subscript getter result (e.g. L[I].Field) are
a separate, deeper gap — the native backend lacks the QBE backend's
statement-level deferred-release (PendingRelease/Flush) — addressed next.

cp.test.e2e.leakcheck.TestDebug_FuncReturnAssign_NoLeak pins both backends.
Full suite 3850 green; native fixpoint reproduces (and shrank the compiler's own
emitted asm by ~1400 lines of redundant retains).
This commit is contained in:
Graeme Geldenhuys 2026-06-27 00:21:12 +01:00
parent 948cd4ed1b
commit 7abf5b6255
2 changed files with 62 additions and 2 deletions

View file

@ -11283,8 +11283,17 @@ begin
begin begin
Self.EmitExprToEax(Asgn.Expr); Self.EmitExprToEax(Asgn.Expr);
Self.Emit(#9'pushq %rax'); Self.Emit(#9'pushq %rax');
Self.Emit(#9'movq %rax, %rdi'); { Elide the retain when the RHS already owns +1 (a call result): a
Self.Emit(#9'callq _ClassAddRef'); function/method returning a class leaves Result at +1 (the callee's
`Result := x` AddRef'd and the epilogue did not release it), so the
assignment consumes that transferred reference. AddRef'ing again leaks
one ref per call. This matches the tyString/tyDynArray branches above
and the QBE backend's ExprOwnsRef elision. }
if not NativeExprOwnsRef(Asgn.Expr) then
begin
Self.Emit(#9'movq %rax, %rdi');
Self.Emit(#9'callq _ClassAddRef');
end;
if Asgn.IsVarParam then if Asgn.IsVarParam then
begin begin
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(Asgn.Name)])); Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(Asgn.Name)]));

View file

@ -38,6 +38,10 @@ type
{ obj.Field := MakeClass() consumes the call's +1 — no leak per store. } { obj.Field := MakeClass() consumes the call's +1 — no leak per store. }
procedure TestDebug_ClassFieldFromCall_NoLeak; procedure TestDebug_ClassFieldFromCall_NoLeak;
{ local := MakeClass() consumes the call's +1 — no leak per assignment.
Pins the native class-assignment AddRef elision against the QBE backend. }
procedure TestDebug_FuncReturnAssign_NoLeak;
{ Multiple same-named typed handlers share one slot — no over-release. } { Multiple same-named typed handlers share one slot — no over-release. }
procedure TestDebug_MultiHandlerVar_NoOverRelease; procedure TestDebug_MultiHandlerVar_NoOverRelease;
{ for-in over a TList: GetEnumerator's +1 result must be transferred { for-in over a TList: GetEnumerator's +1 result must be transferred
@ -512,6 +516,35 @@ const
end. end.
'''; ''';
{ A function returning a class leaves Result at +1 (the callee's `Result := x`
AddRef'd and the epilogue did not release it). Assigning that call result to
a local consumes the transferred reference — the assignment site must NOT
AddRef again, or one object leaks per call. The native backend used to
AddRef class assignments unconditionally; this pins the elision. }
SrcFuncReturnAssign = '''
program P;
type
TThing = class N: Integer; end;
function MakeThing(): TThing;
begin
Result := TThing.Create();
Result.N := 9;
end;
var
T: TThing;
I, Sum: Integer;
begin
Sum := 0;
for I := 1 to 100 do
begin
T := MakeThing();
Sum := Sum + T.N;
T := nil;
end;
WriteLn(Sum);
end.
''';
SrcMultiHandlerVar = ''' SrcMultiHandlerVar = '''
program P; program P;
type type
@ -550,6 +583,24 @@ begin
AssertTrue('no leak report (native)', Pos('leak', Output) < 0); AssertTrue('no leak report (native)', Pos('leak', Output) < 0);
end; end;
procedure TE2ELeakCheckTests.TestDebug_FuncReturnAssign_NoLeak;
var
Output: string;
ExitCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
AssertTrue('compile+run (qbe)',
CompileAndRunWithRTLDebugOn(beQBE, SrcFuncReturnAssign, Output, ExitCode, True));
AssertEquals('exit 0 (qbe)', 0, ExitCode);
AssertEquals('stdout (qbe)', '900' + LE, Output);
AssertTrue('no leak report (qbe)', Pos('leak', Output) < 0);
AssertTrue('compile+run (native)',
CompileAndRunWithRTLDebugOn(beNative, SrcFuncReturnAssign, Output, ExitCode, True));
AssertEquals('exit 0 (native)', 0, ExitCode);
AssertEquals('stdout (native)', '900' + LE, Output);
AssertTrue('no leak report (native)', Pos('leak', Output) < 0);
end;
procedure TE2ELeakCheckTests.TestDebug_MultiHandlerVar_NoOverRelease; procedure TE2ELeakCheckTests.TestDebug_MultiHandlerVar_NoOverRelease;
var var
Output: string; Output: string;