feat(ai): wire async connection test

Cheat Engine/AIConnectionTestWorker.pas

@@ -38,6 +38,9 @@ type
     // a nil source or a failed clone raises here and leaves nothing allocated.
     constructor Create(SourceProvider: TAIProvider; const Model: UTF8String);
     destructor Destroy; override;
+    // True once Execute has returned. Public read-only wrapper over the ancestor's
+    // Finished so callers can poll completion without WaitFor blocking.
+    function IsFinished: boolean;
     // Valid only after the thread has finished (WaitFor / OnTerminate).
     property Success: boolean read FSuccess;
     property ResultText: UTF8String read FResultText;
@@ -69,6 +72,11 @@ begin
   FClient := TAIClient.Create;
 end;
 
+function TAIConnectionTestThread.IsFinished: boolean;
+begin
+  Result := Finished;   // ancestor's public flag; set once Execute returns
+end;
+
 destructor TAIConnectionTestThread.Destroy;
 begin
   // Tolerates partial construction (either field may be nil) and the normal path

Cheat Engine/frmAISettingsUnit.lfm

@@ -220,8 +220,18 @@ object frmAISettings: TfrmAISettings
       Width = 130
       Anchors = [akLeft, akBottom]
       Caption = 'Test connection'
+      OnClick = btnTestConnectionClick
       TabOrder = 10
     end
+    object lblTestConnectionResult: TLabel
+      Left = 136
+      Height = 15
+      Top = 429
+      Width = 132
+      Anchors = [akLeft, akBottom]
+      Caption = ''
+      ParentColor = False
+    end
     object btnCancel: TButton
       Left = 274
       Height = 25

Cheat Engine/frmAISettingsUnit.pas

@@ -11,7 +11,8 @@ unit frmAISettingsUnit;
 interface
 
 uses
-  Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls, AIConfig, AIClient;
+  Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls, AIConfig, AIClient,
+  AIConnectionTestWorker;
 
 type
 
@@ -41,9 +42,11 @@ type
     lblDefaultModel: TLabel;
     cmbDefaultModel: TComboBox;
     btnTestConnection: TButton;
+    lblTestConnectionResult: TLabel;
     btnCancel: TButton;
     btnSave: TButton;
     procedure btnSaveClick(Sender: TObject);
+    procedure btnTestConnectionClick(Sender: TObject);
     procedure cbShowKeyChange(Sender: TObject);
     procedure btnCancelClick(Sender: TObject);
     procedure btnAddProviderClick(Sender: TObject);
@@ -58,10 +61,22 @@ type
     FCurrentIndex: integer;   // provider currently mirrored into the editor, or -1
     FSaveFileName: string;
     FLastSaveError: string;
+    // Async connection-test wiring: at most one worker + one poll timer at a time.
+    FTestWorker: TAIConnectionTestThread;   // owned while a test runs, else nil
+    FTestTimer: TTimer;                      // owned; polls worker completion on UI thread
+    {$IFDEF AICLIENT_TEST}
+    FTestConnectionTransport: TAITransportFunc;  // injected into each new worker
+    FForceTestConnectionStartFailure: boolean;   // raise just before worker.Start
+    {$ENDIF}
     function EffectiveSaveFileName: string;
     procedure LoadProviderIntoControls(Index: integer);
     procedure FlushControlsToProvider(Index: integer);
     procedure ClearEditor;
+    procedure TestTimerTick(Sender: TObject);
+    procedure FinishTestWorker;   // WaitFor + copy result + free; UI thread only
+    {$IFDEF AICLIENT_TEST}
+    function GetTestConnectionActive: boolean;
+    {$ENDIF}
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -84,6 +99,15 @@ type
     // Read-only: the form owns and frees this client. Exposed only so tests can
     // assert ownership and (later) inject a fake Transport.
     property TestClient: TAIClient read FClient;
+    // Injected into each new connection-test worker before Start. Absent in production.
+    property TestConnectionTransport: TAITransportFunc
+      read FTestConnectionTransport write FTestConnectionTransport;
+    // True while a connection-test worker exists (between click and completion).
+    property TestConnectionActive: boolean read GetTestConnectionActive;
+    // When set, the click handler raises just before worker.Start, to exercise the
+    // Start-failure cleanup path deterministically. Absent in production.
+    property ForceTestConnectionStartFailure: boolean
+      read FForceTestConnectionStartFailure write FForceTestConnectionStartFailure;
     {$ENDIF}
   end;
 
@@ -109,8 +133,13 @@ begin
   inherited Create(AOwner);
   FClient := TAIClient.Create;   // per-form owned client; freed in Destroy
   try
+    FTestTimer := TTimer.Create(Self);   // owned via Self; also freed explicitly in Destroy
+    FTestTimer.Enabled := False;
+    FTestTimer.Interval := 50;           // poll cadence for worker completion
+    FTestTimer.OnTimer := @TestTimerTick;
     FSaveFileName := AIConfigStore_DefaultFileName;
   except
+    FreeAndNil(FTestTimer);
     FreeAndNil(FClient);         // later init failed: don't leak the client
     raise;
   end;
@@ -162,6 +191,21 @@ end;
 
 destructor TfrmAISettings.Destroy;
 begin
+  // Stop polling first so no tick fires mid-teardown, then bring the worker down
+  // synchronously: a blocked worker is Terminate+WaitFor'd so it can never call
+  // back into (or be freed out from under) a half-destroyed form.
+  if FTestTimer <> nil then
+  begin
+    FTestTimer.Enabled := False;
+    FTestTimer.OnTimer := nil;
+    FreeAndNil(FTestTimer);
+  end;
+  if FTestWorker <> nil then
+  begin
+    FTestWorker.Terminate;   // cooperative; the send itself is uninterruptible
+    FTestWorker.WaitFor;
+    FreeAndNil(FTestWorker);
+  end;
   FreeAndNil(FClient);
   FreeAndNil(FPublishedSettings);
   FreeAndNil(FSettings);
@@ -300,6 +344,109 @@ begin
   end;
 end;
 
+{$IFDEF AICLIENT_TEST}
+function TfrmAISettings.GetTestConnectionActive: boolean;
+begin
+  Result := FTestWorker <> nil;
+end;
+{$ENDIF}
+
+// Start an asynchronous connection test for the current provider. Snapshots the
+// provider into a worker thread, disables the button, and polls completion via
+// FTestTimer. A second click while a test is active is ignored.
+procedure TfrmAISettings.btnTestConnectionClick(Sender: TObject);
+var p: TAIProvider; model: UTF8String; worker: TAIConnectionTestThread;
+begin
+  if FTestWorker <> nil then Exit;   // one test at a time; ignore re-entrant clicks
+
+  worker := nil;
+  try
+    if (FSettings = nil) or (FClient = nil) then
+    begin lblTestConnectionResult.Caption := 'Settings are not loaded'; Exit; end;
+    if (FCurrentIndex < 0) or (FCurrentIndex >= FSettings.Count) then
+    begin lblTestConnectionResult.Caption := 'No provider is selected'; Exit; end;
+
+    FlushControlsToProvider(FCurrentIndex);
+    p := FSettings.Providers[FCurrentIndex];
+
+    if (cmbDefaultModel.ItemIndex >= 0)
+       and (cmbDefaultModel.ItemIndex < cmbDefaultModel.Items.Count) then
+      model := cmbDefaultModel.Items[cmbDefaultModel.ItemIndex]
+    else
+      model := p.DefaultModel;
+
+    worker := TAIConnectionTestThread.Create(p, model);   // deep snapshot; may raise
+    {$IFDEF AICLIENT_TEST}
+    if Assigned(FTestConnectionTransport) then
+      worker.TestClient.Transport := FTestConnectionTransport;
+    {$ENDIF}
+
+    // Prep the UI/timer, then Start while `worker` still owns the thread. The timer
+    // cannot fire until this handler returns, so no tick can observe the field yet.
+    btnTestConnection.Enabled := False;
+    lblTestConnectionResult.Caption := 'Testing...';
+    FTestTimer.Enabled := True;
+    {$IFDEF AICLIENT_TEST}
+    if FForceTestConnectionStartFailure then
+      raise Exception.Create('injected start failure');   // exercise the cleanup path
+    {$ENDIF}
+    worker.Start;                        // may raise; local still owns it on failure
+    // Start succeeded: hand ownership to the field. Nothing below may raise.
+    FTestWorker := worker;
+    worker := nil;
+  except
+    // Setup failed: leave no worker behind, restore idle UI, show a safe message.
+    on E: Exception do
+    begin
+      worker.Free;
+      FTestWorker := nil;
+      FTestTimer.Enabled := False;
+      btnTestConnection.Enabled := True;
+      lblTestConnectionResult.Caption := 'Connection test failed';   // never E.Message/key
+    end;
+  end;
+end;
+
+// Poll tick: bail while the worker is still running; finalize once it's done.
+procedure TfrmAISettings.TestTimerTick(Sender: TObject);
+begin
+  if FTestWorker = nil then
+  begin
+    FTestTimer.Enabled := False;
+    btnTestConnection.Enabled := True;
+    Exit;
+  end;
+  if not FTestWorker.IsFinished then Exit;   // not done yet; check again next tick
+  FinishTestWorker;
+end;
+
+// Runs on the UI thread once the worker has finished. Detaches and frees the
+// worker, copies its result into the status label, and restores the button.
+procedure TfrmAISettings.FinishTestWorker;
+var local: TAIConnectionTestThread; ok: boolean; resultText: UTF8String;
+begin
+  FTestTimer.Enabled := False;
+  local := FTestWorker;
+  FTestWorker := nil;   // clear the field first so no re-entrant tick sees it
+  try
+    local.WaitFor;      // already finished; returns promptly
+    ok := local.Success;
+    resultText := local.ResultText;   // client already redacted any key
+  except
+    ok := False;
+    resultText := '';
+  end;
+  local.Free;
+
+  btnTestConnection.Enabled := True;
+  if ok then
+    lblTestConnectionResult.Caption := 'Success: ' + string(resultText)
+  else if Trim(string(resultText)) <> '' then
+    lblTestConnectionResult.Caption := string(resultText)
+  else
+    lblTestConnectionResult.Caption := 'Connection test failed';
+end;
+
 // Fired when the provider selection changes. Flush the outgoing provider's edits
 // into the clone, then load the newly-selected provider. No validation yet.
 procedure TfrmAISettings.ProvidersSelectionChange(Sender: TObject; User: boolean);

Cheat Engine/tests/testaisettingsconnectionbutton.lpi

@@ -0,0 +1,47 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="testaisettingsconnectionbutton"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="testaisettingsconnectionbutton.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testaisettingsconnectionbutton"/>
+    </Target>
+    <SearchPaths>
+      <OtherUnitFiles Value=".."/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <SyntaxMode Value="ObjFPC"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <CustomOptions Value="-dAICLIENT_TEST"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

Cheat Engine/tests/testaisettingsconnectionbutton.lpr

@@ -0,0 +1,373 @@
+program testaisettingsconnectionbutton;
+
+// Task 5F3b: settings "Test connection" button wired to TAIConnectionTestThread
+// through a form-owned TTimer that polls completion on the UI thread. No worker
+// UI access, no Synchronize/Queue/callback, no FreeOnTerminate.
+//
+// Built with -dAICLIENT_TEST so the fake transport is injected into each new
+// worker via the form's TestConnectionTransport seam before Start.
+//
+// The fake transport runs on the worker thread. The form owns AT MOST ONE worker
+// at a time, so the fake is single-writer: spies are only inspected after the
+// worker has finished. Blocking is coordinated with native TSimpleEvent objects
+// (no managed-string races).
+
+{$mode objfpc}{$H+}
+
+uses
+  Interfaces, // LCL widgetset
+  SysUtils, Classes, syncobjs, jsonparser, fpjson,
+  Forms, Controls, StdCtrls,
+  AIConfig, AIClient,
+  frmAISettingsUnit;
+
+var
+  Failures: integer = 0;
+
+  // Fake-transport config + spies (single-writer: one worker at a time).
+  FakeReturn: boolean;
+  FakeResponse: UTF8String;
+  FakeError: UTF8String;
+  FakeShouldBlock: boolean;
+  FakeCallCount: integer;
+  FakeSawURL: UTF8String;
+  FakeSawBody: UTF8String;
+  FakeSawAuthValue: UTF8String;
+  // Native coordination: fake signals "entered", waits on "release".
+  FakeEntered: TSimpleEvent;
+  FakeRelease: TSimpleEvent;
+
+procedure Check(cond: Boolean; const msg: string);
+begin
+  if cond then
+    WriteLn('  PASS: ', msg)
+  else
+  begin
+    WriteLn('  FAIL: ', msg);
+    Inc(Failures);
+  end;
+end;
+
+procedure ResetFake;
+begin
+  FakeReturn := True;
+  FakeResponse := '{"choices":[{"message":{"role":"assistant","content":"OK"}}]}';
+  FakeError := '';
+  FakeShouldBlock := False;
+  FakeCallCount := 0;
+  FakeSawURL := '';
+  FakeSawBody := '';
+  FakeSawAuthValue := '';
+  FakeEntered.ResetEvent;
+  FakeRelease.ResetEvent;
+end;
+
+function FakeTransport(const AURL: UTF8String; AHeaders: TStrings;
+  const ABody: UTF8String; ATimeoutMS: LongWord;
+  out AStatus: LongWord; out AResponse, AErrorText: UTF8String): Boolean;
+const Bearer = 'Authorization: Bearer ';
+var i: integer;
+begin
+  Inc(FakeCallCount);
+  FakeSawURL := AURL;
+  FakeSawBody := ABody;
+  FakeSawAuthValue := '';
+  if AHeaders <> nil then
+    for i := 0 to AHeaders.Count - 1 do
+      if Pos(Bearer, AHeaders[i]) = 1 then
+        FakeSawAuthValue := Copy(AHeaders[i], Length(Bearer) + 1, MaxInt);
+  FakeEntered.SetEvent;                 // announce the worker reached transport
+  if FakeShouldBlock then
+    FakeRelease.WaitFor(5000);          // released by the test (5s safety net)
+  AStatus := 200;
+  AResponse := FakeResponse;
+  AErrorText := FakeError;
+  Result := FakeReturn;
+end;
+
+function BodyModel(const ABody: UTF8String): UTF8String;
+var root, node: TJSONData;
+begin
+  Result := '';
+  try root := GetJSON(ABody); except Exit; end;
+  try
+    if root.JSONType <> jtObject then Exit;
+    node := TJSONObject(root).Find('model');
+    if (node <> nil) and (node.JSONType = jtString) then Result := node.AsString;
+  finally
+    root.Free;
+  end;
+end;
+
+function BodyUserContent(const ABody: UTF8String): UTF8String;
+var root, mNode, item, cNode, rNode: TJSONData; msgs: TJSONArray; i: integer;
+begin
+  Result := '';
+  try root := GetJSON(ABody); except Exit; end;
+  try
+    if root.JSONType <> jtObject then Exit;
+    mNode := TJSONObject(root).Find('messages');
+    if (mNode = nil) or (mNode.JSONType <> jtArray) then Exit;
+    msgs := TJSONArray(mNode);
+    for i := 0 to msgs.Count - 1 do
+    begin
+      item := msgs.Items[i];
+      if item.JSONType <> jtObject then Continue;
+      rNode := TJSONObject(item).Find('role');
+      cNode := TJSONObject(item).Find('content');
+      if (rNode <> nil) and (rNode.JSONType = jtString) and (rNode.AsString = 'user')
+         and (cNode <> nil) and (cNode.JSONType = jtString) then
+        Exit(cNode.AsString);
+    end;
+  finally
+    root.Free;
+  end;
+end;
+
+function MakeProvider(const AName, AURL, AKey: string; AProto: TAIProtocol;
+  const AModels: array of string; const ADefault: string): TAIProvider;
+var m: string;
+begin
+  Result := TAIProvider.Create;
+  Result.Name := AName;
+  Result.Protocol := AProto;
+  Result.BaseURL := AURL;
+  Result.APIKey := AKey;
+  for m in AModels do Result.Models.Add(m);
+  Result.DefaultModel := ADefault;
+end;
+
+function NewOpenAISettings(const AKey: string): TAISettings;
+var p: TAIProvider;
+begin
+  Result := TAISettings.Create;
+  p := Result.AddProvider(MakeProvider('OpenAI', 'https://api.example.com/v1/',
+    AKey, apOpenAI, ['gpt-4o', 'gpt-4o-mini'], 'gpt-4o'));
+  Result.ActiveProviderID := p.ID;
+end;
+
+const
+  FixedPrompt = 'Reply with OK.';
+  OrigKey = 'sk-secret-key-1234567890';
+
+// Pump the message loop (firing the form's poll timer) until the predicate holds
+// or the timeout elapses.
+type TPredicate = function: boolean;
+
+function Pump(Pred: TPredicate; MaxMs: integer): boolean;
+var elapsed: integer;
+begin
+  elapsed := 0;
+  while (not Pred()) and (elapsed < MaxMs) do
+  begin
+    Application.ProcessMessages;
+    Sleep(5);
+    Inc(elapsed, 5);
+  end;
+  Result := Pred();
+end;
+
+// Predicates over the single form under test (module global for the fn pointers).
+var f: TfrmAISettings;
+function ButtonEnabled: boolean; begin Result := f.btnTestConnection.Enabled; end;
+function NotActive: boolean; begin Result := not f.TestConnectionActive; end;
+
+// --- Test 1: OpenAI success round-trip through the button + timer. ---
+procedure TestSuccess;
+var src: TAISettings;
+begin
+  WriteLn('TestSuccess');
+  ResetFake;
+  src := NewOpenAISettings(OrigKey);
+  f := TfrmAISettings.Create(nil);
+  try
+    f.LoadSettings(src);
+    f.TestConnectionTransport := @FakeTransport;
+    Check(f.lblTestConnectionResult.Caption = '', 'result label initially blank');
+
+    f.btnTestConnection.Click;   // real OnClick
+
+    // Synchronous post-click state: worker started, button disabled, "Testing...".
+    Check(not f.btnTestConnection.Enabled, 'button disabled immediately after click');
+    Check(f.lblTestConnectionResult.Caption = 'Testing...', 'status shows Testing... immediately');
+    Check(f.TestConnectionActive, 'a worker is active right after click');
+
+    Check(Pump(@ButtonEnabled, 5000), 'button re-enabled before timeout');
+    // Worker is finished and freed -> spies are stable.
+    Check(not f.TestConnectionActive, 'no worker remains after completion');
+    Check(Pos('OK', f.lblTestConnectionResult.Caption) > 0, 'status contains the reply');
+    Check(Pos('Success', f.lblTestConnectionResult.Caption) > 0, 'status marks success');
+    Check(FakeCallCount = 1, 'transport called exactly once');
+    Check(FakeSawURL = 'https://api.example.com/v1/chat/completions', 'exact OpenAI route');
+    Check(FakeSawAuthValue = OrigKey, 'Bearer carries the provider key');
+    Check(BodyModel(FakeSawBody) = 'gpt-4o', 'body carries the resolved default model');
+    Check(BodyUserContent(FakeSawBody) = FixedPrompt, 'body carries the fixed prompt');
+  finally
+    f.Free;
+  end;
+  src.Free;
+end;
+
+// --- Test 2: a second click while the worker is blocked is ignored. ---
+procedure TestSecondClickIgnored;
+var src: TAISettings;
+begin
+  WriteLn('TestSecondClickIgnored');
+  ResetFake;
+  FakeShouldBlock := True;
+  src := NewOpenAISettings(OrigKey);
+  f := TfrmAISettings.Create(nil);
+  try
+    f.LoadSettings(src);
+    f.TestConnectionTransport := @FakeTransport;
+
+    f.btnTestConnection.Click;
+    Check(f.TestConnectionActive, 'first worker active');
+    // Wait until the (blocked) worker is actually inside the transport.
+    Check(FakeEntered.WaitFor(5000) = wrSignaled, 'worker reached transport');
+    Check(FakeCallCount = 1, 'exactly one transport call so far');
+
+    // Second click while blocked: must be a no-op (button already disabled).
+    f.btnTestConnection.Click;
+    Sleep(50);
+    Application.ProcessMessages;
+    Check(FakeCallCount = 1, 'second click created no second transport call');
+    Check(f.TestConnectionActive, 'still exactly one worker active');
+
+    FakeRelease.SetEvent;   // let the worker finish
+    Check(Pump(@NotActive, 5000), 'worker completes after release');
+    Check(f.btnTestConnection.Enabled, 'button re-enabled after completion');
+  finally
+    FakeRelease.SetEvent;   // ensure never left blocked
+    f.Free;
+  end;
+  src.Free;
+end;
+
+// --- Test 3: transport failure embeds the key; status is nonblank + redacted. ---
+procedure TestFailureRedacted;
+var src: TAISettings;
+begin
+  WriteLn('TestFailureRedacted');
+  ResetFake;
+  FakeReturn := False;
+  FakeError := 'HTTP 401 rejected token ' + OrigKey + ' upstream';
+  src := NewOpenAISettings(OrigKey);
+  f := TfrmAISettings.Create(nil);
+  try
+    f.LoadSettings(src);
+    f.TestConnectionTransport := @FakeTransport;
+    f.btnTestConnection.Click;
+    Check(Pump(@ButtonEnabled, 5000), 'button re-enabled after failure');
+    Check(Trim(f.lblTestConnectionResult.Caption) <> '', 'failure status is nonblank');
+    Check(Pos(OrigKey, f.lblTestConnectionResult.Caption) = 0, 'status is redacted of the key');
+    Check(not f.TestConnectionActive, 'no worker remains after failure');
+  finally
+    f.Free;
+  end;
+  src.Free;
+end;
+
+// --- Test 3b: worker.Start failure cleans up the local, leaves no stale field. ---
+// The seam raises immediately before Start, so the still-unstarted worker must be
+// freed on the exception path with the field left nil and the UI back to idle.
+// A follow-up real click (seam cleared) proves the form is still fully usable.
+procedure TestStartFailureCleanup;
+var src: TAISettings;
+begin
+  WriteLn('TestStartFailureCleanup');
+  ResetFake;
+  src := NewOpenAISettings(OrigKey);
+  f := TfrmAISettings.Create(nil);
+  try
+    f.LoadSettings(src);
+    f.TestConnectionTransport := @FakeTransport;
+
+    f.ForceTestConnectionStartFailure := True;
+    f.btnTestConnection.Click;   // handler catches its own injected exception
+    Check(not f.TestConnectionActive, 'no worker remains after Start failure');
+    Check(f.btnTestConnection.Enabled, 'button re-enabled after Start failure');
+    Check(Trim(f.lblTestConnectionResult.Caption) <> '', 'Start-failure status is nonblank');
+    Check(Pos(OrigKey, f.lblTestConnectionResult.Caption) = 0,
+      'Start-failure status is redacted of the key');
+    Check(FakeCallCount = 0, 'transport never called when Start fails');
+
+    // Clear the seam; the form must still work end-to-end.
+    f.ForceTestConnectionStartFailure := False;
+    f.btnTestConnection.Click;
+    Check(Pump(@ButtonEnabled, 5000), 'button re-enabled on the recovery run');
+    Check(not f.TestConnectionActive, 'no worker remains after the recovery run');
+    Check(Pos('Success', f.lblTestConnectionResult.Caption) > 0, 'recovery run succeeds');
+    Check(FakeCallCount = 1, 'recovery run made exactly one transport call');
+  finally
+    f.Free;
+  end;
+  src.Free;
+end;
+
+// --- Test 4: destroy the form while the worker is blocked mid-transport. ---
+// A helper thread releases the fake shortly after Free is entered, so the form's
+// destructor genuinely WaitFors a running worker. Must return with no AV / UAF.
+type
+  TReleaser = class(TThread)
+  protected procedure Execute; override;
+  end;
+procedure TReleaser.Execute;
+begin
+  Sleep(80);
+  FakeRelease.SetEvent;
+end;
+
+procedure TestDestroyWhileBlocked;
+var src: TAISettings; rel: TReleaser;
+begin
+  WriteLn('TestDestroyWhileBlocked');
+  ResetFake;
+  FakeShouldBlock := True;
+  src := NewOpenAISettings(OrigKey);
+  f := TfrmAISettings.Create(nil);
+  try
+    f.LoadSettings(src);
+    f.TestConnectionTransport := @FakeTransport;
+    f.btnTestConnection.Click;
+    Check(FakeEntered.WaitFor(5000) = wrSignaled, 'worker reached transport (blocked)');
+
+    // Worker is blocked in transport RIGHT NOW. Arm a releaser, then Free the form:
+    // the destructor stops the timer and WaitFors the blocked worker.
+    rel := TReleaser.Create(False);
+    rel.FreeOnTerminate := False;
+    f.Free;                 // must return safely despite the running worker
+    f := nil;
+    rel.WaitFor; rel.Free;
+    Check(True, 'form destroyed with a running worker, no access violation');
+  finally
+    FakeRelease.SetEvent;
+    if f <> nil then f.Free;
+  end;
+  src.Free;
+end;
+
+begin
+  Application.Initialize;
+  FakeEntered := TSimpleEvent.Create;
+  FakeRelease := TSimpleEvent.Create;
+  try
+    TestSuccess;
+    TestSecondClickIgnored;
+    TestFailureRedacted;
+    TestStartFailureCleanup;
+    TestDestroyWhileBlocked;
+  finally
+    FakeEntered.Free;
+    FakeRelease.Free;
+  end;
+
+  WriteLn;
+  if Failures = 0 then
+    WriteLn('ALL PASSED')
+  else
+  begin
+    WriteLn(Failures, ' FAILURE(S)');
+    ExitCode := 1;
+  end;
+end.