diff --git a/Cheat Engine/AIConnectionTestWorker.pas b/Cheat Engine/AIConnectionTestWorker.pas index 9c09c547..dc54eab4 100644 --- a/Cheat Engine/AIConnectionTestWorker.pas +++ b/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 diff --git a/Cheat Engine/frmAISettingsUnit.lfm b/Cheat Engine/frmAISettingsUnit.lfm index 3e31961a..243f3952 100644 --- a/Cheat Engine/frmAISettingsUnit.lfm +++ b/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 diff --git a/Cheat Engine/frmAISettingsUnit.pas b/Cheat Engine/frmAISettingsUnit.pas index 740fb51e..7a34bd6b 100644 --- a/Cheat Engine/frmAISettingsUnit.pas +++ b/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); diff --git a/Cheat Engine/tests/testaisettingsconnectionbutton.lpi b/Cheat Engine/tests/testaisettingsconnectionbutton.lpi new file mode 100644 index 00000000..02952d47 --- /dev/null +++ b/Cheat Engine/tests/testaisettingsconnectionbutton.lpi @@ -0,0 +1,47 @@ + + + + + + + + + + + + + </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> diff --git a/Cheat Engine/tests/testaisettingsconnectionbutton.lpr b/Cheat Engine/tests/testaisettingsconnectionbutton.lpr new file mode 100644 index 00000000..ee80e2a3 --- /dev/null +++ b/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.