THRIFT-5622 Garbled test output with multithreaded clients
Client: Delphi
Patch: Jens Geyer
diff --git a/lib/delphi/test/ConsoleHelper.pas b/lib/delphi/test/ConsoleHelper.pas
index 0a8ddcf..23c6adc 100644
--- a/lib/delphi/test/ConsoleHelper.pas
+++ b/lib/delphi/test/ConsoleHelper.pas
@@ -21,31 +21,43 @@
interface
-uses Classes;
+uses Classes, SysUtils, SyncObjs;
type
TThriftConsole = class
+ strict private
+ FLock : TCriticalSection;
+ strict protected
+ procedure Lock;
+ procedure UnLock;
public
+ constructor Create;
+ destructor Destroy; override;
+
procedure Write( const S: string); virtual;
procedure WriteLine( const S: string); virtual;
end;
+
TGUIConsole = class( TThriftConsole )
- private
+ strict private
FLineBreak : Boolean;
FMemo : TStrings;
procedure InternalWrite( const S: string; bWriteLine: Boolean);
public
+ constructor Create( AMemo: TStrings);
+
procedure Write( const S: string); override;
procedure WriteLine( const S: string); override;
- constructor Create( AMemo: TStrings);
end;
+
function Console: TThriftConsole;
procedure ChangeConsole( AConsole: TThriftConsole );
procedure RestoreConsoleToDefault;
+
implementation
var
@@ -59,14 +71,46 @@
{ TThriftConsole }
+constructor TThriftConsole.Create;
+begin
+ inherited Create;
+ FLock := TCriticalSection.Create;
+end;
+
+destructor TThriftConsole.Destroy;
+begin
+ FreeAndNil( FLock);
+ inherited Destroy;
+end;
+
+procedure TThriftConsole.Lock;
+begin
+ FLock.Enter;
+end;
+
+procedure TThriftConsole.UnLock;
+begin
+ FLock.Leave;
+end;
+
procedure TThriftConsole.Write(const S: string);
begin
- System.Write( S );
+ Lock;
+ try
+ System.Write( S );
+ finally
+ Unlock;
+ end;
end;
procedure TThriftConsole.WriteLine(const S: string);
begin
- System.Writeln( S );
+ Lock;
+ try
+ System.Writeln( S );
+ finally
+ Unlock;
+ end;
end;
procedure ChangeConsole( AConsole: TThriftConsole );
@@ -89,21 +133,25 @@
end;
procedure TGUIConsole.InternalWrite(const S: string; bWriteLine: Boolean);
-var
- idx : Integer;
+var idx : Integer;
begin
- if FLineBreak then
- begin
- FMemo.Add( S );
- end else
- begin
- idx := FMemo.Count - 1;
- if idx < 0 then
+ Lock;
+ try
+
+ if FLineBreak then begin
FMemo.Add( S )
- else
- FMemo[idx] := FMemo[idx] + S;
+ end
+ else begin
+ idx := FMemo.Count - 1;
+ if idx < 0
+ then FMemo.Add( S )
+ else FMemo[idx] := FMemo[idx] + S;
+ end;
+ FLineBreak := bWriteLine;
+
+ finally
+ Unlock;
end;
- FLineBreak := bWriteLine;
end;
procedure TGUIConsole.Write(const S: string);
@@ -117,15 +165,12 @@
end;
initialization
-begin
FDefaultConsole := TThriftConsole.Create;
FConsole := FDefaultConsole;
-end;
finalization
-begin
FDefaultConsole.Free;
-end;
+ FDefaultConsole := nil;
end.
diff --git a/lib/delphi/test/TestClient.pas b/lib/delphi/test/TestClient.pas
index 86235eb..d541e18 100644
--- a/lib/delphi/test/TestClient.pas
+++ b/lib/delphi/test/TestClient.pas
@@ -57,13 +57,17 @@
Thrift.Collections;
type
- TThreadConsole = class
- private
- FThread : TThread;
+ TClientThread = class;
+
+ TThreadConsole = class(TThriftConsole)
+ strict private
+ FThread : TClientThread;
+ FLogThreadID : Boolean;
public
- procedure Write( const S : string);
- procedure WriteLine( const S : string);
- constructor Create( AThread: TThread);
+ constructor Create( const aThread: TClientThread; const aLogThreadID : Boolean);
+
+ procedure Write( const S: string); override;
+ procedure WriteLine( const S: string); override;
end;
TTestSetup = record
@@ -97,11 +101,13 @@
FifteenMB // quite a bit of data, but still below the default max frame size
);
- private
+ strict private
FSetup : TTestSetup;
FTransport : ITransport;
FProtocol : IProtocol;
- FNumIteration : Integer;
+ FNumIterations : Integer;
+
+ FThreadNo : Integer;
FConsole : TThreadConsole;
// test reporting, will be refactored out into separate class later
@@ -133,18 +139,23 @@
{$IFDEF Win64}
procedure UseInterlockedExchangeAdd64;
{$ENDIF}
- protected
+
+ strict protected
procedure Execute; override;
+ property Console : TThreadConsole read FConsole;
+
public
- constructor Create( const aSetup : TTestSetup; const aNumIteration: Integer);
+ constructor Create( const aSetup : TTestSetup; const aNumIteration, aThreadNo: Integer; const aLogThreadID : Boolean);
destructor Destroy; override;
+
+ property ThreadNo : Integer read FThreadNo;
end;
TTestClient = class
private
class var
- FNumIteration : Integer;
- FNumThread : Integer;
+ FNumIterations : Integer;
+ FNumThreads : Integer;
class procedure PrintCmdLineHelp;
class procedure InvalidArgs;
@@ -314,15 +325,15 @@
end
else if IsSwitch( sArg, '-n', sValue) or IsSwitch( sArg, '--testloops', sValue) then begin
// -n [ --testloops ] arg (=1) Number of Tests
- FNumIteration := StrToIntDef( sValue, 0);
- if FNumIteration <= 0
+ FNumIterations := StrToIntDef( sValue, 0);
+ if FNumIterations <= 0
then InvalidArgs;
end
else if IsSwitch( sArg, '-t', sValue) or IsSwitch( sArg, '--threads', sValue) then begin
// -t [ --threads ] arg (=1) Number of Test threads
- FNumThread := StrToIntDef( sValue, 0);
- if FNumThread <= 0
+ FNumThreads := StrToIntDef( sValue, 0);
+ if FNumThreads <= 0
then InvalidArgs;
end
else if IsSwitch( sArg, '--performance', sValue) then begin
@@ -342,7 +353,7 @@
'Thrift TestClient (Delphi)',
MB_OK or MB_ICONEXCLAMATION);
- SetLength( threads, FNumThread);
+ SetLength( threads, FNumThreads);
dtStart := Now;
// layered transports are not really meant to be stacked upon each other
@@ -355,14 +366,20 @@
Console.WriteLine(THRIFT_PROTOCOLS[setup.protType]+' protocol');
- for test := 0 to FNumThread - 1 do begin
- thread := TClientThread.Create( setup, FNumIteration);
+ if FNumThreads <> 1
+ then Console.WriteLine(IntToStr(FNumThreads)+' client threads');
+
+ if FNumIterations <> 1
+ then Console.WriteLine(IntToStr(FNumIterations)+' iterations');
+
+ for test := 0 to FNumThreads - 1 do begin
+ thread := TClientThread.Create( setup, FNumIterations, test, FNumThreads<>1);
threads[test] := thread;
thread.Start;
end;
result := 0;
- for test := 0 to FNumThread - 1 do begin
+ for test := 0 to FNumThreads - 1 do begin
threadExitCode := threads[test].WaitFor;
result := result or threadExitCode;
threads[test].Free;
@@ -1294,12 +1311,13 @@
end;
-constructor TClientThread.Create( const aSetup : TTestSetup; const aNumIteration: Integer);
+constructor TClientThread.Create( const aSetup : TTestSetup; const aNumIteration, aThreadNo: Integer; const aLogThreadID : Boolean);
begin
FSetup := aSetup;
- FNumIteration := ANumIteration;
+ FThreadNo := aThreadNo;
+ FNumIterations := aNumIteration;
- FConsole := TThreadConsole.Create( Self );
+ FConsole := TThreadConsole.Create( Self, aLogThreadID);
FCurrentTest := test_Unknown;
// error list: keep correct order, allow for duplicates
@@ -1331,7 +1349,7 @@
// must be run in the context of the thread
InitializeProtocolTransportStack;
try
- for i := 0 to FNumIteration - 1 do begin
+ for i := 0 to FNumIterations - 1 do begin
ClientTest;
{$IFDEF SupportsAsync}
ClientAsyncTest;
@@ -1484,38 +1502,30 @@
{ TThreadConsole }
-constructor TThreadConsole.Create(AThread: TThread);
+constructor TThreadConsole.Create( const aThread: TClientThread; const aLogThreadID : Boolean);
begin
inherited Create;
FThread := AThread;
+ FLogThreadID := aLogThreadID;
end;
procedure TThreadConsole.Write(const S: string);
-var
- proc : TThreadProcedure;
begin
- proc := procedure
- begin
- Console.Write( S );
- end;
- TThread.Synchronize( FThread, proc);
+ if FLogThreadID
+ then ConsoleHelper.Console.Write( IntToStr(FThread.ThreadNo)+'> '+S)
+ else ConsoleHelper.Console.Write( S);
end;
procedure TThreadConsole.WriteLine(const S: string);
-var
- proc : TThreadProcedure;
begin
- proc := procedure
- begin
- Console.WriteLine( S );
- end;
- TThread.Synchronize( FThread, proc);
+ if FLogThreadID
+ then ConsoleHelper.Console.WriteLine( IntToStr(FThread.ThreadNo)+'> '+S)
+ else ConsoleHelper.Console.WriteLine( S);
end;
+
initialization
-begin
- TTestClient.FNumIteration := 1;
- TTestClient.FNumThread := 1;
-end;
+ TTestClient.FNumIterations := 1;
+ TTestClient.FNumThreads := 1;
end.