THRIFT-5789 Refactor test suite client implementation
Client: Delphi
Patch: Jens Geyer
diff --git a/lib/delphi/test/testsuite/client/TestLogger.pas b/lib/delphi/test/testsuite/client/TestLogger.pas
new file mode 100644
index 0000000..10ddfc7
--- /dev/null
+++ b/lib/delphi/test/testsuite/client/TestLogger.pas
@@ -0,0 +1,193 @@
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+
+unit TestLogger;
+
+{$I ../src/Thrift.Defines.inc}
+
+interface
+
+uses
+ Classes, Windows, SysUtils, Math, ActiveX, ComObj,
+ {$IFDEF SupportsAsync} System.Threading, {$ENDIF}
+ DateUtils,
+ Generics.Collections,
+ TestConstants,
+ ConsoleHelper,
+ Thrift,
+ Thrift.Protocol.Compact,
+ Thrift.Protocol.JSON,
+ Thrift.Protocol,
+ Thrift.Transport.Pipes,
+ Thrift.Transport.WinHTTP,
+ Thrift.Transport.MsxmlHTTP,
+ Thrift.Transport,
+ Thrift.Stream,
+ Thrift.Test,
+ Thrift.WinHTTP,
+ Thrift.Utils,
+ Thrift.Configuration,
+ Thrift.Collections;
+
+
+type
+ TClientTestGroup = (
+ test_Unknown,
+ test_BaseTypes,
+ test_Structs,
+ test_Containers,
+ test_Exceptions
+ // new values here
+ );
+ TClientTestGroups = set of TClientTestGroup;
+
+
+ ITestLogger = interface
+ ['{26693ED5-1469-48AD-B1F3-04281B053DD4}']
+ procedure StartTestGroup( const aGroup : string; const aTest : TClientTestGroup);
+ procedure Expect( aTestResult : Boolean; const aTestInfo : string);
+ procedure QueryTestStats( out failed, executed : TClientTestGroups);
+ procedure ReportResults;
+ end;
+
+
+ // test reporting helper
+ TTestLoggerImpl = class( TInterfacedObject, ITestLogger)
+ strict private
+ FTestGroup : string;
+ FCurrentTest : TClientTestGroup;
+ FSuccesses : Integer;
+ FErrors : TStringList;
+ FFailed : TClientTestGroups;
+ FExecuted : TClientTestGroups;
+
+ strict protected
+ // ITestLogger = interface
+ procedure StartTestGroup( const aGroup : string; const aTest : TClientTestGroup);
+ procedure Expect( aTestResult : Boolean; const aTestInfo : string);
+ procedure QueryTestStats( out failed, executed : TClientTestGroups);
+ procedure ReportResults;
+
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ end;
+
+
+implementation
+
+
+constructor TTestLoggerImpl.Create;
+begin
+ inherited Create;
+ FCurrentTest := test_Unknown;
+
+ // error list: keep correct order, allow for duplicates
+ FErrors := TStringList.Create;
+ FErrors.Sorted := FALSE;
+ FErrors.Duplicates := dupAccept;
+end;
+
+
+destructor TTestLoggerImpl.Destroy;
+begin
+ try
+ FreeAndNil( FErrors);
+ finally
+ inherited Destroy;
+ end;
+end;
+
+
+procedure TTestLoggerImpl.StartTestGroup( const aGroup : string; const aTest : TClientTestGroup);
+begin
+ FTestGroup := aGroup;
+ FCurrentTest := aTest;
+
+ Include( FExecuted, aTest);
+
+ if FTestGroup <> '' then begin
+ Console.WriteLine('');
+ Console.WriteLine( aGroup+' tests');
+ Console.WriteLine( StringOfChar('-',60));
+ end;
+end;
+
+
+procedure TTestLoggerImpl.Expect( aTestResult : Boolean; const aTestInfo : string);
+begin
+ if aTestResult then begin
+ Inc(FSuccesses);
+ Console.WriteLine( aTestInfo+': passed');
+ end
+ else begin
+ FErrors.Add( FTestGroup+': '+aTestInfo);
+ Include( FFailed, FCurrentTest);
+ Console.WriteLine( aTestInfo+': *** FAILED ***');
+
+ // We have a failed test!
+ // -> issue DebugBreak ONLY if a debugger is attached,
+ // -> unhandled DebugBreaks would cause Windows to terminate the app otherwise
+ if IsDebuggerPresent
+ then {$IFDEF CPUX64} DebugBreak {$ELSE} asm int 3 end {$ENDIF};
+ end;
+end;
+
+
+procedure TTestLoggerImpl.QueryTestStats( out failed, executed : TClientTestGroups);
+begin
+ failed := FFailed;
+ executed := FExecuted;
+end;
+
+
+
+procedure TTestLoggerImpl.ReportResults;
+var nTotal : Integer;
+ sLine : string;
+begin
+ // prevent us from stupid DIV/0 errors
+ nTotal := FSuccesses + FErrors.Count;
+ if nTotal = 0 then begin
+ Console.WriteLine('No results logged');
+ Exit;
+ end;
+
+ Console.WriteLine('');
+ Console.WriteLine( StringOfChar('=',60));
+ Console.WriteLine( IntToStr(nTotal)+' tests performed');
+ Console.WriteLine( IntToStr(FSuccesses)+' tests succeeded ('+IntToStr(round(100*FSuccesses/nTotal))+'%)');
+ Console.WriteLine( IntToStr(FErrors.Count)+' tests failed ('+IntToStr(round(100*FErrors.Count/nTotal))+'%)');
+ Console.WriteLine( StringOfChar('=',60));
+ if FErrors.Count > 0 then begin
+ Console.WriteLine('FAILED TESTS:');
+ for sLine in FErrors do Console.WriteLine('- '+sLine);
+ Console.WriteLine( StringOfChar('=',60));
+ InterlockedIncrement( ExitCode); // return <> 0 on errors
+ end;
+ Console.WriteLine('');
+end;
+
+
+
+
+
+
+end.