fix(arc): release old value when assigning nil to a class variable

Assigning nil to a class-typed variable (O := nil) did not call
_ClassRelease on the old value in either backend.  The nil literal
has ResolvedType.Kind = tyNil which bypassed the tyClass ARC branch
in EmitAssignment, falling through to the generic scalar store that
performs no reference counting.

QBE backend: added a class-nil branch in EmitAssignment that loads the
old value, calls _ClassRelease, and stores zero.  Handles strong, weak,
and promoted-local cases.

Native backend: added the same class-nil assignment branch, plus two
further fixes:
- EmitExprToEax now handles TNilLiteral (emits xorq %rax, %rax)
- EmitFieldCleanupFn now emits the destructor call and ARC field
  releases instead of being an empty stub, bringing it to parity with
  the QBE backend's FieldCleanup emission.

Updated leak-check tests whose leak scenarios relied on the broken
nil-assignment behaviour — they now use _ClassAddRef to create genuine
unbalanced reference leaks.

Updated test count in README (2293 -> 2606).

README.adoc

@@ -38,7 +38,7 @@ https://github.com/graemeg/opdebugger[OPDF] debug format support.
 == 🚀 Project Status
 
 * **Self-Hosting:** Yes. Blaise bootstraps and recompiles itself with byte-for-byte fixpoint. FPC is no longer required — the entire toolchain runs on Blaise alone.
-* **Testing:** 2293 tests and growing (Test-Driven Development from day one). The test suite itself compiles under Blaise.
+* **Testing:** 2606 tests and growing (Test-Driven Development from day one). The test suite itself compiles under Blaise.
 * **Backends:** Currently utilising a QBE backend, with an LLVM backend in active development.
 
 

compiler/src/main/pascal/blaise.codegen.native.x86_64.pas

@@ -117,10 +117,8 @@ type
     { Emit an immortal class-name string blob in the data section and return
       the label+12 expression that points to the character data. }
     function EmitClassNameString(const AClassName: string): string;
-    { Emit the body of one $_FieldCleanup_<T> function.  For classes with
-      no managed fields this is just a ret; with ARC string/class fields it
-      would call release helpers (deferred — today all user classes have only
-      integer fields). }
+    { Emit the body of one $_FieldCleanup_<T> function.  Calls the
+      destructor (if any), releases ARC-managed fields, then returns. }
     procedure EmitFieldCleanupFn(const AMangledName: string;
                                  ART: TRecordTypeDesc);
     { Emit all class method definitions (OwnerTypeName <> ''). }
@@ -710,12 +708,68 @@ end;
 
 procedure TX86_64Backend.EmitFieldCleanupFn(const AMangledName: string;
                                             ART: TRecordTypeDesc);
+var
+  Walk: TRecordTypeDesc;
+  I:    Integer;
+  F:    TFieldInfo;
+  DestroyName: string;
 begin
   Self.Emit('.text');
   Self.Emit('.globl _FieldCleanup_' + AMangledName);
   Self.Emit('_FieldCleanup_' + AMangledName + ':');
   Self.Emit(#9'pushq %rbp');
   Self.Emit(#9'movq %rsp, %rbp');
+  Self.Emit(#9'pushq %rbx');
+  Self.Emit(#9'movq %rdi, %rbx');
+  if ART <> nil then
+  begin
+    Walk := ART;
+    while Walk <> nil do
+    begin
+      if Walk.HasDestroyMethod then
+      begin
+        if Walk.DestroyResolvedQbeName <> '' then
+          DestroyName := NativeMangle(Walk.DestroyResolvedQbeName)
+        else
+          DestroyName := NativeMangle(Walk.Name) + '_Destroy';
+        Self.Emit(#9'movq %rbx, %rdi');
+        Self.Emit(#9'callq ' + DestroyName);
+        Break;
+      end;
+      Walk := Walk.Parent;
+    end;
+    for I := 0 to ART.Fields.Count - 1 do
+    begin
+      F := TFieldInfo(ART.Fields.Items[I]);
+      if F.TypeDesc = nil then Continue;
+      if not (F.TypeDesc.IsString or (F.TypeDesc.Kind = tyClass)) then
+        Continue;
+      if F.IsUnretained and (F.TypeDesc.Kind = tyClass) then
+        Continue;
+      if F.IsWeak then
+      begin
+        if F.Offset > 0 then
+          Self.Emit(Format(#9'leaq %d(%%rbx), %%rdi', [F.Offset]))
+        else
+          Self.Emit(#9'movq %rbx, %rdi');
+        Self.Emit(#9'callq _WeakClear');
+        Continue;
+      end;
+      if F.Offset > 0 then
+        Self.Emit(Format(#9'movq %d(%%rbx), %%rdi', [F.Offset]))
+      else
+        Self.Emit(#9'movq (%rbx), %rdi');
+      if F.TypeDesc.IsString then
+        Self.Emit(#9'callq _StringRelease')
+      else
+        Self.Emit(#9'callq _ClassRelease');
+      if F.Offset > 0 then
+        Self.Emit(Format(#9'movq $0, %d(%%rbx)', [F.Offset]))
+      else
+        Self.Emit(#9'movq $0, (%rbx)');
+    end;
+  end;
+  Self.Emit(#9'popq %rbx');
   Self.Emit(#9'movq %rbp, %rsp');
   Self.Emit(#9'popq %rbp');
   Self.Emit(#9'ret');
@@ -2003,6 +2057,12 @@ var
   Unsigned: Boolean;
   AOE: TAddrOfExpr;
 begin
+  if AExpr is TNilLiteral then
+  begin
+    Self.Emit(#9'xorq %rax, %rax');
+    Exit;
+  end;
+
   if AExpr is TIntLiteral then
   begin
     { movabsq carries the full 64-bit immediate (32-bit movq sign-extends a
@@ -3926,6 +3986,23 @@ begin
     begin
       Self.EmitInterfaceAssign(Asgn);
     end
+    else if (Asgn.ResolvedLhsType <> nil) and
+            (Asgn.ResolvedLhsType.Kind = tyClass) and
+            (Asgn.Expr is TNilLiteral) then
+    begin
+      if Self.IsLocal(Asgn.Name) then
+        Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand(Asgn.Name)]))
+      else
+        Self.Emit(Format(#9'movq %s(%%rip), %%rdi', [Asgn.Name]));
+      Self.Emit(#9'callq _ClassRelease');
+      if Self.IsLocal(Asgn.Name) then
+        Self.Emit(Format(#9'movq $0, %s', [Self.VarOperand(Asgn.Name)]))
+      else
+      begin
+        Self.AddGlobal(Asgn.Name, Asgn.ResolvedLhsType);
+        Self.Emit(Format(#9'movq $0, %s(%%rip)', [Asgn.Name]));
+      end;
+    end
     else if (Asgn.ResolvedLhsType <> nil) and
             (Asgn.ResolvedLhsType.Kind = tyClass) then
     begin

compiler/src/main/pascal/uCodeGenQBE.pas

@@ -3852,6 +3852,27 @@ begin
     else
       EmitLine(Format('  storel %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal)]));
   end
+  else if (AAssign.ResolvedLhsType <> nil) and
+          (AAssign.ResolvedLhsType.Kind = tyClass) and
+          (AAssign.Expr is TNilLiteral) then
+  begin
+    if AAssign.IsWeakLhs then
+      EmitLine(Format('  call $_WeakClear(l %s)',
+        [VarRef(AAssign.Name, AAssign.IsGlobal)]))
+    else
+    begin
+      OldTemp := AllocTemp;
+      if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then
+        EmitLine(Format('  %s =l copy %%_var_%s', [OldTemp, AAssign.Name]))
+      else
+        EmitLine(Format('  %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal)]));
+      EmitLine(Format('  call $_ClassRelease(l %s)', [OldTemp]));
+      if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then
+        EmitLine(Format('  %%_var_%s =l copy 0', [AAssign.Name]))
+      else
+        EmitLine(Format('  storel 0, %s', [VarRef(AAssign.Name, AAssign.IsGlobal)]));
+    end;
+  end
   else if AAssign.IsWeakLhs and (AAssign.Expr.ResolvedType.Kind = tyClass) then
   begin
     { Weak class-typed assignment: bypass the strong refcount entirely.

compiler/src/test/pascal/cp.test.classes.pas

@@ -81,6 +81,7 @@ type
     { ARC on class variables and fields                                    }
     { ------------------------------------------------------------------ }
     procedure TestCodegen_ClassVarAssign_InsertsAddRefRelease;
+    procedure TestCodegen_ClassVarAssignNil_EmitsRelease;
     procedure TestCodegen_ClassVarScopeExit_EmitsRelease;
     procedure TestCodegen_ClassFieldAssign_InsertsAddRefRelease;
     procedure TestCodegen_FieldCleanup_EmittedPerClass;
@@ -882,6 +883,30 @@ begin
     Pos('call $_ClassRelease', IR) > 0);
 end;
 
+procedure TClassTests.TestCodegen_ClassVarAssignNil_EmitsRelease;
+const
+  Src = '''
+      program P;
+      type TFoo = class end;
+      var F: TFoo;
+      begin
+        F := TFoo.Create;
+        F := nil
+      end.
+      ''';
+var
+  IR: string;
+  P1, P2, P3: Integer;
+begin
+  IR := GenIR(Src);
+  P1 := Pos('call $_ClassRelease', IR);
+  AssertTrue('1st _ClassRelease (Create assignment)', P1 > 0);
+  P2 := Pos('call $_ClassRelease', Copy(IR, P1 + 20, MaxInt));
+  AssertTrue('2nd _ClassRelease (F := nil must release old value)', P2 > 0);
+  P3 := Pos('call $_ClassRelease', Copy(IR, P1 + 20 + P2 + 20, MaxInt));
+  AssertTrue('3rd _ClassRelease (scope-exit cleanup)', P3 > 0);
+end;
+
 procedure TClassTests.TestCodegen_ClassVarScopeExit_EmitsRelease;
 var IR: string;
 begin

compiler/src/test/pascal/cp.test.e2e.arc.pas

@@ -46,6 +46,7 @@ type
       dispatching the assignment ARC on the RHS (Pointer) type instead of the
       LHS (class) slot type. }
     procedure TestRun_PtrRvalueToClassLocal_PreservesLifetime;
+    procedure TestRun_ClassVarAssignNil_Destroys;
   end;
 
 implementation
@@ -525,6 +526,36 @@ begin
     '0' + LE + '1' + LE, Output);
 end;
 
+const
+  SrcClassAssignNil = '''
+    program P;
+    type
+      TThing = class
+        destructor Destroy; override;
+      end;
+    destructor TThing.Destroy;
+    begin
+      WriteLn('destroyed');
+      inherited Destroy
+    end;
+    var O: TThing;
+    begin
+      O := TThing.Create;
+      O := nil;
+      WriteLn('done')
+    end.
+    ''';
+
+procedure TE2EArcTests.TestRun_ClassVarAssignNil_Destroys;
+var Output: string; RCode: Integer;
+begin
+  if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
+  AssertTrue('compile+run', CompileAndRunWithRTL(SrcClassAssignNil, Output, RCode));
+  AssertEquals('exit 0', 0, RCode);
+  AssertEquals('O := nil triggers destroy',
+    'destroyed' + LE + 'done' + LE, Output);
+end;
+
 initialization
   RegisterTest(TE2EArcTests);
 

compiler/src/test/pascal/cp.test.e2e.leakcheck.pas

@@ -120,14 +120,12 @@ const
       end;
     var
       B: TBox;
-      P: Pointer;
     begin
       B := TBox.Create;
       B.Value := 7;
-      P := Pointer(B);
-      B := nil;
-      { P holds the only reference but is an unmanaged Pointer — ARC never
-        releases it, so TBox leaks. }
+      _ClassAddRef(Pointer(B));
+      { Artificial extra addref: rc=2.  Scope-exit releases B (rc=1),
+        but the unbalanced addref keeps the object alive — leak. }
       WriteLn('done')
     end.
     ''';
@@ -146,14 +144,13 @@ const
     var
       A: TAlpha;
       B: TBeta;
-      PA, PB: Pointer;
     begin
       A := TAlpha.Create;
       B := TBeta.Create;
-      PA := Pointer(A);
-      PB := Pointer(B);
-      A := nil;
-      B := nil;
+      _ClassAddRef(Pointer(A));
+      _ClassAddRef(Pointer(B));
+      { Artificial extra addref on each: scope-exit releases both
+        (rc 2->1) but the unbalanced addref keeps them alive. }
       WriteLn('done')
     end.
     ''';

compiler/src/test/pascal/cp.test.e2e.native.pas

@@ -173,6 +173,7 @@ type
     { ARC on class fields }
     procedure TestRun_Native_ArcClassField_StoreAndRead;
     procedure TestRun_Native_ArcStringField_StoreAndRead;
+    procedure TestRun_Native_ArcClassAssignNil_Destroys;
 
     { ARC value param retain/release }
     procedure TestRun_Native_ArcValueParam_String;
@@ -2466,6 +2467,25 @@ const
     end.
     ''';
 
+  SrcArcClassAssignNil = '''
+    program P;
+    type
+      TThing = class
+        destructor Destroy; override;
+      end;
+    destructor TThing.Destroy;
+    begin
+      WriteLn('destroyed');
+      inherited Destroy
+    end;
+    var O: TThing;
+    begin
+      O := TThing.Create;
+      O := nil;
+      WriteLn('done')
+    end.
+    ''';
+
   SrcArcValueParamString = '''
     program P;
     procedure PrintIt(S: string);
@@ -2846,6 +2866,12 @@ begin
   AssertRunsOnBoth(SrcArcStringField, 'hello' + LE, 0);
 end;
 
+procedure TE2ENativeTests.TestRun_Native_ArcClassAssignNil_Destroys;
+begin
+  if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
+  AssertRunsOnBoth(SrcArcClassAssignNil, 'destroyed' + LE + 'done' + LE, 0);
+end;
+
 procedure TE2ENativeTests.TestRun_Native_ArcValueParam_String;
 begin
   if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;