THRIFT-1880 Make named pipes server work asynchronously (overlapped) to allow for clean server stops
Patch: Jens Geyer
diff --git a/lib/delphi/test/TestClient.pas b/lib/delphi/test/TestClient.pas
index 2f77de8..37fe7d7 100644
--- a/lib/delphi/test/TestClient.pas
+++ b/lib/delphi/test/TestClient.pas
@@ -19,6 +19,9 @@
unit TestClient;
+{.$DEFINE StressTest} // activate to stress-test the server with frequent connects/disconnects
+{.$DEFINE PerfTest} // activate to activate the performance test
+
interface
uses
@@ -63,6 +66,7 @@
procedure ClientTest;
procedure JSONProtocolReadWriteTest;
+ procedure StressTest(const client : TThriftTest.Iface);
protected
procedure Execute; override;
public
@@ -238,11 +242,11 @@
begin
if sPipeName <> '' then begin
Console.WriteLine('Using named pipe ('+sPipeName+')');
- streamtrans := TNamedPipeImpl.Create( sPipeName, 0, nil, TIMEOUT);
+ 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 := TAnonymousPipeImpl.Create( hAnonRead, hAnonWrite, FALSE);
+ streamtrans := TAnonymousPipeTransportImpl.Create( hAnonRead, hAnonWrite, FALSE);
end
else begin
Console.WriteLine('Using sockets ('+host+' port '+IntToStr(port)+')');
@@ -370,6 +374,10 @@
client := TThriftTest.TClient.Create( FProtocol);
FTransport.Open;
+ {$IFDEF StressTest}
+ StressTest( client);
+ {$ENDIF StressTest}
+
// in-depth exception test
// (1) do we get an exception at all?
// (2) do we get the right exception?
@@ -422,6 +430,11 @@
s := client.testString('Test');
Expect( s = 'Test', 'testString(''Test'') = "'+s+'"');
+ s := client.testString(HUGE_TEST_STRING);
+ Expect( length(s) = length(HUGE_TEST_STRING),
+ 'testString( lenght(HUGE_TEST_STRING) = '+IntToStr(Length(HUGE_TEST_STRING))+') '
+ +'=> length(result) = '+IntToStr(Length(s)));
+
i8 := client.testByte(1);
Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));
@@ -831,6 +844,7 @@
Expect( TRUE, 'Test Oneway(1)'); // success := no exception
// call time
+ {$IFDEF PerfTest}
StartTestGroup( 'Test Calltime()');
StartTick := GetTIckCount;
for k := 0 to 1000 - 1 do
@@ -838,12 +852,31 @@
client.testVoid();
end;
Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' );
+ {$ENDIF PerfTest}
// no more tests here
StartTestGroup( '');
end;
+procedure TClientThread.StressTest(const client : TThriftTest.Iface);
+begin
+ while TRUE do begin
+ try
+ if not FTransport.IsOpen then FTransport.Open; // re-open connection, server has already closed
+ try
+ client.testString('Test');
+ Write('.');
+ finally
+ if FTransport.IsOpen then FTransport.Close;
+ end;
+ except
+ on e:Exception do Writeln(#10+e.message);
+ end;
+ end;
+end;
+
+
procedure TClientThread.JSONProtocolReadWriteTest;
// Tests only then read/write procedures of the JSON protocol
// All tests succeed, if we can read what we wrote before