THRIFT-2718 Align cmdline help and return codes for Thrift test server/client
Client: Delphi
Patch: Jens Geyer
diff --git a/lib/delphi/test/TestClient.pas b/lib/delphi/test/TestClient.pas
index d587e46..9001411 100644
--- a/lib/delphi/test/TestClient.pas
+++ b/lib/delphi/test/TestClient.pas
@@ -50,6 +50,17 @@
end;
TClientThread = class( TThread )
+ private type
+ TTestGroup = (
+ test_Unknown,
+ test_BaseTypes,
+ test_Structs,
+ test_Containers,
+ test_Exceptions
+ // new values here
+ );
+ TTestGroups = set of TTestGroup;
+
private
FTransport : ITransport;
FProtocol : IProtocol;
@@ -58,11 +69,15 @@
// test reporting, will be refactored out into separate class later
FTestGroup : string;
+ FCurrentTest : TTestGroup;
FSuccesses : Integer;
FErrors : TStringList;
- procedure StartTestGroup( const aGroup : string);
+ FFailed : TTestGroups;
+ FExecuted : TTestGroups;
+ procedure StartTestGroup( const aGroup : string; const aTest : TTestGroup);
procedure Expect( aTestResult : Boolean; const aTestInfo : string);
procedure ReportResults;
+ function CalculateExitCode : Byte;
procedure ClientTest;
procedure JSONProtocolReadWriteTest;
@@ -81,12 +96,34 @@
class var
FNumIteration : Integer;
FNumThread : Integer;
+
+ class procedure PrintCmdLineHelp;
+ class procedure InvalidArgs;
public
- class procedure Execute( const args: array of string);
+ class function Execute( const args: array of string) : Byte;
end;
+
implementation
+const
+ EXITCODE_SUCCESS = $00; // no errors bits set
+ //
+ EXITCODE_FAILBIT_BASETYPES = $01;
+ EXITCODE_FAILBIT_STRUCTS = $02;
+ EXITCODE_FAILBIT_CONTAINERS = $04;
+ EXITCODE_FAILBIT_EXCEPTIONS = $08;
+
+ MAP_FAILURES_TO_EXITCODE_BITS : array[TClientThread.TTestGroup] of Byte = (
+ EXITCODE_SUCCESS, // no bits here
+ EXITCODE_FAILBIT_BASETYPES,
+ EXITCODE_FAILBIT_STRUCTS,
+ EXITCODE_FAILBIT_CONTAINERS,
+ EXITCODE_FAILBIT_EXCEPTIONS
+ );
+
+
+
function BoolToString( b : Boolean) : string;
// overrides global BoolToString()
begin
@@ -100,19 +137,42 @@
{ TTestClient }
-class procedure TTestClient.Execute(const args: array of string);
+class procedure TTestClient.PrintCmdLineHelp;
+const HELPTEXT = ' [options]'#10
+ + #10
+ + 'Allowed options:'#10
+ + ' -h [ --help ] produce help message'#10
+ + ' --host arg (=localhost) Host to connect'#10
+ + ' --port arg (=9090) Port number to connect'#10
+ + ' --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift),'#10
+ + ' instead of host and port'#10
+ + ' --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)'#10
+ + ' --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)'#10
+ + ' --transport arg (=sockets) Transport: buffered, framed, http, evhttp'#10
+ + ' --protocol arg (=binary) Protocol: binary, compact, json'#10
+ + ' --ssl Encrypted Transport using SSL'#10
+ + ' -n [ --testloops ] arg (=1) Number of Tests'#10
+ + ' -t [ --threads ] arg (=1) Number of Test threads'#10
+ ;
+begin
+ Writeln( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + HELPTEXT);
+end;
+
+class procedure TTestClient.InvalidArgs;
+begin
+ Console.WriteLine( 'Invalid args.');
+ Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + ' -h for more information');
+ Abort;
+end;
+
+class function TTestClient.Execute(const args: array of string) : Byte;
var
i : Integer;
host : string;
port : Integer;
- url : string;
- bBuffered : Boolean;
- bAnonPipe : Boolean;
- bFramed : Boolean;
sPipeName : string;
hAnonRead, hAnonWrite : THandle;
s : string;
- n : Integer;
threads : array of TThread;
dtStart : TDateTime;
test : Integer;
@@ -121,116 +181,117 @@
prot : IProtocol;
streamtrans : IStreamTransport;
http : IHTTPClient;
- protType, p : TKnownProtocol;
+ protType : TKnownProtocol;
+ endpoint : TEndpointTransport;
+ layered : TLayeredTransports;
+ UseSSL : Boolean; // include where appropriate (TLayeredTransport?)
const
// pipe timeouts to be used
DEBUG_TIMEOUT = 30 * 1000;
RELEASE_TIMEOUT = DEFAULT_THRIFT_TIMEOUT;
TIMEOUT = RELEASE_TIMEOUT;
begin
- bBuffered := False;;
- bFramed := False;
protType := prot_Binary;
+ endpoint := trns_Sockets;
+ layered := [];
+ UseSSL := FALSE;
+ host := 'localhost';
+ port := 9090;
+ sPipeName := '';
+ hAnonRead := INVALID_HANDLE_VALUE;
+ hAnonWrite := INVALID_HANDLE_VALUE;
try
- host := 'localhost';
- port := 9090;
- url := '';
- sPipeName := '';
- bAnonPipe := FALSE;
- hAnonRead := INVALID_HANDLE_VALUE;
- hAnonWrite := INVALID_HANDLE_VALUE;
i := 0;
- try
- while ( i < Length(args) ) do
- begin
+ while ( i < Length(args) ) do begin
+ s := args[i];
+ Inc( i);
- try
- if ( args[i] = '-h') then
- begin
- Inc( i );
- s := args[i];
- n := Pos( ':', s);
- if ( n > 0 ) then
- begin
- host := Copy( s, 1, n - 1);
- port := StrToInt( Copy( s, n + 1, MaxInt));
- end else
- begin
- host := s;
- end;
- end
- else if (args[i] = '-u') then
- begin
- Inc( i );
- url := args[i];
- end
- else if (args[i] = '-n') then
- begin
- Inc( i );
- FNumIteration := StrToInt( args[i] );
- end
- else if (args[i] = '-b') then
- begin
- bBuffered := True;
- Console.WriteLine('Buffered transport');
- end
- else if (args[i] = '-f' ) or ( args[i] = '-framed') then
- begin
- bFramed := True;
- Console.WriteLine('Framed transport');
- end
- else if (args[i] = '-pipe') then // -pipe <name>
- begin
- Console.WriteLine('Named pipes transport');
- Inc( i );
- sPipeName := args[i];
- end
- else if (args[i] = '-anon') then // -anon <hReadPipe> <hWritePipe>
- begin
- if Length(args) <= (i+2) then begin
- Console.WriteLine('Invalid args: -anon <hRead> <hWrite> or use "server.exe -anon"');
- Halt(1);
- end;
- Console.WriteLine('Anonymous pipes transport');
- Inc( i);
- hAnonRead := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
- Inc( i);
- hAnonWrite := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
- bAnonPipe := TRUE;
- end
- else if (args[i] = '-t') then
- begin
- Inc( i );
- FNumThread := StrToInt( args[i] );
- end
- else if (args[i] = '-prot') then // -prot JSON|binary
- begin
- Inc( i );
- s := args[i];
- for p:= Low(TKnownProtocol) to High(TKnownProtocol) do begin
- if SameText( s, KNOWN_PROTOCOLS[p]) then begin
- protType := p;
- Console.WriteLine('Using '+KNOWN_PROTOCOLS[protType]+' protocol');
- Break;
- end;
- end;
- end;
- finally
- Inc( i );
- end;
+ if (s = '-h') or (s = '--help') then begin
+ // -h [ --help ] produce help message
+ PrintCmdLineHelp;
+ result := $FF; // all tests failed
+ Exit;
+ end
+ else if s = '-host' then begin
+ // -host arg (=localhost) Host to connect
+ host := args[i];
+ Inc( i);
+ end
+ else if s = '-port' then begin
+ // -port arg (=9090) Port number to connect
+ s := args[i];
+ Inc( i);
+ port := StrToIntDef(s,0);
+ if port <= 0 then InvalidArgs;
+ end
+ else if s = '-domain-socket' then begin
+ // -domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift), instead of host and port
+ raise Exception.Create('domain-socket not supported');
+ end
+ else if s = '-named-pipe' then begin
+ // -named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)
+ endpoint := trns_NamedPipes;
+ sPipeName := args[i];
+ Inc( i);
+ end
+ else if s = '-anon-pipes' then begin
+ // -anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)
+ endpoint := trns_AnonPipes;
+ hAnonRead := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
+ Inc( i);
+ hAnonWrite := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
+ Inc( i);
+ end
+ else if s = '-transport' then begin
+ // -transport arg (=sockets) Transport: buffered, framed, http, evhttp
+ s := args[i];
+ Inc( i);
- end;
+ if s = 'buffered' then Include( layered, trns_Buffered)
+ else if s = 'framed' then Include( layered, trns_Framed)
+ else if s = 'http' then endpoint := trns_Http
+ else if s = 'evhttp' then endpoint := trns_AnonPipes
+ else InvalidArgs;
+ end
+ else if s = '-protocol' then begin
+ // -protocol arg (=binary) Protocol: binary, compact, json
+ s := args[i];
+ Inc( i);
- except
- on E: Exception do
- begin
- Console.WriteLine( E.Message );
+ if s = 'binary' then protType := prot_Binary
+ else if s = 'compact' then protType := prot_Compact
+ else if s = 'json' then protType := prot_JSON
+ else InvalidArgs;
+ end
+ else if s = '-ssl' then begin
+ // -ssl Encrypted Transport using SSL
+ UseSSL := TRUE;
+
+ end
+ else if (s = '-n') or (s = '--testloops') then begin
+ // -n [ --testloops ] arg (=1) Number of Tests
+ FNumIteration := StrToIntDef( args[i], 0);
+ Inc( i);
+ if FNumIteration <= 0
+ then InvalidArgs;
+
+ end
+ else if (s = '-t') or (s = '--threads') then begin
+ // -t [ --threads ] arg (=1) Number of Test threads
+ FNumThread := StrToIntDef( args[i], 0);
+ Inc( i);
+ if FNumThread <= 0
+ then InvalidArgs;
+ end
+ else begin
+ InvalidArgs;
end;
end;
+
// In the anonymous pipes mode the client is launched by the test server
// -> behave nicely and allow for attaching a debugger to this process
- if bAnonPipe and not IsDebuggerPresent
+ if (endpoint = trns_AnonPipes) and not IsDebuggerPresent
then MessageBox( 0, 'Attach Debugger and/or click OK to continue.',
'Thrift TestClient (Delphi)',
MB_OK or MB_ICONEXCLAMATION);
@@ -240,72 +301,83 @@
for test := 0 to FNumThread - 1 do
begin
- if url = '' then
- begin
- if sPipeName <> '' then begin
- Console.WriteLine('Using named pipe ('+sPipeName+')');
- streamtrans := TNamedPipeTransportClientEndImpl.Create( sPipeName, 0, nil, TIMEOUT);
- end
- else if bAnonPipe then begin
- Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(hAnonRead))+' and '+IntToStr(Integer(hAnonWrite))+')');
- streamtrans := TAnonymousPipeTransportImpl.Create( hAnonRead, hAnonWrite, FALSE);
- end
- else begin
+ case endpoint of
+ trns_Sockets: begin
Console.WriteLine('Using sockets ('+host+' port '+IntToStr(port)+')');
streamtrans := TSocketImpl.Create( host, port );
end;
- trans := streamtrans;
-
- if bBuffered then begin
- trans := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read()
- Console.WriteLine('Using buffered transport');
+ trns_Http: begin
+ Console.WriteLine('Using HTTPClient');
+ http := THTTPClientImpl.Create( host);
+ trans := http;
end;
- if bFramed then begin
- trans := TFramedTransportImpl.Create( trans );
- Console.WriteLine('Using framed transport');
+ trns_EvHttp: begin
+ raise Exception.Create(ENDPOINT_TRANSPORTS[endpoint]+' transport not implemented');
end;
- end
- else begin
- Console.WriteLine('Using HTTPClient');
- http := THTTPClientImpl.Create( url );
- trans := http;
+ trns_NamedPipes: begin
+ Console.WriteLine('Using named pipe ('+sPipeName+')');
+ streamtrans := TNamedPipeTransportClientEndImpl.Create( sPipeName, 0, nil, TIMEOUT);
+ end;
+
+ trns_AnonPipes: begin
+ Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(hAnonRead))+' and '+IntToStr(Integer(hAnonWrite))+')');
+ streamtrans := TAnonymousPipeTransportImpl.Create( hAnonRead, hAnonWrite, FALSE);
+ end;
+
+ else
+ raise Exception.Create('Unhandled endpoint transport');
+ end;
+ trans := streamtrans;
+ ASSERT( trans <> nil);
+
+ if (trns_Buffered in layered) then begin
+ trans := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read()
+ Console.WriteLine('Using buffered transport');
+ end;
+
+ if (trns_Framed in layered) then begin
+ trans := TFramedTransportImpl.Create( trans );
+ Console.WriteLine('Using framed transport');
+ end;
+
+ if UseSSL then begin
+ raise Exception.Create('SSL not implemented');
end;
// create protocol instance, default to BinaryProtocol
case protType of
- prot_Binary: prot := TBinaryProtocolImpl.Create( trans, BINARY_STRICT_READ, BINARY_STRICT_WRITE);
- prot_JSON : prot := TJSONProtocolImpl.Create( trans);
+ prot_Binary : prot := TBinaryProtocolImpl.Create( trans, BINARY_STRICT_READ, BINARY_STRICT_WRITE);
+ prot_JSON : prot := TJSONProtocolImpl.Create( trans);
+ prot_Compact : raise Exception.Create('Compact protocol not implemented');
else
- ASSERT( FALSE); // unhandled case!
- prot := TBinaryProtocolImpl.Create( trans, BINARY_STRICT_READ, BINARY_STRICT_WRITE); // use default
+ raise Exception.Create('Unhandled protocol');
end;
+ ASSERT( trans <> nil);
+ Console.WriteLine(THRIFT_PROTOCOLS[protType]+' protocol');
thread := TClientThread.Create( trans, prot, FNumIteration);
threads[test] := thread;
-{$WARN SYMBOL_DEPRECATED OFF}
- thread.Resume;
-{$WARN SYMBOL_DEPRECATED ON}
+ thread.Start;
end;
- for test := 0 to FNumThread - 1 do
- begin
- threads[test].WaitFor;
+ result := 0;
+ for test := 0 to FNumThread - 1 do begin
+ result := result or threads[test].WaitFor;
end;
- for test := 0 to FNumThread - 1 do
- begin
- threads[test].Free;
- end;
+ for test := 0 to FNumThread - 1
+ do threads[test].Free;
Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));
except
- on E: Exception do
- begin
- Console.WriteLine( E.Message + ' ST: ' + E.StackTrace );
+ on E: EAbort do raise;
+ on E: Exception do begin
+ Console.WriteLine( E.Message + #10 + E.StackTrace);
+ raise;
end;
end;
@@ -384,7 +456,7 @@
// (1) do we get an exception at all?
// (2) do we get the right exception?
// (3) does the exception contain the expected data?
- StartTestGroup( 'testException');
+ StartTestGroup( 'testException', test_Exceptions);
// case 1: exception type declared in IDL at the function call
try
client.testException('Xception');
@@ -430,7 +502,7 @@
// simple things
- StartTestGroup( 'simple Thrift calls');
+ StartTestGroup( 'simple Thrift calls', test_BaseTypes);
client.testVoid();
Expect( TRUE, 'testVoid()'); // success := no exception
@@ -457,7 +529,7 @@
Expect( abs(dub-5.325098235) < 1e-14, 'testDouble(5.325098235) = ' + FloatToStr( dub));
// structs
- StartTestGroup( 'testStruct');
+ StartTestGroup( 'testStruct', test_Structs);
Console.WriteLine('testStruct({''Zero'', 1, -3, -5})');
o := TXtructImpl.Create;
o.String_thing := 'Zero';
@@ -475,7 +547,7 @@
Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
// nested structs
- StartTestGroup( 'testNest');
+ StartTestGroup( 'testNest', test_Structs);
Console.WriteLine('testNest({1, {''Zero'', 1, -3, -5}, 5})');
o2 := TXtruct2Impl.Create;
o2.Byte_thing := 1;
@@ -498,7 +570,7 @@
// map<type1,type2>: A map of strictly unique keys to values.
// Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
- StartTestGroup( 'testMap');
+ StartTestGroup( 'testMap', test_Containers);
mapout := TThriftDictionaryImpl<Integer,Integer>.Create;
for j := 0 to 4 do
begin
@@ -530,7 +602,7 @@
// map<type1,type2>: A map of strictly unique keys to values.
// Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
- StartTestGroup( 'testStringMap');
+ StartTestGroup( 'testStringMap', test_Containers);
strmapout := TThriftDictionaryImpl<string,string>.Create;
for j := 0 to 4 do
begin
@@ -565,7 +637,7 @@
// set<type>: An unordered set of unique elements.
// Translates to an STL set, Java HashSet, set in Python, etc.
// Note: PHP does not support sets, so it is treated similar to a List
- StartTestGroup( 'testSet');
+ StartTestGroup( 'testSet', test_Containers);
setout := THashSetImpl<Integer>.Create;
for j := -2 to 2 do
begin
@@ -592,7 +664,7 @@
// list<type>: An ordered list of elements.
// Translates to an STL vector, Java ArrayList, native arrays in scripting languages, etc.
- StartTestGroup( 'testList');
+ StartTestGroup( 'testList', test_Containers);
listout := TThriftListImpl<Integer>.Create;
listout.Add( +1);
listout.Add( -2);
@@ -642,7 +714,7 @@
// maps of maps
- StartTestGroup( 'testMapMap(1)');
+ StartTestGroup( 'testMapMap(1)', test_Containers);
mm := client.testMapMap(1);
Console.Write(' = {');
for key in mm.Keys do
@@ -670,7 +742,7 @@
// insanity
- StartTestGroup( 'testInsanity');
+ StartTestGroup( 'testInsanity', test_Structs);
insane := TInsanityImpl.Create;
insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);
@@ -776,7 +848,7 @@
// multi args
- StartTestGroup( 'testMulti');
+ StartTestGroup( 'testMulti', test_BaseTypes);
arg0 := 1;
arg1 := 2;
arg2 := High(Int64);
@@ -800,7 +872,7 @@
Expect( i.__isset_I64_thing, 'testMulti: i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
// multi exception
- StartTestGroup( 'testMultiException(1)');
+ StartTestGroup( 'testMultiException(1)', test_Exceptions);
try
i := client.testMultiException( 'need more pizza', 'run out of beer');
Expect( i.String_thing = 'run out of beer', 'i.String_thing = "' +i.String_thing+ '"');
@@ -814,7 +886,7 @@
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
end;
- StartTestGroup( 'testMultiException(Xception)');
+ StartTestGroup( 'testMultiException(Xception)', test_Exceptions);
try
i := client.testMultiException( 'Xception', 'second test');
Expect( FALSE, 'testMultiException(''Xception''): must trow an exception');
@@ -828,7 +900,7 @@
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
end;
- StartTestGroup( 'testMultiException(Xception2)');
+ StartTestGroup( 'testMultiException(Xception2)', test_Exceptions);
try
i := client.testMultiException( 'Xception2', 'third test');
Expect( FALSE, 'testMultiException(''Xception2''): must trow an exception');
@@ -850,7 +922,7 @@
// oneway functions
- StartTestGroup( 'Test Oneway(1)');
+ StartTestGroup( 'Test Oneway(1)', test_Unknown);
client.testOneway(1);
Expect( TRUE, 'Test Oneway(1)'); // success := no exception
@@ -866,7 +938,7 @@
{$ENDIF PerfTest}
// no more tests here
- StartTestGroup( '');
+ StartTestGroup( '', test_Unknown);
end;
@@ -916,7 +988,7 @@
begin
stm := TStringStream.Create;
try
- StartTestGroup( 'JsonProtocolTest'); // no more tests here
+ StartTestGroup( 'JsonProtocolTest', test_Unknown);
// prepare binary data
SetLength( binary, $100);
@@ -1018,14 +1090,18 @@
finally
stm.Free;
prot := nil; //-> Release
- StartTestGroup( ''); // no more tests here
+ StartTestGroup( '', test_Unknown); // no more tests here
end;
end;
-procedure TClientThread.StartTestGroup( const aGroup : string);
+procedure TClientThread.StartTestGroup( const aGroup : string; const aTest : TTestGroup);
begin
FTestGroup := aGroup;
+ FCurrentTest := aTest;
+
+ Include( FExecuted, aTest);
+
if FTestGroup <> '' then begin
Console.WriteLine('');
Console.WriteLine( aGroup+' tests');
@@ -1042,6 +1118,7 @@
end
else begin
FErrors.Add( FTestGroup+': '+aTestInfo);
+ Include( FFailed, FCurrentTest);
Console.WriteLine( aTestInfo+': *** FAILED ***');
// We have a failed test!
@@ -1079,6 +1156,17 @@
end;
+function TClientThread.CalculateExitCode : Byte;
+var test : TTestGroup;
+begin
+ result := EXITCODE_SUCCESS;
+ for test := Low(TTestGroup) to High(TTestGroup) do begin
+ if (test in FFailed) or not (test in FExecuted)
+ then result := result or MAP_FAILURES_TO_EXITCODE_BITS[test];
+ end;
+end;
+
+
constructor TClientThread.Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
begin
inherited Create( True );
@@ -1086,6 +1174,7 @@
FTransport := ATransport;
FProtocol := AProtocol;
FConsole := TThreadConsole.Create( Self );
+ FCurrentTest := test_Unknown;
// error list: keep correct order, allow for duplicates
FErrors := TStringList.Create;
@@ -1118,6 +1207,7 @@
// report the outcome
ReportResults;
+ SetReturnValue( CalculateExitCode);
// shutdown
proc := procedure
@@ -1132,6 +1222,7 @@
Synchronize( proc );
end;
+
{ TThreadConsole }
constructor TThreadConsole.Create(AThread: TThread);