From edfb309a1a3c20ee7ce9acfe24f71a5d5eec7f43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?R=C3=A9gys=20Borges=20da=20Silveira?= Date: Wed, 16 Sep 2026 22:07:42 -0300 Subject: [PATCH 1/2] test(console): add persistent connection stability stress --- .../ConsoleStabilityCheck.dpr | 178 ++++++++++++++++++ tests/console-stability/README.md | 15 ++ .../run-console-stability-test.ps1 | 22 +++ 3 files changed, 215 insertions(+) create mode 100644 tests/console-stability/ConsoleStabilityCheck.dpr create mode 100644 tests/console-stability/README.md create mode 100644 tests/console-stability/run-console-stability-test.ps1 diff --git a/tests/console-stability/ConsoleStabilityCheck.dpr b/tests/console-stability/ConsoleStabilityCheck.dpr new file mode 100644 index 0000000..48ce80c --- /dev/null +++ b/tests/console-stability/ConsoleStabilityCheck.dpr @@ -0,0 +1,178 @@ +program ConsoleStabilityCheck; + +{$APPTYPE CONSOLE} + +uses + System.SysUtils, + System.Classes, + System.Generics.Collections, + IdHTTP, + IdHTTPHeaderInfo, + IdGlobalProtocols, + Horse, + Horse.Request, + Horse.Response, + Horse.Provider.Console; + +const + TEST_PORT = 19181; + CLIENT_COUNT = 50; + REQUESTS_PER_CLIENT = 1500; + CONNECT_TIMEOUT_MS = 5000; + READ_TIMEOUT_MS = 10000; + +type + TServerThread = class(TThread) + private + FErrorMessage: string; + protected + procedure Execute; override; + public + property ErrorMessage: string read FErrorMessage; + end; + + TClientThread = class(TThread) + private + FClientIndex: Integer; + FErrorCount: Integer; + FMaxLatencyMS: UInt64; + FFirstError: string; + protected + procedure Execute; override; + public + constructor Create(const AClientIndex: Integer); + property ErrorCount: Integer read FErrorCount; + property MaxLatencyMS: UInt64 read FMaxLatencyMS; + property FirstError: string read FFirstError; + end; + +procedure Ping(Req: THorseRequest; Res: THorseResponse); +begin + Res.Send('ok'); +end; + +procedure TServerThread.Execute; +begin + try + THorse.Listen(TEST_PORT, '127.0.0.1'); + except + on E: Exception do + FErrorMessage := E.ClassName + ': ' + E.Message; + end; +end; + +constructor TClientThread.Create(const AClientIndex: Integer); +begin + inherited Create(True); + FreeOnTerminate := False; + FClientIndex := AClientIndex; +end; + +procedure TClientThread.Execute; +var + LHTTP: TIdHTTP; + LIteration: Integer; + LStartedAt: UInt64; + LElapsed: UInt64; + LResponse: string; +begin + LHTTP := TIdHTTP.Create(nil); + try + LHTTP.ConnectTimeout := CONNECT_TIMEOUT_MS; + LHTTP.ReadTimeout := READ_TIMEOUT_MS; + LHTTP.ProtocolVersion := pv1_1; + LHTTP.HTTPOptions := LHTTP.HTTPOptions + [hoKeepOrigProtocol]; + LHTTP.Request.Connection := 'keep-alive'; + + for LIteration := 1 to REQUESTS_PER_CLIENT do + begin + LStartedAt := GetTickCount64; + try + LResponse := LHTTP.Get(Format('http://127.0.0.1:%d/stability?client=%d&request=%d', + [TEST_PORT, FClientIndex, LIteration])); + if (LHTTP.ResponseCode <> 200) or (LResponse <> 'ok') then + raise Exception.CreateFmt('status=%d body="%s"', + [LHTTP.ResponseCode, LResponse]); + except + on E: Exception do + begin + Inc(FErrorCount); + if FFirstError = '' then + FFirstError := Format('client=%d request=%d %s: %s', + [FClientIndex, LIteration, E.ClassName, E.Message]); + LHTTP.Disconnect; + end; + end; + + LElapsed := GetTickCount64 - LStartedAt; + if LElapsed > FMaxLatencyMS then + FMaxLatencyMS := LElapsed; + end; + finally + LHTTP.Free; + end; +end; + +var + LServer: TServerThread; + LClients: TObjectList; + LClient: TClientThread; + LIndex: Integer; + LAttempts: Integer; + LErrors: Integer; + LMaxLatencyMS: UInt64; + LFirstError: string; +begin + THorse.Get('/stability', Ping); + LServer := TServerThread.Create(True); + LClients := TObjectList.Create(True); + try + LServer.FreeOnTerminate := False; + LServer.Start; + for LAttempts := 1 to 100 do + begin + if THorseProvider.IsRunning then + Break; + Sleep(50); + end; + if not THorseProvider.IsRunning then + begin + LServer.WaitFor; + Writeln('Server failed to start: ', LServer.ErrorMessage); + Halt(1); + end; + + for LIndex := 1 to CLIENT_COUNT do + LClients.Add(TClientThread.Create(LIndex)); + for LClient in LClients do + LClient.Start; + for LClient in LClients do + LClient.WaitFor; + + LErrors := 0; + LMaxLatencyMS := 0; + LFirstError := ''; + for LClient in LClients do + begin + Inc(LErrors, LClient.ErrorCount); + if LClient.MaxLatencyMS > LMaxLatencyMS then + LMaxLatencyMS := LClient.MaxLatencyMS; + if (LFirstError = '') and (LClient.FirstError <> '') then + LFirstError := LClient.FirstError; + end; + + Writeln(Format('clients=%d requests=%d errors=%d max_latency_ms=%d', + [CLIENT_COUNT, CLIENT_COUNT * REQUESTS_PER_CLIENT, LErrors, LMaxLatencyMS])); + if LErrors <> 0 then + begin + Writeln('First error: ', LFirstError); + Halt(1); + end; + finally + if THorseProvider.IsRunning then + THorse.StopListen; + LServer.WaitFor; + LClients.Free; + LServer.Free; + end; +end. diff --git a/tests/console-stability/README.md b/tests/console-stability/README.md new file mode 100644 index 0000000..085707d --- /dev/null +++ b/tests/console-stability/README.md @@ -0,0 +1,15 @@ +# Console provider stability regression + +This Windows/Delphi stress test models the workload reported in issue #581: +50 persistent HTTP/1.1 clients perform 1,500 keep-alive requests each, for a +total of 75,000 transactions. It fails on connection errors, timeouts, HTTP +errors, or invalid response bodies and reports the highest observed latency. + +Run from the repository root: + +```powershell +powershell -ExecutionPolicy Bypass -File tests/console-stability/run-console-stability-test.ps1 +``` + +Set `RADSTUDIO_RSVARS` when RAD Studio is installed outside the default Delphi +12 path. diff --git a/tests/console-stability/run-console-stability-test.ps1 b/tests/console-stability/run-console-stability-test.ps1 new file mode 100644 index 0000000..ff4106e --- /dev/null +++ b/tests/console-stability/run-console-stability-test.ps1 @@ -0,0 +1,22 @@ +$ErrorActionPreference = 'Stop' + +$testDir = Split-Path -Parent $MyInvocation.MyCommand.Path +$horseRoot = (Resolve-Path (Join-Path $testDir '..\..')).Path +$outputDir = Join-Path ([System.IO.Path]::GetTempPath()) ('horse-console-stability-' + [Guid]::NewGuid().ToString('N')) +$rsvars = if ($env:RADSTUDIO_RSVARS) { $env:RADSTUDIO_RSVARS } else { 'C:\Program Files (x86)\Embarcadero\Studio\23.0\bin\rsvars.bat' } + +New-Item -ItemType Directory -Path $outputDir | Out-Null +try { + $command = 'call "' + $rsvars + '" && dcc32.exe -B -Q ' + + '-E"' + $outputDir + '" -NS"System;Xml;Data;Datasnap;Web;Soap;Winapi" ' + + '-I"' + $horseRoot + '\src" -U"' + $horseRoot + '\src" ' + + '"' + (Join-Path $testDir 'ConsoleStabilityCheck.dpr') + '"' + & cmd.exe /d /c $command + if ($LASTEXITCODE -ne 0) { exit $LASTEXITCODE } + + & (Join-Path $outputDir 'ConsoleStabilityCheck.exe') + if ($LASTEXITCODE -ne 0) { exit $LASTEXITCODE } +} +finally { + Remove-Item -LiteralPath $outputDir -Recurse -Force -ErrorAction SilentlyContinue +} From 14d6f22de03d840bb0a828db76a81743ead75249 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?R=C3=A9gys=20Borges=20da=20Silveira?= Date: Wed, 16 Sep 2026 22:10:19 -0300 Subject: [PATCH 2/2] test(console): allow paced stability workload --- .../ConsoleStabilityCheck.dpr | 39 ++++++++++++++++--- tests/console-stability/README.md | 15 +++++++ 2 files changed, 48 insertions(+), 6 deletions(-) diff --git a/tests/console-stability/ConsoleStabilityCheck.dpr b/tests/console-stability/ConsoleStabilityCheck.dpr index 48ce80c..aac80d7 100644 --- a/tests/console-stability/ConsoleStabilityCheck.dpr +++ b/tests/console-stability/ConsoleStabilityCheck.dpr @@ -16,11 +16,26 @@ uses const TEST_PORT = 19181; - CLIENT_COUNT = 50; - REQUESTS_PER_CLIENT = 1500; + DEFAULT_CLIENT_COUNT = 50; + DEFAULT_REQUESTS_PER_CLIENT = 1500; + DEFAULT_REQUEST_DELAY_MS = 0; CONNECT_TIMEOUT_MS = 5000; READ_TIMEOUT_MS = 10000; +var + GClientCount: Integer; + GRequestsPerClient: Integer; + GRequestDelayMS: Integer; + +function EnvironmentInteger(const AName: string; const ADefault: Integer): Integer; +var + LValue: string; +begin + LValue := GetEnvironmentVariable(AName); + if (LValue = '') or not TryStrToInt(LValue, Result) or (Result < 0) then + Result := ADefault; +end; + type TServerThread = class(TThread) private @@ -84,7 +99,7 @@ begin LHTTP.HTTPOptions := LHTTP.HTTPOptions + [hoKeepOrigProtocol]; LHTTP.Request.Connection := 'keep-alive'; - for LIteration := 1 to REQUESTS_PER_CLIENT do + for LIteration := 1 to GRequestsPerClient do begin LStartedAt := GetTickCount64; try @@ -107,6 +122,8 @@ begin LElapsed := GetTickCount64 - LStartedAt; if LElapsed > FMaxLatencyMS then FMaxLatencyMS := LElapsed; + if (GRequestDelayMS > 0) and (LIteration < GRequestsPerClient) then + Sleep(GRequestDelayMS); end; finally LHTTP.Free; @@ -123,6 +140,15 @@ var LMaxLatencyMS: UInt64; LFirstError: string; begin + GClientCount := EnvironmentInteger('HORSE_STABILITY_CLIENTS', DEFAULT_CLIENT_COUNT); + GRequestsPerClient := EnvironmentInteger('HORSE_STABILITY_REQUESTS_PER_CLIENT', DEFAULT_REQUESTS_PER_CLIENT); + GRequestDelayMS := EnvironmentInteger('HORSE_STABILITY_REQUEST_DELAY_MS', DEFAULT_REQUEST_DELAY_MS); + if (GClientCount = 0) or (GRequestsPerClient = 0) then + begin + Writeln('Client and request counts must be greater than zero'); + Halt(1); + end; + THorse.Get('/stability', Ping); LServer := TServerThread.Create(True); LClients := TObjectList.Create(True); @@ -142,7 +168,7 @@ begin Halt(1); end; - for LIndex := 1 to CLIENT_COUNT do + for LIndex := 1 to GClientCount do LClients.Add(TClientThread.Create(LIndex)); for LClient in LClients do LClient.Start; @@ -161,8 +187,9 @@ begin LFirstError := LClient.FirstError; end; - Writeln(Format('clients=%d requests=%d errors=%d max_latency_ms=%d', - [CLIENT_COUNT, CLIENT_COUNT * REQUESTS_PER_CLIENT, LErrors, LMaxLatencyMS])); + Writeln(Format('clients=%d requests=%d delay_ms=%d errors=%d max_latency_ms=%d', + [GClientCount, GClientCount * GRequestsPerClient, GRequestDelayMS, + LErrors, LMaxLatencyMS])); if LErrors <> 0 then begin Writeln('First error: ', LFirstError); diff --git a/tests/console-stability/README.md b/tests/console-stability/README.md index 085707d..b8bcf1a 100644 --- a/tests/console-stability/README.md +++ b/tests/console-stability/README.md @@ -13,3 +13,18 @@ powershell -ExecutionPolicy Bypass -File tests/console-stability/run-console-sta Set `RADSTUDIO_RSVARS` when RAD Studio is installed outside the default Delphi 12 path. + +The default run has no delay so that it can be used as a quick regression +check. The workload can be paced with environment variables. The issue's +reported rate (75,000 transactions from 50 clients over approximately eight +hours) is equivalent to a delay of about 19.2 seconds between requests from +each client: + +```powershell +$env:HORSE_STABILITY_CLIENTS = '50' +$env:HORSE_STABILITY_REQUESTS_PER_CLIENT = '1500' +$env:HORSE_STABILITY_REQUEST_DELAY_MS = '19200' +powershell -ExecutionPolicy Bypass -File tests/console-stability/run-console-stability-test.ps1 +``` + +Unset `HORSE_STABILITY_REQUEST_DELAY_MS` (or set it to `0`) for the quick run.