You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@thrift.apache.org by je...@apache.org on 2014/09/24 00:27:26 UTC
git commit: THRIFT-2718 Align cmdline help and return codes for
Thrift test server/client Client: Delphi Patch: Jens Geyer
Repository: thrift
Updated Branches:
refs/heads/master 4ab18cef7 -> f8a1b7a29
THRIFT-2718 Align cmdline help and return codes for Thrift test server/client
Client: Delphi
Patch: Jens Geyer
Project: http://git-wip-us.apache.org/repos/asf/thrift/repo
Commit: http://git-wip-us.apache.org/repos/asf/thrift/commit/f8a1b7a2
Tree: http://git-wip-us.apache.org/repos/asf/thrift/tree/f8a1b7a2
Diff: http://git-wip-us.apache.org/repos/asf/thrift/diff/f8a1b7a2
Branch: refs/heads/master
Commit: f8a1b7a29abadf315f4be186fc7dfa4c0a906c42
Parents: 4ab18ce
Author: Jens Geyer <je...@apache.org>
Authored: Wed Sep 24 00:26:46 2014 +0200
Committer: Jens Geyer <je...@apache.org>
Committed: Wed Sep 24 00:26:46 2014 +0200
----------------------------------------------------------------------
lib/delphi/test/TestClient.pas | 413 ++++++++++++++++++++-------------
lib/delphi/test/TestConstants.pas | 44 +++-
lib/delphi/test/TestServer.pas | 234 +++++++++++++------
lib/delphi/test/client.dpr | 8 +-
lib/delphi/test/server.dpr | 8 +-
test/README.md | 26 ++-
6 files changed, 491 insertions(+), 242 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/thrift/blob/f8a1b7a2/lib/delphi/test/TestClient.pas
----------------------------------------------------------------------
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 @@ type
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 @@ type
// 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 @@ type
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 @@ function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPre
{ 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 @@ var
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
-
- 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;
+ while ( i < Length(args) ) do begin
+ s := args[i];
+ Inc( i);
+
+ 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);
+
+ 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);
+
+ 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;
+ 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;
- except
- on E: Exception do
- begin
- Console.WriteLine( E.Message );
+ 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 @@ begin
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;
+ trns_Http: begin
+ Console.WriteLine('Using HTTPClient');
+ http := THTTPClientImpl.Create( host);
+ trans := http;
+ end;
- if bBuffered then begin
- trans := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read()
- Console.WriteLine('Using buffered transport');
+ trns_EvHttp: begin
+ raise Exception.Create(ENDPOINT_TRANSPORTS[endpoint]+' transport not implemented');
end;
- if bFramed then begin
- trans := TFramedTransportImpl.Create( trans );
- Console.WriteLine('Using framed transport');
+ trns_NamedPipes: begin
+ Console.WriteLine('Using named pipe ('+sPipeName+')');
+ streamtrans := TNamedPipeTransportClientEndImpl.Create( sPipeName, 0, nil, TIMEOUT);
end;
- end
- else begin
- Console.WriteLine('Using HTTPClient');
- http := THTTPClientImpl.Create( url );
- trans := http;
+ 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 @@ begin
// (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 @@ begin
// simple things
- StartTestGroup( 'simple Thrift calls');
+ StartTestGroup( 'simple Thrift calls', test_BaseTypes);
client.testVoid();
Expect( TRUE, 'testVoid()'); // success := no exception
@@ -457,7 +529,7 @@ begin
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 @@ begin
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 @@ begin
// 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 @@ begin
// 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 @@ begin
// 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 @@ begin
// 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 @@ begin
// 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 @@ begin
// 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 @@ begin
// multi args
- StartTestGroup( 'testMulti');
+ StartTestGroup( 'testMulti', test_BaseTypes);
arg0 := 1;
arg1 := 2;
arg2 := High(Int64);
@@ -800,7 +872,7 @@ begin
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 @@ begin
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 @@ begin
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 @@ begin
// 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 @@ begin
{$ENDIF PerfTest}
// no more tests here
- StartTestGroup( '');
+ StartTestGroup( '', test_Unknown);
end;
@@ -916,7 +988,7 @@ const
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 @@ begin
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 @@ begin
end
else begin
FErrors.Add( FTestGroup+': '+aTestInfo);
+ Include( FFailed, FCurrentTest);
Console.WriteLine( aTestInfo+': *** FAILED ***');
// We have a failed test!
@@ -1079,6 +1156,17 @@ begin
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 @@ begin
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 @@ begin
// report the outcome
ReportResults;
+ SetReturnValue( CalculateExitCode);
// shutdown
proc := procedure
@@ -1132,6 +1222,7 @@ begin
Synchronize( proc );
end;
+
{ TThreadConsole }
constructor TThreadConsole.Create(AThread: TThread);
http://git-wip-us.apache.org/repos/asf/thrift/blob/f8a1b7a2/lib/delphi/test/TestConstants.pas
----------------------------------------------------------------------
diff --git a/lib/delphi/test/TestConstants.pas b/lib/delphi/test/TestConstants.pas
index f21a4bb..e5aa6c5 100644
--- a/lib/delphi/test/TestConstants.pas
+++ b/lib/delphi/test/TestConstants.pas
@@ -22,12 +22,46 @@ unit TestConstants;
interface
type
- TKnownProtocol = ( prot_Binary, // default binary protocol
- prot_JSON // JSON protocol
- );
+ TKnownProtocol = (
+ prot_Binary, // default binary protocol
+ prot_JSON, // JSON protocol
+ prot_Compact
+ );
+
+ TServerType = (
+ srv_Simple,
+ srv_Nonblocking,
+ srv_Threadpool,
+ srv_Threaded
+ );
+
+ TEndpointTransport = (
+ trns_Sockets,
+ trns_Http,
+ trns_NamedPipes,
+ trns_AnonPipes,
+ trns_EvHttp // as listed on http://thrift.apache.org/test
+ );
+
+ TLayeredTransport = (
+ trns_Buffered,
+ trns_Framed
+ );
+
+ TLayeredTransports = set of TLayeredTransport;
+
const
- KNOWN_PROTOCOLS : array[TKnownProtocol] of string
- = ('binary', 'JSON');
+ SERVER_TYPES : array[TServerType] of string
+ = ('Simple', 'Nonblocking', 'Threadpool', 'Threaded');
+
+ THRIFT_PROTOCOLS : array[TKnownProtocol] of string
+ = ('Binary', 'JSON', 'Compact');
+
+ LAYERED_TRANSPORTS : array[TLayeredTransport] of string
+ = ('Buffered', 'Framed');
+
+ ENDPOINT_TRANSPORTS : array[TEndpointTransport] of string
+ = ('Sockets', 'Http', 'Named Pipes','Anon Pipes', 'EvHttp');
// defaults are: read=false, write=true
BINARY_STRICT_READ = FALSE;
http://git-wip-us.apache.org/repos/asf/thrift/blob/f8a1b7a2/lib/delphi/test/TestServer.pas
----------------------------------------------------------------------
diff --git a/lib/delphi/test/TestServer.pas b/lib/delphi/test/TestServer.pas
index 9d06e8e..286047d 100644
--- a/lib/delphi/test/TestServer.pas
+++ b/lib/delphi/test/TestServer.pas
@@ -81,6 +81,9 @@ type
procedure SetServer( const AServer : IServer );
end;
+ class procedure PrintCmdLineHelp;
+ class procedure InvalidArgs;
+
class procedure LaunchAnonPipeChild( const app : string; const transport : IAnonymousPipeServerTransport);
class procedure Execute( const args: array of string);
end;
@@ -437,6 +440,34 @@ end;
{ TTestServer }
+class procedure TTestServer.PrintCmdLineHelp;
+const HELPTEXT = ' [options]'#10
+ + #10
+ + 'Allowed options:'#10
+ + ' -h [ --help ] produce help message'#10
+ + ' --port arg (=9090) Port number to listen'#10
+ + ' --domain-socket arg Unix Domain Socket (e.g. /tmp/ThriftTest.thrift)'#10
+ + ' --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)'#10
+ + ' --server-type arg (=simple) type of server, "simple", "thread-pool",'#10
+ + ' "threaded", or "nonblocking"'#10
+ + ' --transport arg (=socket) transport: buffered, framed, http, anonpipe'#10
+ + ' --protocol arg (=binary) protocol: binary, compact, json'#10
+ + ' --ssl Encrypted Transport using SSL'#10
+ + ' --processor-events processor-events'#10
+ + ' -n [ --workers ] arg (=4) Number of thread pools workers. Only valid for'#10
+ + ' thread-pool server type'#10
+ ;
+begin
+ Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + HELPTEXT);
+end;
+
+class procedure TTestServer.InvalidArgs;
+begin
+ Console.WriteLine( 'Invalid args.');
+ Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + ' -h for more information');
+ Abort;
+end;
+
class procedure TTestServer.LaunchAnonPipeChild( const app : string; const transport : IAnonymousPipeServerTransport);
//Launch child process and pass R/W anonymous pipe handles on cmd line.
//This is a simple example and does not include elevation or other
@@ -480,10 +511,8 @@ end;
class procedure TTestServer.Execute( const args: array of string);
var
- UseBufferedSockets : Boolean;
- UseFramed : Boolean;
Port : Integer;
- AnonPipe, ServerEvents : Boolean;
+ ServerEvents : Boolean;
sPipeName : string;
testHandler : ITestHandler;
testProcessor : IProcessor;
@@ -493,9 +522,13 @@ var
namedpipe : INamedPipeServerTransport;
TransportFactory : ITransportFactory;
ProtocolFactory : IProtocolFactory;
- i : Integer;
+ i, numWorker : Integer;
s : string;
- protType, p : TKnownProtocol;
+ protType : TKnownProtocol;
+ servertype : TServerType;
+ endpoint : TEndpointTransport;
+ layered : TLayeredTransports;
+ UseSSL : Boolean; // include where appropriate (TLayeredTransport?)
const
// pipe timeouts to be used
DEBUG_TIMEOUT = 30 * 1000;
@@ -503,63 +536,96 @@ const
TIMEOUT = RELEASE_TIMEOUT;
begin
try
- UseBufferedSockets := False;
- UseFramed := False;
- AnonPipe := FALSE;
ServerEvents := FALSE;
protType := prot_Binary;
+ servertype := srv_Simple;
+ endpoint := trns_Sockets;
+ layered := [];
+ UseSSL := FALSE;
Port := 9090;
sPipeName := '';
+ numWorker := 4;
i := 0;
while ( i < Length(args) ) do begin
s := args[i];
Inc(i);
- if StrToIntDef( s, -1) > 0 then
- begin
- Port := StrToIntDef( s, Port);
- end
- else if ( s = 'raw' ) then
- begin
- // as default
+ // Allowed options:
+ if (s = '-h') or (s = '--help') then begin
+ // -h [ --help ] produce help message
+ PrintCmdLineHelp;
+ Exit;
end
- else if ( s = 'buffered' ) then
- begin
- UseBufferedSockets := True;
+ else if (s = '--port') then begin
+ // --port arg (=9090) Port number to listen
+ s := args[i];
+ Inc(i);
+ Port := StrToIntDef( s, Port);
end
- else if ( s = 'framed' ) then
- begin
- UseFramed := True;
+ else if (s = '--domain-socket') then begin
+ // --domain-socket arg Unix Domain Socket (e.g. /tmp/ThriftTest.thrift)
+ raise Exception.Create('domain-socket not supported');
end
- else if (s = '-pipe') then
- begin
+ else if (s = '--named-pipe') then begin
+ // --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)
+ endpoint := trns_NamedPipes;
sPipeName := args[i]; // -pipe <name>
Inc( i );
end
- else if (s = '-anon') then
- begin
- AnonPipe := TRUE;
+ else if (s = '--server-type') then begin
+ // --server-type arg (=simple) type of server,
+ // arg = "simple", "thread-pool", "threaded", or "nonblocking"
+ s := args[i];
+ Inc(i);
+
+ if s = 'simple' then servertype := srv_Simple
+ else if s = 'thread-pool' then servertype := srv_Threadpool
+ else if s = 'threaded' then servertype := srv_Threaded
+ else if s = 'nonblocking' then servertype := srv_Nonblocking
+ else InvalidArgs;
end
- else if (s = '-prot') then // -prot JSON|binary
- begin
+ else if (s = '--transport') then begin
+ // --transport arg (=buffered) transport: buffered, framed, http
s := args[i];
- Inc( i );
- for p:= Low(TKnownProtocol) to High(TKnownProtocol) do begin
- if SameText( s, KNOWN_PROTOCOLS[p]) then begin
- protType := p;
- Break;
- end;
- end;
+ Inc(i);
+
+ 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 = 'anonpipe' 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);
+
+ 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 = '-events' ) then
- begin
- ServerEvents := True;
+ else if (s = '--ssl') then begin
+ // --ssl Encrypted Transport using SSL
+ UseSSL := TRUE;
end
- else begin
- // Fall back to the older boolean syntax
- UseBufferedSockets := StrToBoolDef( args[1], UseBufferedSockets);
+ else if (s = '--processor-events') then begin
+ // --processor-events processor-events
+ ServerEvents := TRUE;
end
+ else if (s = '-n') or (s = '--workers') then begin
+ // -n [ --workers ] arg (=4) Number of thread pools workers.
+ // Only valid for thread-pool server type
+ s := args[i];
+ numWorker := StrToIntDef(s,0);
+ if numWorker > 0
+ then Inc(i)
+ else numWorker := 4;
+ end
+ else begin
+ InvalidArgs;
+ end;
end;
@@ -567,34 +633,49 @@ begin
// create protocol factory, default to BinaryProtocol
case protType of
- prot_Binary: ProtocolFactory := TBinaryProtocolImpl.TFactory.Create( BINARY_STRICT_READ, BINARY_STRICT_WRITE);
- prot_JSON : ProtocolFactory := TJSONProtocolImpl.TFactory.Create;
+ prot_Binary : ProtocolFactory := TBinaryProtocolImpl.TFactory.Create( BINARY_STRICT_READ, BINARY_STRICT_WRITE);
+ prot_JSON : ProtocolFactory := TJSONProtocolImpl.TFactory.Create;
+ prot_Compact : raise Exception.Create('Compact protocol not implemented');
else
- ASSERT( FALSE); // unhandled case!
- ProtocolFactory := TBinaryProtocolImpl.TFactory.Create( BINARY_STRICT_READ, BINARY_STRICT_WRITE);
+ raise Exception.Create('Unhandled protocol');
end;
ASSERT( ProtocolFactory <> nil);
- Console.WriteLine('- '+KNOWN_PROTOCOLS[protType]+' protocol');
+ Console.WriteLine('- '+THRIFT_PROTOCOLS[protType]+' protocol');
+ case endpoint of
- if sPipeName <> '' then begin
- Console.WriteLine('- named pipe ('+sPipeName+')');
- namedpipe := TNamedPipeServerTransportImpl.Create( sPipeName, 4096, PIPE_UNLIMITED_INSTANCES, TIMEOUT);
- servertrans := namedpipe;
- end
- else if AnonPipe then begin
- Console.WriteLine('- anonymous pipes');
- anonymouspipe := TAnonymousPipeServerTransportImpl.Create;
- servertrans := anonymouspipe;
- end
- else begin
- Console.WriteLine('- sockets (port '+IntToStr(port)+')');
- if UseBufferedSockets then Console.WriteLine('- buffered sockets');
- servertrans := TServerSocketImpl.Create( Port, 0, UseBufferedSockets);
+ trns_Sockets : begin
+ Console.WriteLine('- sockets (port '+IntToStr(port)+')');
+ if (trns_Buffered in layered) then Console.WriteLine('- buffered');
+ servertrans := TServerSocketImpl.Create( Port, 0, (trns_Buffered in layered));
+ end;
+
+ trns_Http : begin
+ raise Exception.Create('HTTP server transport not implemented');
+ end;
+
+ trns_NamedPipes : begin
+ Console.WriteLine('- named pipe ('+sPipeName+')');
+ namedpipe := TNamedPipeServerTransportImpl.Create( sPipeName, 4096, PIPE_UNLIMITED_INSTANCES, TIMEOUT);
+ servertrans := namedpipe;
+ end;
+
+ trns_AnonPipes : begin
+ Console.WriteLine('- anonymous pipes');
+ anonymouspipe := TAnonymousPipeServerTransportImpl.Create;
+ servertrans := anonymouspipe;
+ end
+
+ else
+ raise Exception.Create('Unhandled endpoint transport');
end;
ASSERT( servertrans <> nil);
- if UseFramed then begin
+ if UseSSL then begin
+ raise Exception.Create('SSL not implemented');
+ end;
+
+ if (trns_Framed in layered) then begin
Console.WriteLine('- framed transport');
TransportFactory := TFramedTransportImpl.TFactory.Create
end
@@ -606,10 +687,25 @@ begin
testHandler := TTestHandlerImpl.Create;
testProcessor := TThriftTest.TProcessorImpl.Create( testHandler );
- ServerEngine := TSimpleServer.Create( testProcessor,
- ServerTrans,
- TransportFactory,
- ProtocolFactory);
+ case servertype of
+ srv_Simple : begin
+ ServerEngine := TSimpleServer.Create( testProcessor, ServerTrans, TransportFactory, ProtocolFactory);
+ end;
+
+ srv_Nonblocking : begin
+ raise Exception.Create(SERVER_TYPES[servertype]+' server not implemented');
+ end;
+
+ srv_Threadpool,
+ srv_Threaded: begin
+ if numWorker > 1 then {use here};
+ raise Exception.Create(SERVER_TYPES[servertype]+' server not implemented');
+ end;
+
+ else
+ raise Exception.Create('Unhandled server type');
+ end;
+ ASSERT( ServerEngine <> nil);
testHandler.SetServer( ServerEngine);
@@ -620,7 +716,7 @@ begin
end;
// start the client now when we have the anon handles, but before the server starts
- if AnonPipe
+ if endpoint = trns_AnonPipes
then LaunchAnonPipeChild( ExtractFilePath(ParamStr(0))+'client.exe', anonymouspipe);
// install Ctrl+C handler before the server starts
@@ -637,9 +733,9 @@ begin
g_Handler := nil;
except
- on E: Exception do
- begin
- Console.Write( E.Message);
+ on E: EAbort do raise;
+ on E: Exception do begin
+ Console.WriteLine( E.Message + #10 + E.StackTrace );
end;
end;
Console.WriteLine( 'done.');
http://git-wip-us.apache.org/repos/asf/thrift/blob/f8a1b7a2/lib/delphi/test/client.dpr
----------------------------------------------------------------------
diff --git a/lib/delphi/test/client.dpr b/lib/delphi/test/client.dpr
index dc576d9..fd47d8b 100644
--- a/lib/delphi/test/client.dpr
+++ b/lib/delphi/test/client.dpr
@@ -55,12 +55,14 @@ begin
arg := ParamStr( i );
args[i-1] := arg;
end;
- TTestClient.Execute( args );
- Readln;
+ ExitCode := TTestClient.Execute( args);
except
+ on E: EAbort do begin
+ ExitCode := $FF;
+ end;
on E: Exception do begin
Writeln(E.ClassName, ': ', E.Message);
- ExitCode := $FFFF;
+ ExitCode := $FF;
end;
end;
end.
http://git-wip-us.apache.org/repos/asf/thrift/blob/f8a1b7a2/lib/delphi/test/server.dpr
----------------------------------------------------------------------
diff --git a/lib/delphi/test/server.dpr b/lib/delphi/test/server.dpr
index 6dbc914..d30d84b 100644
--- a/lib/delphi/test/server.dpr
+++ b/lib/delphi/test/server.dpr
@@ -56,10 +56,14 @@ begin
args[i-1] := arg;
end;
TTestServer.Execute( args );
- Writeln('Press ENTER to close ... '); Readln;
except
- on E: Exception do
+ on E: EAbort do begin
+ ExitCode := $FF;
+ end;
+ on E: Exception do begin
Writeln(E.ClassName, ': ', E.Message);
+ ExitCode := $FF;
+ end;
end;
end.
http://git-wip-us.apache.org/repos/asf/thrift/blob/f8a1b7a2/test/README.md
----------------------------------------------------------------------
diff --git a/test/README.md b/test/README.md
index 5a9aaa9..5e3e5d5 100755
--- a/test/README.md
+++ b/test/README.md
@@ -18,9 +18,10 @@ line interface for servers:
-h [ --help ] produce help message
--port arg (=9090) Port number to listen
--domain-socket arg Unix Domain Socket (e.g. /tmp/ThriftTest.thrift)
+ --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)
--server-type arg (=simple) type of server, "simple", "thread-pool",
"threaded", or "nonblocking"
- --transport arg (=buffered) transport: buffered, framed, http
+ --transport arg (=buffered) transport: buffered, framed, http, anonpipe
--protocol arg (=binary) protocol: binary, compact, json
--ssl Encrypted Transport using SSL
--processor-events processor-events
@@ -36,15 +37,36 @@ and this for clients:
--port arg (=9090) Port number to connect
--domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift),
instead of host and port
+ --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)
+ --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)
--transport arg (=buffered) Transport: buffered, framed, http, evhttp
--protocol arg (=binary) Protocol: binary, compact, json
--ssl Encrypted Transport using SSL
-n [ --testloops ] arg (=1) Number of Tests
+ -t [ --threads ] arg (=1) Number of Test threads
If you have executed the **make check** or **make cross** then you will be able to browse
[gen-html/ThriftTest.html](gen-html/ThriftTest.html) with the test documentation.
-return code shall be 0 on success or an integer in the range 1 - 255 on error
+The return code (exit code) shall be 0 on success, or an integer in the range 1 - 255 on errors.
+In order to signal failed tests, the return code shall be composed from these bits to indicate
+failing tests:
+
+ #define TEST_BASETYPES 1 // 0000 0001
+ #define TEST_STRUCTS 2 // 0000 0010
+ #define TEST_CONTAINERS 4 // 0000 0100
+ #define TEST_EXCEPTIONS 8 // 0000 1000
+ #define TEST_NOTUSED 240 // 1111 0000 (reserved bits)
+
+Tests that have not been executed at all count as errors.
+
+### Example:
+
+During tests, the test client notices that some of the Struct tests fail.
+Furthermore, due to some other problem none of the Exception tests is executed.
+Therefore, the test client returns the code `10 = 2 | 8`, indicating the failure
+of both test 2 (TEST_STRUCTS) and test 8 (TEST_EXCEPTIONS).
+
## SSL
Test Keys and Certificates are provided in multiple formats under the following