THRIFT-5622 Garbled test output with multithreaded clients

Client: Delphi
Patch: Jens Geyer

2 files changed, 119 insertions, 64 deletions

diff --git a/lib/delphi/test/ConsoleHelper.pas b/lib/delphi/test/ConsoleHelper.pas
index 0a8ddcf10..23c6adc80 100644
--- a/lib/delphi/test/ConsoleHelper.pas
+++ b/lib/delphi/test/ConsoleHelper.pas
@@ -21,31 +21,43 @@ unit ConsoleHelper;
 
 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 @@ end;
 
 { 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 @@ begin
 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 @@ begin
 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 86235ebaf..d541e186d 100644
--- a/lib/delphi/test/TestClient.pas
+++ b/lib/delphi/test/TestClient.pas
@@ -57,13 +57,17 @@ uses
   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 @@ type
       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 @@ type
     {$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 @@ begin
       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 @@ begin
                         '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 @@ begin
 
     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 @@ begin
 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 @@ begin
     // 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 @@ end;
 
 { 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.