THRIFT-1713 Named and Anonymous Pipe transport (Delphi)
Patch: Jens Geyer
git-svn-id: https://svn.apache.org/repos/asf/thrift/trunk@1394952 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/delphi/src/Thrift.Transport.Pipes.pas b/lib/delphi/src/Thrift.Transport.Pipes.pas
new file mode 100644
index 0000000..8f7ec59
--- /dev/null
+++ b/lib/delphi/src/Thrift.Transport.Pipes.pas
@@ -0,0 +1,710 @@
+(*
+ * 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 Thrift.Transport.Pipes;
+
+{$WARN SYMBOL_PLATFORM OFF}
+
+interface
+
+uses
+ Windows, SysUtils, Math, AccCtrl, AclAPI,
+ Thrift.Transport,
+ Thrift.Console,
+ Thrift.Stream;
+
+const
+ DEFAULT_THRIFT_PIPE_TIMEOUT = 5 * 1000; // ms
+
+
+type
+ IPipe = interface( IStreamTransport)
+ ['{5E05CC85-434F-428F-BFB2-856A168B5558}']
+ end;
+
+
+ TPipeStreamImpl = class( TThriftStreamImpl)
+ private
+ FPipe : THandle;
+ FOwner : Boolean;
+ FPipeName : string;
+ FTimeout : DWORD;
+ FShareMode: DWORD;
+ FSecurityAttribs : PSecurityAttributes;
+
+ protected
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+ procedure Open; override;
+ procedure Close; override;
+ procedure Flush; override;
+
+ function IsOpen: Boolean; override;
+ function ToArray: TBytes; override;
+ public
+ constructor Create( const aPipeHandle : THandle; aOwnsHandle : Boolean); overload;
+ constructor Create( const aPipeName : string;
+ const aShareMode: DWORD = 0;
+ const aSecurityAttributes: PSecurityAttributes = nil;
+ const aTimeOut : DWORD = DEFAULT_THRIFT_PIPE_TIMEOUT); overload;
+ destructor Destroy; override;
+ end;
+
+
+ TNamedPipeImpl = class( TStreamTransportImpl, IPipe)
+ public
+ FOwner : Boolean;
+
+ // Constructs a new pipe object.
+ constructor Create(); overload;
+ // Named pipe constructors
+ constructor Create( aPipe : THandle; aOwnsHandle : Boolean); overload;
+ constructor Create( const aPipeName : string;
+ const aShareMode: DWORD = 0;
+ const aSecurityAttributes: PSecurityAttributes = nil;
+ const aTimeOut : DWORD = DEFAULT_THRIFT_PIPE_TIMEOUT); overload;
+
+ // ITransport
+ function GetIsOpen: Boolean; override;
+ procedure Open; override;
+ procedure Close; override;
+ end;
+
+
+ TAnonymousPipeImpl = class( TStreamTransportImpl, IPipe)
+ public
+ FOwner : Boolean;
+
+ // Constructs a new pipe object.
+ constructor Create(); overload;
+ // Anonymous pipe constructor
+ constructor Create( const aPipeRead, aPipeWrite : THandle; aOwnsHandles : Boolean); overload;
+
+ // ITransport
+ function GetIsOpen: Boolean; override;
+ procedure Open; override;
+ procedure Close; override;
+ end;
+
+
+ IPipeServer = interface( IServerTransport)
+ ['{7AEE6793-47B9-4E49-981A-C39E9108E9AD}']
+ // Server side anonymous pipe ends
+ function Handle : THandle;
+ function WriteHandle : THandle;
+ // Client side anonymous pipe ends
+ function ClientAnonRead : THandle;
+ function ClientAnonWrite : THandle;
+ end;
+
+
+ TServerPipeImpl = class( TServerTransportImpl, IPipeServer)
+ private
+ FPipeName : string;
+ FMaxConns : DWORD;
+ FBufSize : DWORD;
+ FAnonymous : Boolean;
+
+ FHandle,
+ FWriteHandle : THandle;
+
+ //Client side anonymous pipe handles
+ FClientAnonRead,
+ FClientAnonWrite : THandle;
+
+ protected
+ function AcceptImpl: ITransport; override;
+
+ function CreateNamedPipe : Boolean;
+ function CreateAnonPipe : Boolean;
+
+ // IPipeServer
+ function Handle : THandle;
+ function WriteHandle : THandle;
+ function ClientAnonRead : THandle;
+ function ClientAnonWrite : THandle;
+
+ public
+ // Constructors
+ constructor Create(); overload;
+ // Named Pipe
+ constructor Create( aPipename : string); overload;
+ constructor Create( aPipename : string; aBufsize : Cardinal); overload;
+ constructor Create( aPipename : string; aBufsize, aMaxConns : Cardinal); overload;
+ // Anonymous pipe
+ constructor Create( aBufsize : Cardinal); overload;
+
+ procedure Listen; override;
+ procedure Close; override;
+ end;
+
+
+const
+ TPIPE_SERVER_MAX_CONNS_DEFAULT = 10;
+
+
+implementation
+
+
+{ TPipeStreamImpl }
+
+
+constructor TPipeStreamImpl.Create( const aPipeHandle : THandle; aOwnsHandle : Boolean);
+begin
+ FPipe := aPipeHandle;
+ FOwner := aOwnsHandle;
+ FPipeName := '';
+ FTimeout := DEFAULT_THRIFT_PIPE_TIMEOUT;
+ FShareMode := 0;
+ FSecurityAttribs := nil;
+end;
+
+
+constructor TPipeStreamImpl.Create( const aPipeName : string; const aShareMode: DWORD;
+ const aSecurityAttributes: PSecurityAttributes;
+ const aTimeOut : DWORD);
+begin
+ FPipe := INVALID_HANDLE_VALUE;
+ FOwner := TRUE;
+ FPipeName := aPipeName;
+ FTimeout := aTimeOut;
+ FShareMode := aShareMode;
+ FSecurityAttribs := aSecurityAttributes;
+
+ if Copy(FPipeName,1,2) <> '\\'
+ then FPipeName := '\\.\pipe\' + FPipeName; // assume localhost
+end;
+
+
+destructor TPipeStreamImpl.Destroy;
+begin
+ try
+ Close;
+ finally
+ inherited Destroy;
+ end;
+end;
+
+
+procedure TPipeStreamImpl.Close;
+begin
+ if IsOpen then try
+ if FOwner
+ then CloseHandle( FPipe);
+ finally
+ FPipe := INVALID_HANDLE_VALUE;
+ end;
+end;
+
+
+procedure TPipeStreamImpl.Flush;
+begin
+ // nothing to do
+end;
+
+
+function TPipeStreamImpl.IsOpen: Boolean;
+begin
+ result := (FPipe <> INVALID_HANDLE_VALUE);
+end;
+
+
+procedure TPipeStreamImpl.Open;
+var retries : Integer;
+ hPipe : THandle;
+ dwMode : DWORD;
+const INTERVAL = 500; // ms
+begin
+ if IsOpen then Exit;
+
+ // open that thingy
+ retries := Max( 1, Round( 1.0 * FTimeout / INTERVAL));
+ hPipe := INVALID_HANDLE_VALUE;
+ while TRUE do begin
+ hPipe := CreateFile( PChar( FPipeName),
+ GENERIC_READ or GENERIC_WRITE,
+ FShareMode, // sharing
+ FSecurityAttribs, // security attributes
+ OPEN_EXISTING, // opens existing pipe
+ 0, // default attributes
+ 0); // no template file
+
+ if hPipe <> INVALID_HANDLE_VALUE
+ then Break;
+
+ Dec( retries);
+ if (retries > 0) or (FTimeout = INFINITE)
+ then Sleep( INTERVAL)
+ else raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Unable to open pipe');
+ end;
+
+ // pipe connected; change to message-read mode.
+ dwMode := PIPE_READMODE_MESSAGE;
+ if not SetNamedPipeHandleState( hPipe, dwMode, nil, nil) then begin
+ Close;
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'SetNamedPipeHandleState failed');
+ end;
+
+ // everything fine
+ FPipe := hPipe;
+end;
+
+
+procedure TPipeStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
+var cbWritten : DWORD;
+begin
+ if not IsOpen
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Called write on non-open pipe');
+
+ if not WriteFile( FPipe, buffer[offset], count, cbWritten, nil)
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Write to pipe failed');
+end;
+
+
+function TPipeStreamImpl.Read( var buffer: TBytes; offset, count: Integer): Integer;
+var cbRead : DWORD;
+ bytes, retries : LongInt;
+ bOk : Boolean;
+const INTERVAL = 10; // ms
+begin
+ if not IsOpen
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Called read on non-open pipe');
+
+ // MSDN: Handle can be a handle to a named pipe instance,
+ // or it can be a handle to the read end of an anonymous pipe,
+ // The handle must have GENERIC_READ access to the pipe.
+ if FTimeOut <> INFINITE then begin
+ retries := Max( 1, Round( 1.0 * FTimeOut / INTERVAL));
+ while TRUE do begin
+ if IsOpen
+ and PeekNamedPipe( FPipe, nil, 0, nil, @bytes, nil)
+ and (bytes > 0)
+ then Break; // there are data
+
+ Dec( retries);
+ if retries > 0
+ then Sleep( INTERVAL)
+ else raise TTransportException.Create( TTransportException.TExceptionType.TimedOut,
+ 'Pipe read timed out');
+ end;
+ end;
+
+ // read the data (or block INFINITE-ly)
+ bOk := ReadFile( FPipe, buffer[offset], count, cbRead, nil);
+ if (not bOk) and (GetLastError() <> ERROR_MORE_DATA)
+ then result := 0 // No more data, possibly because client disconnected.
+ else result := cbRead;
+end;
+
+
+function TPipeStreamImpl.ToArray: TBytes;
+var bytes : LongInt;
+begin
+ SetLength( result, 0);
+ bytes := 0;
+
+ if IsOpen
+ and PeekNamedPipe( FPipe, nil, 0, nil, @bytes, nil)
+ and (bytes > 0)
+ then begin
+ SetLength( result, bytes);
+ Read( result, 0, bytes);
+ end;
+end;
+
+
+{ TNamedPipeImpl }
+
+
+constructor TNamedPipeImpl.Create();
+// Constructs a new pipe object / provides defaults
+begin
+ inherited Create( nil, nil);
+ FOwner := FALSE;
+end;
+
+
+constructor TNamedPipeImpl.Create( const aPipeName : string; const aShareMode: DWORD;
+ const aSecurityAttributes: PSecurityAttributes;
+ const aTimeOut : DWORD);
+// Named pipe constructor
+begin
+ Create();
+ FInputStream := TPipeStreamImpl.Create( aPipeName, aShareMode, aSecurityAttributes, aTimeOut);
+ FOutputStream := FInputStream; // true for named pipes
+ FOwner := TRUE;
+end;
+
+
+constructor TNamedPipeImpl.Create( aPipe : THandle; aOwnsHandle : Boolean);
+// Named pipe constructor
+begin
+ Create();
+ FInputStream := TPipeStreamImpl.Create( aPipe, aOwnsHandle);
+ FOutputStream := FInputStream; // true for named pipes
+ FOwner := aOwnsHandle;
+end;
+
+
+function TNamedPipeImpl.GetIsOpen: Boolean;
+begin
+ result := (FInputStream <> nil);
+end;
+
+
+procedure TNamedPipeImpl.Open;
+begin
+ if FOwner then begin
+ FInputStream.Open;
+ if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
+ then FOutputStream.Open;
+ end;
+end;
+
+
+procedure TNamedPipeImpl.Close;
+begin
+ if FOwner then begin
+ FInputStream.Close;
+ if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
+ then FOutputStream.Close;
+ end;
+end;
+
+
+{ TAnonymousPipeImpl }
+
+
+constructor TAnonymousPipeImpl.Create();
+// Constructs a new pipe object / provides defaults
+begin
+ inherited Create( nil, nil);
+ FOwner := FALSE;
+end;
+
+
+constructor TAnonymousPipeImpl.Create( const aPipeRead, aPipeWrite : THandle; aOwnsHandles : Boolean);
+// Anonymous pipe constructor
+begin
+ Create();
+ FInputStream := TPipeStreamImpl.Create( aPipeRead, aOwnsHandles);
+ FOutputStream := TPipeStreamImpl.Create( aPipeWrite, aOwnsHandles);
+ FOwner := aOwnsHandles;
+end;
+
+
+function TAnonymousPipeImpl.GetIsOpen: Boolean;
+begin
+ result := (FInputStream <> nil) or (FOutputStream <> nil);
+end;
+
+
+procedure TAnonymousPipeImpl.Open;
+begin
+ if FOwner then begin
+ FInputStream.Open;
+ if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
+ then FOutputStream.Open;
+ end;
+end;
+
+
+procedure TAnonymousPipeImpl.Close;
+begin
+ if FOwner then begin
+ FInputStream.Close;
+ if (FOutputStream <> nil) and (FOutputStream <> FInputStream)
+ then FOutputStream.Close;
+ end;
+end;
+
+
+{ TServerPipeImpl }
+
+
+constructor TServerPipeImpl.Create( aPipename : string; aBufsize, aMaxConns : Cardinal);
+// Named Pipe CTOR
+begin
+ inherited Create;
+ FPipeName := aPipename;
+ FBufsize := aBufSize;
+ FMaxConns := Max( 1, Min( 255, aMaxConns)); // restrict to 1-255 connections
+ FAnonymous := FALSE;
+ FHandle := INVALID_HANDLE_VALUE;
+ FWriteHandle := INVALID_HANDLE_VALUE;
+ FClientAnonRead := INVALID_HANDLE_VALUE;
+ FClientAnonWrite := INVALID_HANDLE_VALUE;
+
+ if Copy(FPipeName,1,2) <> '\\'
+ then FPipeName := '\\.\pipe\' + FPipeName; // assume localhost
+end;
+
+
+constructor TServerPipeImpl.Create( aPipename : string; aBufsize : Cardinal);
+// Named Pipe CTOR
+begin
+ Create( aPipename, aBufSize, TPIPE_SERVER_MAX_CONNS_DEFAULT);
+end;
+
+
+constructor TServerPipeImpl.Create( aPipename : string);
+// Named Pipe CTOR
+begin
+ Create( aPipename, 1024, TPIPE_SERVER_MAX_CONNS_DEFAULT);
+end;
+
+
+constructor TServerPipeImpl.Create( aBufsize : Cardinal);
+// Anonymous pipe CTOR
+begin
+ inherited Create;
+ FPipeName := '';
+ FBufsize := aBufSize;
+ FMaxConns := 1;
+ FAnonymous := TRUE;
+ FHandle := INVALID_HANDLE_VALUE;
+ FWriteHandle := INVALID_HANDLE_VALUE;
+ FClientAnonRead := INVALID_HANDLE_VALUE;
+ FClientAnonWrite := INVALID_HANDLE_VALUE;
+
+ // The anonymous pipe needs to be created first so that the server can
+ // pass the handles on to the client before the serve (acceptImpl)
+ // blocking call.
+ if not CreateAnonPipe
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ ClassName+'.Create() failed');
+end;
+
+
+constructor TServerPipeImpl.Create();
+// Anonymous pipe CTOR
+begin
+ Create( 1024);
+end;
+
+
+function TServerPipeImpl.AcceptImpl: ITransport;
+var buf : Byte;
+ br : DWORD;
+ connectRet : Boolean;
+begin
+ if FAnonymous then begin //Anonymous Pipe
+
+ // This 0-byte read serves merely as a blocking call.
+ if not ReadFile( FHandle, buf, 0, br, nil)
+ and (GetLastError() <> ERROR_MORE_DATA)
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'TPipeServer unable to initiate pipe communication');
+ result := TAnonymousPipeImpl.Create( FHandle, FWriteHandle, FALSE);
+
+ end
+ else begin //Named Pipe
+
+ while TRUE do begin
+ if not CreateNamedPipe()
+ then raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'TPipeServer CreateNamedPipe failed');
+
+ // Wait for the client to connect; if it succeeds, the
+ // function returns a nonzero value. If the function returns
+ // zero, GetLastError should return ERROR_PIPE_CONNECTED.
+ if ConnectNamedPipe( FHandle,nil)
+ then connectRet := TRUE
+ else connectRet := (GetLastError() = ERROR_PIPE_CONNECTED);
+
+ if connectRet
+ then Break;
+
+ Close;
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'TPipeServer: client connection failed');
+ end;
+
+ result := TNamedPipeImpl.Create( FHandle, TRUE);
+ end;
+end;
+
+
+procedure TServerPipeImpl.Listen;
+begin
+ // not much to do here
+end;
+
+
+procedure TServerPipeImpl.Close;
+begin
+ if not FAnonymous then begin
+
+ if FHandle <> INVALID_HANDLE_VALUE then begin
+ DisconnectNamedPipe( FHandle);
+ CloseHandle( FHandle);
+ FHandle := INVALID_HANDLE_VALUE;
+ end;
+
+ end
+ else begin
+
+ if FHandle <> INVALID_HANDLE_VALUE then begin
+ CloseHandle( FHandle);
+ FHandle := INVALID_HANDLE_VALUE;
+ end;
+ if FWriteHandle <> INVALID_HANDLE_VALUE then begin
+ CloseHandle( FWriteHandle);
+ FWriteHandle := INVALID_HANDLE_VALUE;
+ end;
+ if FClientAnonRead <> INVALID_HANDLE_VALUE then begin
+ CloseHandle( FClientAnonRead);
+ FClientAnonRead := INVALID_HANDLE_VALUE;
+ end;
+ if FClientAnonWrite <> INVALID_HANDLE_VALUE then begin
+ CloseHandle( FClientAnonWrite);
+ FClientAnonWrite := INVALID_HANDLE_VALUE;
+ end;
+ end;
+end;
+
+
+function TServerPipeImpl.Handle : THandle;
+begin
+ result := FHandle;
+end;
+
+
+function TServerPipeImpl.WriteHandle : THandle;
+begin
+ result := FWriteHandle;
+end;
+
+
+function TServerPipeImpl.ClientAnonRead : THandle;
+begin
+ result := FClientAnonRead;
+end;
+
+
+function TServerPipeImpl.ClientAnonWrite : THandle;
+begin
+ result := FClientAnonWrite;
+end;
+
+
+function TServerPipeImpl.CreateNamedPipe : Boolean;
+var SIDAuthWorld : SID_IDENTIFIER_AUTHORITY ;
+ everyone_sid : PSID;
+ ea : EXPLICIT_ACCESS;
+ acl : PACL;
+ sd : PSECURITY_DESCRIPTOR;
+ sa : SECURITY_ATTRIBUTES;
+ hPipe : THandle;
+const
+ SECURITY_WORLD_SID_AUTHORITY : TSIDIdentifierAuthority = (Value : (0,0,0,0,0,1));
+ SECURITY_WORLD_RID = $00000000;
+begin
+ // Windows - set security to allow non-elevated apps
+ // to access pipes created by elevated apps.
+ SIDAuthWorld := SECURITY_WORLD_SID_AUTHORITY;
+ everyone_sid := nil;
+ AllocateAndInitializeSid( SIDAuthWorld, 1, SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, everyone_sid);
+
+ ZeroMemory( @ea, SizeOf(ea));
+ ea.grfAccessPermissions := SPECIFIC_RIGHTS_ALL or STANDARD_RIGHTS_ALL;
+ ea.grfAccessMode := SET_ACCESS;
+ ea.grfInheritance := NO_INHERITANCE;
+ ea.Trustee.TrusteeForm := TRUSTEE_IS_SID;
+ ea.Trustee.TrusteeType := TRUSTEE_IS_WELL_KNOWN_GROUP;
+ ea.Trustee.ptstrName := PChar(everyone_sid);
+
+ acl := nil;
+ SetEntriesInAcl( 1, @ea, nil, acl);
+
+ sd := PSECURITY_DESCRIPTOR( LocalAlloc( LPTR,SECURITY_DESCRIPTOR_MIN_LENGTH));
+ Win32Check( InitializeSecurityDescriptor( sd, SECURITY_DESCRIPTOR_REVISION));
+ Win32Check( SetSecurityDescriptorDacl( sd, TRUE, acl, FALSE));
+
+ sa.nLength := SizeOf(sa);
+ sa.lpSecurityDescriptor := sd;
+ sa.bInheritHandle := FALSE;
+
+ // Create an instance of the named pipe
+ hPipe := Windows.CreateNamedPipe( PChar( FPipeName), // pipe name
+ PIPE_ACCESS_DUPLEX, // read/write access
+ PIPE_TYPE_MESSAGE or // message type pipe
+ PIPE_READMODE_MESSAGE, // message-read mode
+ FMaxConns, // max. instances
+ FBufSize, // output buffer size
+ FBufSize, // input buffer size
+ 0, // client time-out
+ @sa); // default security attribute
+
+ if( hPipe = INVALID_HANDLE_VALUE) then begin
+ FHandle := INVALID_HANDLE_VALUE;
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'CreateNamedPipe() failed ' + IntToStr(GetLastError));
+ end;
+
+ FHandle := hPipe;
+ result := TRUE;
+end;
+
+
+function TServerPipeImpl.CreateAnonPipe : Boolean;
+var sd : PSECURITY_DESCRIPTOR;
+ sa : SECURITY_ATTRIBUTES; //TSecurityAttributes;
+ hCAR, hPipeW, hCAW, hPipe : THandle;
+begin
+ result := FALSE;
+
+ sd := PSECURITY_DESCRIPTOR( LocalAlloc( LPTR,SECURITY_DESCRIPTOR_MIN_LENGTH));
+ Win32Check( InitializeSecurityDescriptor( sd, SECURITY_DESCRIPTOR_REVISION));
+ Win32Check( SetSecurityDescriptorDacl( sd, TRUE, nil, FALSE));
+
+ sa.nLength := sizeof( sa);
+ sa.lpSecurityDescriptor := sd;
+ sa.bInheritHandle := TRUE; //allow passing handle to child
+
+ if not CreatePipe( hCAR, hPipeW, @sa, FBufSize) then begin //create stdin pipe
+ Console.WriteLine( 'TPipeServer CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
+ Exit;
+ end;
+
+ if not CreatePipe( hPipe, hCAW, @sa, FBufSize) then begin //create stdout pipe
+ Console.WriteLine( 'TPipeServer CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
+ CloseHandle( hCAR);
+ CloseHandle( hPipeW);
+ Exit;
+ end;
+
+ FClientAnonRead := hCAR;
+ FClientAnonWrite := hCAW;
+ FHandle := hPipe;
+ FWriteHandle := hPipeW;
+
+ result := TRUE;
+end;
+
+
+
+end.
+
+
+
diff --git a/lib/delphi/src/Thrift.Transport.pas b/lib/delphi/src/Thrift.Transport.pas
index 8464e35..0664772 100644
--- a/lib/delphi/src/Thrift.Transport.pas
+++ b/lib/delphi/src/Thrift.Transport.pas
@@ -53,7 +53,7 @@
protected
function GetIsOpen: Boolean; virtual; abstract;
property IsOpen: Boolean read GetIsOpen;
- function Peek: Boolean;
+ function Peek: Boolean; virtual;
procedure Open(); virtual; abstract;
procedure Close(); virtual; abstract;
function Read(var buf: TBytes; off: Integer; len: Integer): Integer; virtual; abstract;
diff --git a/lib/delphi/test/TestClient.pas b/lib/delphi/test/TestClient.pas
index 90b92a2..d3a4895 100644
--- a/lib/delphi/test/TestClient.pas
+++ b/lib/delphi/test/TestClient.pas
@@ -1,1024 +1,1065 @@
-(*
- * 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 TestClient;
-
-interface
-
-uses
- Windows, SysUtils, Classes,
- DateUtils,
- Generics.Collections,
- TestConstants,
- Thrift,
- Thrift.Protocol.JSON,
- Thrift.Protocol,
- Thrift.Transport,
- Thrift.Stream,
- Thrift.Test,
- Thrift.Collections,
- Thrift.Console;
-
-type
- TThreadConsole = class
- private
- FThread : TThread;
- public
- procedure Write( const S : string);
- procedure WriteLine( const S : string);
- constructor Create( AThread: TThread);
- end;
-
- TClientThread = class( TThread )
- private
- FTransport : ITransport;
- FProtocol : IProtocol;
- FNumIteration : Integer;
- FConsole : TThreadConsole;
-
- // test reporting, will be refactored out into separate class later
- FTestGroup : string;
- FSuccesses : Integer;
- FErrors : TStringList;
- procedure StartTestGroup( const aGroup : string);
- procedure Expect( aTestResult : Boolean; const aTestInfo : string);
- procedure ReportResults;
-
- procedure ClientTest;
- procedure JSONProtocolReadWriteTest;
- protected
- procedure Execute; override;
- public
- constructor Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
- destructor Destroy; override;
- end;
-
- TTestClient = class
- private
- class var
- FNumIteration : Integer;
- FNumThread : Integer;
- public
- class procedure Execute( const args: array of string);
- end;
-
-implementation
-
-function BoolToString( b : Boolean) : string;
-// overrides global BoolToString()
-begin
- if b
- then result := 'true'
- else result := 'false';
-end;
-
-// not available in all versions, so make sure we have this one imported
-function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent';
-
-{ TTestClient }
-
-class procedure TTestClient.Execute(const args: array of string);
-var
- i : Integer;
- host : string;
- port : Integer;
- url : string;
- bBuffered : Boolean;
- bFramed : Boolean;
- s : string;
- n : Integer;
- threads : array of TThread;
- dtStart : TDateTime;
- test : Integer;
- thread : TThread;
- trans : ITransport;
- prot : IProtocol;
- streamtrans : IStreamTransport;
- http : IHTTPClient;
- protType, p : TKnownProtocol;
-begin
- bBuffered := False;;
- bFramed := False;
- protType := prot_Binary;
- try
- host := 'localhost';
- port := 9090;
- url := '';
- 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('Using buffered transport');
- end else
- if (args[i] = '-f' ) or ( args[i] = '-framed') then
- begin
- bFramed := True;
- Console.WriteLine('Using framed transport');
- 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;
- end;
- except
- on E: Exception do
- begin
- Console.WriteLine( E.Message );
- end;
- end;
-
- SetLength( threads, FNumThread);
- dtStart := Now;
-
- for test := 0 to FNumThread - 1 do
- begin
- if url = '' then
- begin
- streamtrans := TSocketImpl.Create( host, port );
- trans := streamtrans;
- if bBuffered then
- begin
- trans := TBufferedTransportImpl.Create( streamtrans );
- end;
-
- if bFramed then
- begin
- trans := TFramedTransportImpl.Create( trans );
- end;
- end else
- begin
- http := THTTPClientImpl.Create( url );
- trans := http;
- end;
-
- // create protocol instance, default to BinaryProtocol
- case protType of
- prot_Binary: prot := TBinaryProtocolImpl.Create( trans);
- prot_JSON : prot := TJSONProtocolImpl.Create( trans);
- else
- ASSERT( FALSE); // unhandled case!
- prot := TBinaryProtocolImpl.Create( trans); // use default
- end;
-
- thread := TClientThread.Create( trans, prot, FNumIteration);
- threads[test] := thread;
-{$WARN SYMBOL_DEPRECATED OFF}
- thread.Resume;
-{$WARN SYMBOL_DEPRECATED ON}
- end;
-
- for test := 0 to FNumThread - 1 do
- begin
- threads[test].WaitFor;
- end;
-
- for test := 0 to FNumThread - 1 do
- begin
- threads[test].Free;
- end;
-
- Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));
-
- except
- on E: Exception do
- begin
- Console.WriteLine( E.Message + ' ST: ' + E.StackTrace );
- end;
- end;
-
- Console.WriteLine('');
- Console.WriteLine('done!');
-end;
-
-{ TClientThread }
-
-procedure TClientThread.ClientTest;
-var
- client : TThriftTest.Iface;
- s : string;
- i8 : ShortInt;
- i32 : Integer;
- i64 : Int64;
- dub : Double;
- o : IXtruct;
- o2 : IXtruct2;
- i : IXtruct;
- i2 : IXtruct2;
- mapout : IThriftDictionary<Integer,Integer>;
- mapin : IThriftDictionary<Integer,Integer>;
- strmapout : IThriftDictionary<string,string>;
- strmapin : IThriftDictionary<string,string>;
- j : Integer;
- first : Boolean;
- key : Integer;
- strkey : string;
- listout : IThriftList<Integer>;
- listin : IThriftList<Integer>;
- setout : IHashSet<Integer>;
- setin : IHashSet<Integer>;
- ret : TNumberz;
- uid : Int64;
- mm : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
- pos : IThriftDictionary<Integer, Integer>;
- neg : IThriftDictionary<Integer, Integer>;
- m2 : IThriftDictionary<Integer, Integer>;
- k2 : Integer;
- insane : IInsanity;
- truck : IXtruct;
- whoa : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
- key64 : Int64;
- val : IThriftDictionary<TNumberz, IInsanity>;
- k2_2 : TNumberz;
- k3 : TNumberz;
- v2 : IInsanity;
- userMap : IThriftDictionary<TNumberz, Int64>;
- xtructs : IThriftList<IXtruct>;
- x : IXtruct;
- arg0 : ShortInt;
- arg1 : Integer;
- arg2 : Int64;
- arg3 : IThriftDictionary<SmallInt, string>;
- arg4 : TNumberz;
- arg5 : Int64;
- StartTick : Cardinal;
- k : Integer;
- proc : TThreadProcedure;
- hello, goodbye : IXtruct;
- crazy : IInsanity;
- looney : IInsanity;
- first_map : IThriftDictionary<TNumberz, IInsanity>;
- second_map : IThriftDictionary<TNumberz, IInsanity>;
-
-begin
- client := TThriftTest.TClient.Create( FProtocol);
- FTransport.Open;
-
- // in-depth exception test
- // (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');
- // case 1: exception type declared in IDL at the function call
- try
- client.testException('Xception');
- Expect( FALSE, 'testException(''Xception''): must trow an exception');
- except
- on e:TXception do begin
- Expect( e.ErrorCode = 1001, 'error code');
- Expect( e.Message_ = 'Xception', 'error message');
- Console.WriteLine( ' = ' + IntToStr(e.ErrorCode) + ', ' + e.Message_ );
- end;
- on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
- on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
- end;
-
- // case 2: exception type NOT declared in IDL at the function call
- // this will close the connection
- try
- client.testException('TException');
- Expect( FALSE, 'testException(''TException''): must trow an exception');
- except
- on e:TTransportException do begin
- Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
- if FTransport.IsOpen then FTransport.Close;
- FTransport.Open; // re-open connection, server has already closed
- end;
- on e:TException do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
- on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
- end;
-
- // case 3: no exception
- try
- client.testException('something');
- Expect( TRUE, 'testException(''something''): must not trow an exception');
- except
- on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
- on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
- end;
-
-
- // simple things
- StartTestGroup( 'simple Thrift calls');
- client.testVoid();
- Expect( TRUE, 'testVoid()'); // success := no exception
-
- s := client.testString('Test');
- Expect( s = 'Test', 'testString(''Test'') = "'+s+'"');
-
- i8 := client.testByte(1);
- Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));
-
- i32 := client.testI32(-1);
- Expect( i32 = -1, 'testI32(-1) = ' + IntToStr(i32));
-
- Console.WriteLine('testI64(-34359738368)');
- i64 := client.testI64(-34359738368);
- Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64));
-
- Console.WriteLine('testDouble(5.325098235)');
- dub := client.testDouble(5.325098235);
- Expect( abs(dub-5.325098235) < 1e-14, 'testDouble(5.325098235) = ' + FloatToStr( dub));
-
- // structs
- StartTestGroup( 'testStruct');
- Console.WriteLine('testStruct({''Zero'', 1, -3, -5})');
- o := TXtructImpl.Create;
- o.String_thing := 'Zero';
- o.Byte_thing := 1;
- o.I32_thing := -3;
- o.I64_thing := -5;
- i := client.testStruct(o);
- Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
- Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
- Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
- Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
- Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
- Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
- Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
- Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
-
- // nested structs
- StartTestGroup( 'testNest');
- Console.WriteLine('testNest({1, {''Zero'', 1, -3, -5}, 5})');
- o2 := TXtruct2Impl.Create;
- o2.Byte_thing := 1;
- o2.Struct_thing := o;
- o2.I32_thing := 5;
- i2 := client.testNest(o2);
- i := i2.Struct_thing;
- Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
- Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
- Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
- Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
- Expect( i2.Byte_thing = 1, 'i2.Byte_thing = '+IntToStr(i2.Byte_thing));
- Expect( i2.I32_thing = 5, 'i2.I32_thing = '+IntToStr(i2.I32_thing));
- Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
- Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
- Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
- Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
- Expect( i2.__isset_Byte_thing, 'i2.__isset_Byte_thing');
- Expect( i2.__isset_I32_thing, 'i2.__isset_I32_thing');
-
- // 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');
- mapout := TThriftDictionaryImpl<Integer,Integer>.Create;
- for j := 0 to 4 do
- begin
- mapout.AddOrSetValue( j, j - 10);
- end;
- Console.Write('testMap({');
- first := True;
- for key in mapout.Keys do
- begin
- if first
- then first := False
- else Console.Write( ', ' );
- Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key]));
- end;
- Console.WriteLine('})');
-
- mapin := client.testMap( mapout );
- Expect( mapin.Count = mapout.Count, 'testMap: mapin.Count = mapout.Count');
- for j := 0 to 4 do
- begin
- Expect( mapout.ContainsKey(j), 'testMap: mapout.ContainsKey('+IntToStr(j)+') = '+BoolToString(mapout.ContainsKey(j)));
- end;
- for key in mapin.Keys do
- begin
- Expect( mapin[key] = mapout[key], 'testMap: '+IntToStr(key) + ' => ' + IntToStr( mapin[key]));
- Expect( mapin[key] = key - 10, 'testMap: mapin['+IntToStr(key)+'] = '+IntToStr( mapin[key]));
- end;
-
-
- // 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');
- strmapout := TThriftDictionaryImpl<string,string>.Create;
- for j := 0 to 4 do
- begin
- strmapout.AddOrSetValue( IntToStr(j), IntToStr(j - 10));
- end;
- Console.Write('testStringMap({');
- first := True;
- for strkey in strmapout.Keys do
- begin
- if first
- then first := False
- else Console.Write( ', ' );
- Console.Write( strkey + ' => ' + strmapout[strkey]);
- end;
- Console.WriteLine('})');
-
- strmapin := client.testStringMap( strmapout );
- Expect( strmapin.Count = strmapout.Count, 'testStringMap: strmapin.Count = strmapout.Count');
- for j := 0 to 4 do
- begin
- Expect( strmapout.ContainsKey(IntToStr(j)),
- 'testStringMap: strmapout.ContainsKey('+IntToStr(j)+') = '
- + BoolToString(strmapout.ContainsKey(IntToStr(j))));
- end;
- for strkey in strmapin.Keys do
- begin
- Expect( strmapin[strkey] = strmapout[strkey], 'testStringMap: '+strkey + ' => ' + strmapin[strkey]);
- Expect( strmapin[strkey] = IntToStr( StrToInt(strkey) - 10), 'testStringMap: strmapin['+strkey+'] = '+strmapin[strkey]);
- end;
-
-
- // 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');
- setout := THashSetImpl<Integer>.Create;
- for j := -2 to 2 do
- begin
- setout.Add( j );
- end;
- Console.Write('testSet({');
- first := True;
- for j in setout do
- begin
- if first
- then first := False
- else Console.Write(', ');
- Console.Write(IntToStr( j));
- end;
- Console.WriteLine('})');
-
- setin := client.testSet(setout);
- Expect( setin.Count = setout.Count, 'testSet: setin.Count = setout.Count');
- Expect( setin.Count = 5, 'testSet: setin.Count = '+IntToStr(setin.Count));
- for j := -2 to 2 do // unordered, we can't rely on the order => test for known elements only
- begin
- Expect( setin.Contains(j), 'testSet: setin.Contains('+IntToStr(j)+') => '+BoolToString(setin.Contains(j)));
- end;
-
- // list<type>: An ordered list of elements.
- // Translates to an STL vector, Java ArrayList, native arrays in scripting languages, etc.
- StartTestGroup( 'testList');
- listout := TThriftListImpl<Integer>.Create;
- listout.Add( +1);
- listout.Add( -2);
- listout.Add( +3);
- listout.Add( -4);
- listout.Add( 0);
- Console.Write('testList({');
- first := True;
- for j in listout do
- begin
- if first
- then first := False
- else Console.Write(', ');
- Console.Write(IntToStr( j));
- end;
- Console.WriteLine('})');
-
- listin := client.testList(listout);
- Expect( listin.Count = listout.Count, 'testList: listin.Count = listout.Count');
- Expect( listin.Count = 5, 'testList: listin.Count = '+IntToStr(listin.Count));
- Expect( listin[0] = +1, 'listin[0] = '+IntToStr( listin[0]));
- Expect( listin[1] = -2, 'listin[1] = '+IntToStr( listin[1]));
- Expect( listin[2] = +3, 'listin[2] = '+IntToStr( listin[2]));
- Expect( listin[3] = -4, 'listin[3] = '+IntToStr( listin[3]));
- Expect( listin[4] = 0, 'listin[4] = '+IntToStr( listin[4]));
-
- // enums
- ret := client.testEnum(TNumberz.ONE);
- Expect( ret = TNumberz.ONE, 'testEnum(ONE) = '+IntToStr(Ord(ret)));
-
- ret := client.testEnum(TNumberz.TWO);
- Expect( ret = TNumberz.TWO, 'testEnum(TWO) = '+IntToStr(Ord(ret)));
-
- ret := client.testEnum(TNumberz.THREE);
- Expect( ret = TNumberz.THREE, 'testEnum(THREE) = '+IntToStr(Ord(ret)));
-
- ret := client.testEnum(TNumberz.FIVE);
- Expect( ret = TNumberz.FIVE, 'testEnum(FIVE) = '+IntToStr(Ord(ret)));
-
- ret := client.testEnum(TNumberz.EIGHT);
- Expect( ret = TNumberz.EIGHT, 'testEnum(EIGHT) = '+IntToStr(Ord(ret)));
-
-
- // typedef
- uid := client.testTypedef(309858235082523);
- Expect( uid = 309858235082523, 'testTypedef(309858235082523) = '+IntToStr(uid));
-
-
- // maps of maps
- StartTestGroup( 'testMapMap(1)');
- mm := client.testMapMap(1);
- Console.Write(' = {');
- for key in mm.Keys do
- begin
- Console.Write( IntToStr( key) + ' => {');
- m2 := mm[key];
- for k2 in m2.Keys do
- begin
- Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', ');
- end;
- Console.Write('}, ');
- end;
- Console.WriteLine('}');
-
- // verify result data
- Expect( mm.Count = 2, 'mm.Count = '+IntToStr(mm.Count));
- pos := mm[4];
- neg := mm[-4];
- for j := 1 to 4 do
- begin
- Expect( pos[j] = j, 'pos[j] = '+IntToStr(pos[j]));
- Expect( neg[-j] = -j, 'neg[-j] = '+IntToStr(neg[-j]));
- end;
-
-
-
- // insanity
- StartTestGroup( 'testInsanity');
- insane := TInsanityImpl.Create;
- insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
- insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);
- truck := TXtructImpl.Create;
- truck.String_thing := 'Truck';
- truck.Byte_thing := 8;
- truck.I32_thing := 8;
- truck.I64_thing := 8;
- insane.Xtructs := TThriftListImpl<IXtruct>.Create;
- insane.Xtructs.Add( truck );
- whoa := client.testInsanity( insane );
- Console.Write(' = {');
- for key64 in whoa.Keys do
- begin
- val := whoa[key64];
- Console.Write( IntToStr( key64) + ' => {');
- for k2_2 in val.Keys do
- begin
- v2 := val[k2_2];
- Console.Write( IntToStr( Integer( k2_2)) + ' => {');
- userMap := v2.UserMap;
- Console.Write('{');
- if userMap <> nil then
- begin
- for k3 in userMap.Keys do
- begin
- Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', ');
- end;
- end else
- begin
- Console.Write('null');
- end;
- Console.Write('}, ');
- xtructs := v2.Xtructs;
- Console.Write('{');
-
- if xtructs <> nil then
- begin
- for x in xtructs do
- begin
- Console.Write('{"' + x.String_thing + '", ' +
- IntToStr( x.Byte_thing) + ', ' +
- IntToStr( x.I32_thing) + ', ' +
- IntToStr( x.I32_thing) + '}, ');
- end;
- end else
- begin
- Console.Write('null');
- end;
- Console.Write('}');
- Console.Write('}, ');
- end;
- Console.Write('}, ');
- end;
- Console.WriteLine('}');
-
- // verify result data
- Expect( whoa.Count = 2, 'whoa.Count = '+IntToStr(whoa.Count));
- //
- first_map := whoa[1];
- second_map := whoa[2];
- Expect( first_map.Count = 2, 'first_map.Count = '+IntToStr(first_map.Count));
- Expect( second_map.Count = 1, 'second_map.Count = '+IntToStr(second_map.Count));
- //
- looney := second_map[TNumberz.SIX];
- Expect( Assigned(looney), 'Assigned(looney) = '+BoolToString(Assigned(looney)));
- Expect( not looney.__isset_UserMap, 'looney.__isset_UserMap = '+BoolToString(looney.__isset_UserMap));
- Expect( not looney.__isset_Xtructs, 'looney.__isset_Xtructs = '+BoolToString(looney.__isset_Xtructs));
- //
- for ret in [TNumberz.TWO, TNumberz.THREE] do begin
- crazy := first_map[ret];
- Console.WriteLine('first_map['+intToStr(Ord(ret))+']');
-
- Expect( crazy.__isset_UserMap, 'crazy.__isset_UserMap = '+BoolToString(crazy.__isset_UserMap));
- Expect( crazy.__isset_Xtructs, 'crazy.__isset_Xtructs = '+BoolToString(crazy.__isset_Xtructs));
-
- Expect( crazy.UserMap.Count = 2, 'crazy.UserMap.Count = '+IntToStr(crazy.UserMap.Count));
- Expect( crazy.UserMap[TNumberz.FIVE] = 5, 'crazy.UserMap[TNumberz.FIVE] = '+IntToStr(crazy.UserMap[TNumberz.FIVE]));
- Expect( crazy.UserMap[TNumberz.EIGHT] = 8, 'crazy.UserMap[TNumberz.EIGHT] = '+IntToStr(crazy.UserMap[TNumberz.EIGHT]));
-
- Expect( crazy.Xtructs.Count = 2, 'crazy.Xtructs.Count = '+IntToStr(crazy.Xtructs.Count));
- goodbye := crazy.Xtructs[0]; // lists are ordered, so we are allowed to assume this order
- hello := crazy.Xtructs[1];
-
- Expect( goodbye.String_thing = 'Goodbye4', 'goodbye.String_thing = "'+goodbye.String_thing+'"');
- Expect( goodbye.Byte_thing = 4, 'goodbye.Byte_thing = '+IntToStr(goodbye.Byte_thing));
- Expect( goodbye.I32_thing = 4, 'goodbye.I32_thing = '+IntToStr(goodbye.I32_thing));
- Expect( goodbye.I64_thing = 4, 'goodbye.I64_thing = '+IntToStr(goodbye.I64_thing));
- Expect( goodbye.__isset_String_thing, 'goodbye.__isset_String_thing = '+BoolToString(goodbye.__isset_String_thing));
- Expect( goodbye.__isset_Byte_thing, 'goodbye.__isset_Byte_thing = '+BoolToString(goodbye.__isset_Byte_thing));
- Expect( goodbye.__isset_I32_thing, 'goodbye.__isset_I32_thing = '+BoolToString(goodbye.__isset_I32_thing));
- Expect( goodbye.__isset_I64_thing, 'goodbye.__isset_I64_thing = '+BoolToString(goodbye.__isset_I64_thing));
-
- Expect( hello.String_thing = 'Hello2', 'hello.String_thing = "'+hello.String_thing+'"');
- Expect( hello.Byte_thing = 2, 'hello.Byte_thing = '+IntToStr(hello.Byte_thing));
- Expect( hello.I32_thing = 2, 'hello.I32_thing = '+IntToStr(hello.I32_thing));
- Expect( hello.I64_thing = 2, 'hello.I64_thing = '+IntToStr(hello.I64_thing));
- Expect( hello.__isset_String_thing, 'hello.__isset_String_thing = '+BoolToString(hello.__isset_String_thing));
- Expect( hello.__isset_Byte_thing, 'hello.__isset_Byte_thing = '+BoolToString(hello.__isset_Byte_thing));
- Expect( hello.__isset_I32_thing, 'hello.__isset_I32_thing = '+BoolToString(hello.__isset_I32_thing));
- Expect( hello.__isset_I64_thing, 'hello.__isset_I64_thing = '+BoolToString(hello.__isset_I64_thing));
- end;
-
-
- // multi args
- StartTestGroup( 'testMulti');
- arg0 := 1;
- arg1 := 2;
- arg2 := High(Int64);
- arg3 := TThriftDictionaryImpl<SmallInt, string>.Create;
- arg3.AddOrSetValue( 1, 'one');
- arg4 := TNumberz.FIVE;
- arg5 := 5000000;
- Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' +
- IntToStr( arg1) + ',' + IntToStr( arg2) + ',' +
- arg3.ToString + ',' + IntToStr( Integer( arg4)) + ',' +
- IntToStr( arg5) + ')');
-
- i := client.testMulti( arg0, arg1, arg2, arg3, arg4, arg5);
- Expect( i.String_thing = 'Hello2', 'testMulti: i.String_thing = "'+i.String_thing+'"');
- Expect( i.Byte_thing = arg0, 'testMulti: i.Byte_thing = '+IntToStr(i.Byte_thing));
- Expect( i.I32_thing = arg1, 'testMulti: i.I32_thing = '+IntToStr(i.I32_thing));
- Expect( i.I64_thing = arg2, 'testMulti: i.I64_thing = '+IntToStr(i.I64_thing));
- Expect( i.__isset_String_thing, 'testMulti: i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
- Expect( i.__isset_Byte_thing, 'testMulti: i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
- Expect( i.__isset_I32_thing, 'testMulti: i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
- Expect( i.__isset_I64_thing, 'testMulti: i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
-
- // multi exception
- StartTestGroup( 'testMultiException(1)');
- 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+ '"');
- Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
- Expect( not i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
- Expect( not i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
- Expect( not i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
- except
- on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
- end;
-
- StartTestGroup( 'testMultiException(Xception)');
- try
- i := client.testMultiException( 'Xception', 'second test');
- Expect( FALSE, 'testMultiException(''Xception''): must trow an exception');
- except
- on x:TXception do begin
- Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
- Expect( x.__isset_Message_, 'x.__isset_Message_ = '+BoolToString(x.__isset_Message_));
- Expect( x.ErrorCode = 1001, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
- Expect( x.Message_ = 'This is an Xception', 'x.Message = "'+x.Message_+'"');
- end;
- on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
- end;
-
- StartTestGroup( 'testMultiException(Xception2)');
- try
- i := client.testMultiException( 'Xception2', 'third test');
- Expect( FALSE, 'testMultiException(''Xception2''): must trow an exception');
- except
- on x:TXception2 do begin
- Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
- Expect( x.__isset_Struct_thing, 'x.__isset_Struct_thing = '+BoolToString(x.__isset_Struct_thing));
- Expect( x.ErrorCode = 2002, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
- Expect( x.Struct_thing.String_thing = 'This is an Xception2', 'x.Struct_thing.String_thing = "'+x.Struct_thing.String_thing+'"');
- Expect( x.Struct_thing.__isset_String_thing, 'x.Struct_thing.__isset_String_thing = '+BoolToString(x.Struct_thing.__isset_String_thing));
- Expect( not x.Struct_thing.__isset_Byte_thing, 'x.Struct_thing.__isset_Byte_thing = '+BoolToString(x.Struct_thing.__isset_Byte_thing));
- Expect( not x.Struct_thing.__isset_I32_thing, 'x.Struct_thing.__isset_I32_thing = '+BoolToString(x.Struct_thing.__isset_I32_thing));
- Expect( not x.Struct_thing.__isset_I64_thing, 'x.Struct_thing.__isset_I64_thing = '+BoolToString(x.Struct_thing.__isset_I64_thing));
- end;
- on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
- end;
-
-
- // oneway functions
- StartTestGroup( 'Test Oneway(1)');
- client.testOneway(1);
- Expect( TRUE, 'Test Oneway(1)'); // success := no exception
-
- // call time
- StartTestGroup( 'Test Calltime()');
- StartTick := GetTIckCount;
- for k := 0 to 1000 - 1 do
- begin
- client.testVoid();
- end;
- Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' );
-
- // no more tests here
- StartTestGroup( '');
-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
-// Note that passing this test does not imply, that our JSON is really compatible to what
-// other clients or servers expect as the real JSON. This is beyond the scope of this test.
-var prot : IProtocol;
- stm : TStringStream;
- list : IList;
- binary, binRead : TBytes;
- i,iErr : Integer;
-const
- TEST_SHORT = ShortInt( $FE);
- TEST_SMALL = SmallInt( $FEDC);
- TEST_LONG = LongInt( $FEDCBA98);
- TEST_I64 = Int64( $FEDCBA9876543210);
- TEST_DOUBLE = -1.234e-56;
- DELTA_DOUBLE = TEST_DOUBLE * 1e-14;
- TEST_STRING = 'abc-'#$00E4#$00f6#$00fc; // german umlauts (en-us: "funny chars")
-begin
- stm := TStringStream.Create;
- try
- StartTestGroup( 'JsonProtocolTest'); // no more tests here
-
- // prepare binary data
- SetLength( binary, $100);
- for i := Low(binary) to High(binary) do binary[i] := i;
-
- // output setup
- prot := TJSONProtocolImpl.Create(
- TStreamTransportImpl.Create(
- nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));
-
- // write
- prot.WriteListBegin( TListImpl.Create( TType.String_, 9));
- prot.WriteBool( TRUE);
- prot.WriteBool( FALSE);
- prot.WriteByte( TEST_SHORT);
- prot.WriteI16( TEST_SMALL);
- prot.WriteI32( TEST_LONG);
- prot.WriteI64( TEST_I64);
- prot.WriteDouble( TEST_DOUBLE);
- prot.WriteString( TEST_STRING);
- prot.WriteBinary( binary);
- prot.WriteListEnd;
-
- // input setup
- Expect( stm.Position = stm.Size, 'Stream position/length after write');
- stm.Position := 0;
- prot := TJSONProtocolImpl.Create(
- TStreamTransportImpl.Create(
- TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
-
- // read and compare
- list := prot.ReadListBegin;
- Expect( list.ElementType = TType.String_, 'list element type');
- Expect( list.Count = 9, 'list element count');
- Expect( prot.ReadBool, 'WriteBool/ReadBool: TRUE');
- Expect( not prot.ReadBool, 'WriteBool/ReadBool: FALSE');
- Expect( prot.ReadByte = TEST_SHORT, 'WriteByte/ReadByte');
- Expect( prot.ReadI16 = TEST_SMALL, 'WriteI16/ReadI16');
- Expect( prot.ReadI32 = TEST_LONG, 'WriteI32/ReadI32');
- Expect( prot.ReadI64 = TEST_I64, 'WriteI64/ReadI64');
- Expect( abs(prot.ReadDouble-TEST_DOUBLE) < abs(DELTA_DOUBLE), 'WriteDouble/ReadDouble');
- Expect( prot.ReadString = TEST_STRING, 'WriteString/ReadString');
- binRead := prot.ReadBinary;
- prot.ReadListEnd;
-
- // test binary data
- Expect( Length(binary) = Length(binRead), 'Binary data length check');
- iErr := -1;
- for i := Low(binary) to High(binary) do begin
- if binary[i] <> binRead[i] then begin
- iErr := i;
- Break;
- end;
- end;
- if iErr < 0
- then Expect( TRUE, 'Binary data check ('+IntToStr(Length(binary))+' Bytes)')
- else Expect( FALSE, 'Binary data check at offset '+IntToStr(iErr));
-
- Expect( stm.Position = stm.Size, 'Stream position after read');
-
- finally
- stm.Free;
- prot := nil; //-> Release
- StartTestGroup( ''); // no more tests here
- end;
-end;
-
-
-procedure TClientThread.StartTestGroup( const aGroup : string);
-begin
- FTestGroup := aGroup;
- if FTestGroup <> '' then begin
- Console.WriteLine('');
- Console.WriteLine( aGroup+' tests');
- Console.WriteLine( StringOfChar('-',60));
- end;
-end;
-
-
-procedure TClientThread.Expect( aTestResult : Boolean; const aTestInfo : string);
-begin
- if aTestResult then begin
- Inc(FSuccesses);
- Console.WriteLine( aTestInfo+': passed');
- end
- else begin
- FErrors.Add( FTestGroup+': '+aTestInfo);
- 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 asm int 3 end;
- end;
-end;
-
-
-procedure TClientThread.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;
-
-
-constructor TClientThread.Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
-begin
- inherited Create( True );
- FNumIteration := ANumIteration;
- FTransport := ATransport;
- FProtocol := AProtocol;
- FConsole := TThreadConsole.Create( Self );
-
- // error list: keep correct order, allow for duplicates
- FErrors := TStringList.Create;
- FErrors.Sorted := FALSE;
- FErrors.Duplicates := dupAccept;
-end;
-
-destructor TClientThread.Destroy;
-begin
- FreeAndNil( FConsole);
- FreeAndNil( FErrors);
- inherited;
-end;
-
-procedure TClientThread.Execute;
-var
- i : Integer;
- proc : TThreadProcedure;
-begin
- // perform all tests
- try
- for i := 0 to FNumIteration - 1 do
- begin
- ClientTest;
- JSONProtocolReadWriteTest;
- end;
- except
- on e:Exception do Expect( FALSE, 'unexpected exception: "'+e.message+'"');
- end;
-
- // report the outcome
- ReportResults;
-
- // shutdown
- proc := procedure
- begin
- if FTransport <> nil then
- begin
- FTransport.Close;
- FTransport := nil;
- end;
- end;
-
- Synchronize( proc );
-end;
-
-{ TThreadConsole }
-
-constructor TThreadConsole.Create(AThread: TThread);
-begin
- FThread := AThread;
-end;
-
-procedure TThreadConsole.Write(const S: string);
-var
- proc : TThreadProcedure;
-begin
- proc := procedure
- begin
- Console.Write( S );
- end;
- TThread.Synchronize( FThread, proc);
-end;
-
-procedure TThreadConsole.WriteLine(const S: string);
-var
- proc : TThreadProcedure;
-begin
- proc := procedure
- begin
- Console.WriteLine( S );
- end;
- TThread.Synchronize( FThread, proc);
-end;
-
-initialization
-begin
- TTestClient.FNumIteration := 1;
- TTestClient.FNumThread := 1;
-end;
-
-end.
+(*
+ * 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 TestClient;
+
+interface
+
+uses
+ Windows, SysUtils, Classes,
+ DateUtils,
+ Generics.Collections,
+ TestConstants,
+ Thrift,
+ Thrift.Protocol.JSON,
+ Thrift.Protocol,
+ Thrift.Transport.Pipes,
+ Thrift.Transport,
+ Thrift.Stream,
+ Thrift.Test,
+ Thrift.Collections,
+ Thrift.Console;
+
+type
+ TThreadConsole = class
+ private
+ FThread : TThread;
+ public
+ procedure Write( const S : string);
+ procedure WriteLine( const S : string);
+ constructor Create( AThread: TThread);
+ end;
+
+ TClientThread = class( TThread )
+ private
+ FTransport : ITransport;
+ FProtocol : IProtocol;
+ FNumIteration : Integer;
+ FConsole : TThreadConsole;
+
+ // test reporting, will be refactored out into separate class later
+ FTestGroup : string;
+ FSuccesses : Integer;
+ FErrors : TStringList;
+ procedure StartTestGroup( const aGroup : string);
+ procedure Expect( aTestResult : Boolean; const aTestInfo : string);
+ procedure ReportResults;
+
+ procedure ClientTest;
+ procedure JSONProtocolReadWriteTest;
+ protected
+ procedure Execute; override;
+ public
+ constructor Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
+ destructor Destroy; override;
+ end;
+
+ TTestClient = class
+ private
+ class var
+ FNumIteration : Integer;
+ FNumThread : Integer;
+ public
+ class procedure Execute( const args: array of string);
+ end;
+
+implementation
+
+function BoolToString( b : Boolean) : string;
+// overrides global BoolToString()
+begin
+ if b
+ then result := 'true'
+ else result := 'false';
+end;
+
+// not available in all versions, so make sure we have this one imported
+function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent';
+
+{ TTestClient }
+
+class procedure TTestClient.Execute(const args: array of string);
+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;
+ thread : TThread;
+ trans : ITransport;
+ prot : IProtocol;
+ streamtrans : IStreamTransport;
+ http : IHTTPClient;
+ protType, p : TKnownProtocol;
+begin
+ bBuffered := False;;
+ bFramed := False;
+ protType := prot_Binary;
+ 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
+ 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;
+
+ end;
+
+ except
+ on E: Exception do
+ begin
+ Console.WriteLine( E.Message );
+ end;
+ end;
+
+ SetLength( threads, FNumThread);
+ dtStart := Now;
+
+ for test := 0 to FNumThread - 1 do
+ begin
+ if url = '' then
+ begin
+ if sPipeName <> '' then begin
+ Console.WriteLine('Using named pipe ('+sPipeName+')');
+ streamtrans := TNamedPipeImpl.Create( sPipeName);
+ end
+ else if bAnonPipe then begin
+ Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(hAnonRead))+' and '+IntToStr(Integer(hAnonWrite))+')');
+ streamtrans := TAnonymousPipeImpl.Create( hAnonRead, hAnonWrite, FALSE);
+ end
+ else 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);
+ Console.WriteLine('Using buffered transport');
+ end;
+
+ if bFramed then begin
+ trans := TFramedTransportImpl.Create( trans );
+ Console.WriteLine('Using framed transport');
+ end;
+
+ end
+ else begin
+ Console.WriteLine('Using HTTPClient');
+ http := THTTPClientImpl.Create( url );
+ trans := http;
+ end;
+
+ // create protocol instance, default to BinaryProtocol
+ case protType of
+ prot_Binary: prot := TBinaryProtocolImpl.Create( trans);
+ prot_JSON : prot := TJSONProtocolImpl.Create( trans);
+ else
+ ASSERT( FALSE); // unhandled case!
+ prot := TBinaryProtocolImpl.Create( trans); // use default
+ end;
+
+ thread := TClientThread.Create( trans, prot, FNumIteration);
+ threads[test] := thread;
+{$WARN SYMBOL_DEPRECATED OFF}
+ thread.Resume;
+{$WARN SYMBOL_DEPRECATED ON}
+ end;
+
+ for test := 0 to FNumThread - 1 do
+ begin
+ threads[test].WaitFor;
+ end;
+
+ for test := 0 to FNumThread - 1 do
+ begin
+ threads[test].Free;
+ end;
+
+ Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));
+
+ except
+ on E: Exception do
+ begin
+ Console.WriteLine( E.Message + ' ST: ' + E.StackTrace );
+ end;
+ end;
+
+ Console.WriteLine('');
+ Console.WriteLine('done!');
+end;
+
+{ TClientThread }
+
+procedure TClientThread.ClientTest;
+var
+ client : TThriftTest.Iface;
+ s : string;
+ i8 : ShortInt;
+ i32 : Integer;
+ i64 : Int64;
+ dub : Double;
+ o : IXtruct;
+ o2 : IXtruct2;
+ i : IXtruct;
+ i2 : IXtruct2;
+ mapout : IThriftDictionary<Integer,Integer>;
+ mapin : IThriftDictionary<Integer,Integer>;
+ strmapout : IThriftDictionary<string,string>;
+ strmapin : IThriftDictionary<string,string>;
+ j : Integer;
+ first : Boolean;
+ key : Integer;
+ strkey : string;
+ listout : IThriftList<Integer>;
+ listin : IThriftList<Integer>;
+ setout : IHashSet<Integer>;
+ setin : IHashSet<Integer>;
+ ret : TNumberz;
+ uid : Int64;
+ mm : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
+ pos : IThriftDictionary<Integer, Integer>;
+ neg : IThriftDictionary<Integer, Integer>;
+ m2 : IThriftDictionary<Integer, Integer>;
+ k2 : Integer;
+ insane : IInsanity;
+ truck : IXtruct;
+ whoa : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
+ key64 : Int64;
+ val : IThriftDictionary<TNumberz, IInsanity>;
+ k2_2 : TNumberz;
+ k3 : TNumberz;
+ v2 : IInsanity;
+ userMap : IThriftDictionary<TNumberz, Int64>;
+ xtructs : IThriftList<IXtruct>;
+ x : IXtruct;
+ arg0 : ShortInt;
+ arg1 : Integer;
+ arg2 : Int64;
+ arg3 : IThriftDictionary<SmallInt, string>;
+ arg4 : TNumberz;
+ arg5 : Int64;
+ StartTick : Cardinal;
+ k : Integer;
+ proc : TThreadProcedure;
+ hello, goodbye : IXtruct;
+ crazy : IInsanity;
+ looney : IInsanity;
+ first_map : IThriftDictionary<TNumberz, IInsanity>;
+ second_map : IThriftDictionary<TNumberz, IInsanity>;
+
+begin
+ client := TThriftTest.TClient.Create( FProtocol);
+ FTransport.Open;
+
+ // in-depth exception test
+ // (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');
+ // case 1: exception type declared in IDL at the function call
+ try
+ client.testException('Xception');
+ Expect( FALSE, 'testException(''Xception''): must trow an exception');
+ except
+ on e:TXception do begin
+ Expect( e.ErrorCode = 1001, 'error code');
+ Expect( e.Message_ = 'Xception', 'error message');
+ Console.WriteLine( ' = ' + IntToStr(e.ErrorCode) + ', ' + e.Message_ );
+ end;
+ on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
+ on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
+ end;
+
+ // case 2: exception type NOT declared in IDL at the function call
+ // this will close the connection
+ try
+ client.testException('TException');
+ Expect( FALSE, 'testException(''TException''): must trow an exception');
+ except
+ on e:TTransportException do begin
+ Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
+ if FTransport.IsOpen then FTransport.Close;
+ FTransport.Open; // re-open connection, server has already closed
+ end;
+ on e:TException do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
+ on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
+ end;
+
+ // case 3: no exception
+ try
+ client.testException('something');
+ Expect( TRUE, 'testException(''something''): must not trow an exception');
+ except
+ on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
+ on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
+ end;
+
+
+ // simple things
+ StartTestGroup( 'simple Thrift calls');
+ client.testVoid();
+ Expect( TRUE, 'testVoid()'); // success := no exception
+
+ s := client.testString('Test');
+ Expect( s = 'Test', 'testString(''Test'') = "'+s+'"');
+
+ i8 := client.testByte(1);
+ Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));
+
+ i32 := client.testI32(-1);
+ Expect( i32 = -1, 'testI32(-1) = ' + IntToStr(i32));
+
+ Console.WriteLine('testI64(-34359738368)');
+ i64 := client.testI64(-34359738368);
+ Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64));
+
+ Console.WriteLine('testDouble(5.325098235)');
+ dub := client.testDouble(5.325098235);
+ Expect( abs(dub-5.325098235) < 1e-14, 'testDouble(5.325098235) = ' + FloatToStr( dub));
+
+ // structs
+ StartTestGroup( 'testStruct');
+ Console.WriteLine('testStruct({''Zero'', 1, -3, -5})');
+ o := TXtructImpl.Create;
+ o.String_thing := 'Zero';
+ o.Byte_thing := 1;
+ o.I32_thing := -3;
+ o.I64_thing := -5;
+ i := client.testStruct(o);
+ Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
+ Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
+ Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
+ Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
+ Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
+ Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
+ Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
+ Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
+
+ // nested structs
+ StartTestGroup( 'testNest');
+ Console.WriteLine('testNest({1, {''Zero'', 1, -3, -5}, 5})');
+ o2 := TXtruct2Impl.Create;
+ o2.Byte_thing := 1;
+ o2.Struct_thing := o;
+ o2.I32_thing := 5;
+ i2 := client.testNest(o2);
+ i := i2.Struct_thing;
+ Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
+ Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
+ Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
+ Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
+ Expect( i2.Byte_thing = 1, 'i2.Byte_thing = '+IntToStr(i2.Byte_thing));
+ Expect( i2.I32_thing = 5, 'i2.I32_thing = '+IntToStr(i2.I32_thing));
+ Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
+ Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
+ Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
+ Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
+ Expect( i2.__isset_Byte_thing, 'i2.__isset_Byte_thing');
+ Expect( i2.__isset_I32_thing, 'i2.__isset_I32_thing');
+
+ // 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');
+ mapout := TThriftDictionaryImpl<Integer,Integer>.Create;
+ for j := 0 to 4 do
+ begin
+ mapout.AddOrSetValue( j, j - 10);
+ end;
+ Console.Write('testMap({');
+ first := True;
+ for key in mapout.Keys do
+ begin
+ if first
+ then first := False
+ else Console.Write( ', ' );
+ Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key]));
+ end;
+ Console.WriteLine('})');
+
+ mapin := client.testMap( mapout );
+ Expect( mapin.Count = mapout.Count, 'testMap: mapin.Count = mapout.Count');
+ for j := 0 to 4 do
+ begin
+ Expect( mapout.ContainsKey(j), 'testMap: mapout.ContainsKey('+IntToStr(j)+') = '+BoolToString(mapout.ContainsKey(j)));
+ end;
+ for key in mapin.Keys do
+ begin
+ Expect( mapin[key] = mapout[key], 'testMap: '+IntToStr(key) + ' => ' + IntToStr( mapin[key]));
+ Expect( mapin[key] = key - 10, 'testMap: mapin['+IntToStr(key)+'] = '+IntToStr( mapin[key]));
+ end;
+
+
+ // 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');
+ strmapout := TThriftDictionaryImpl<string,string>.Create;
+ for j := 0 to 4 do
+ begin
+ strmapout.AddOrSetValue( IntToStr(j), IntToStr(j - 10));
+ end;
+ Console.Write('testStringMap({');
+ first := True;
+ for strkey in strmapout.Keys do
+ begin
+ if first
+ then first := False
+ else Console.Write( ', ' );
+ Console.Write( strkey + ' => ' + strmapout[strkey]);
+ end;
+ Console.WriteLine('})');
+
+ strmapin := client.testStringMap( strmapout );
+ Expect( strmapin.Count = strmapout.Count, 'testStringMap: strmapin.Count = strmapout.Count');
+ for j := 0 to 4 do
+ begin
+ Expect( strmapout.ContainsKey(IntToStr(j)),
+ 'testStringMap: strmapout.ContainsKey('+IntToStr(j)+') = '
+ + BoolToString(strmapout.ContainsKey(IntToStr(j))));
+ end;
+ for strkey in strmapin.Keys do
+ begin
+ Expect( strmapin[strkey] = strmapout[strkey], 'testStringMap: '+strkey + ' => ' + strmapin[strkey]);
+ Expect( strmapin[strkey] = IntToStr( StrToInt(strkey) - 10), 'testStringMap: strmapin['+strkey+'] = '+strmapin[strkey]);
+ end;
+
+
+ // 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');
+ setout := THashSetImpl<Integer>.Create;
+ for j := -2 to 2 do
+ begin
+ setout.Add( j );
+ end;
+ Console.Write('testSet({');
+ first := True;
+ for j in setout do
+ begin
+ if first
+ then first := False
+ else Console.Write(', ');
+ Console.Write(IntToStr( j));
+ end;
+ Console.WriteLine('})');
+
+ setin := client.testSet(setout);
+ Expect( setin.Count = setout.Count, 'testSet: setin.Count = setout.Count');
+ Expect( setin.Count = 5, 'testSet: setin.Count = '+IntToStr(setin.Count));
+ for j := -2 to 2 do // unordered, we can't rely on the order => test for known elements only
+ begin
+ Expect( setin.Contains(j), 'testSet: setin.Contains('+IntToStr(j)+') => '+BoolToString(setin.Contains(j)));
+ end;
+
+ // list<type>: An ordered list of elements.
+ // Translates to an STL vector, Java ArrayList, native arrays in scripting languages, etc.
+ StartTestGroup( 'testList');
+ listout := TThriftListImpl<Integer>.Create;
+ listout.Add( +1);
+ listout.Add( -2);
+ listout.Add( +3);
+ listout.Add( -4);
+ listout.Add( 0);
+ Console.Write('testList({');
+ first := True;
+ for j in listout do
+ begin
+ if first
+ then first := False
+ else Console.Write(', ');
+ Console.Write(IntToStr( j));
+ end;
+ Console.WriteLine('})');
+
+ listin := client.testList(listout);
+ Expect( listin.Count = listout.Count, 'testList: listin.Count = listout.Count');
+ Expect( listin.Count = 5, 'testList: listin.Count = '+IntToStr(listin.Count));
+ Expect( listin[0] = +1, 'listin[0] = '+IntToStr( listin[0]));
+ Expect( listin[1] = -2, 'listin[1] = '+IntToStr( listin[1]));
+ Expect( listin[2] = +3, 'listin[2] = '+IntToStr( listin[2]));
+ Expect( listin[3] = -4, 'listin[3] = '+IntToStr( listin[3]));
+ Expect( listin[4] = 0, 'listin[4] = '+IntToStr( listin[4]));
+
+ // enums
+ ret := client.testEnum(TNumberz.ONE);
+ Expect( ret = TNumberz.ONE, 'testEnum(ONE) = '+IntToStr(Ord(ret)));
+
+ ret := client.testEnum(TNumberz.TWO);
+ Expect( ret = TNumberz.TWO, 'testEnum(TWO) = '+IntToStr(Ord(ret)));
+
+ ret := client.testEnum(TNumberz.THREE);
+ Expect( ret = TNumberz.THREE, 'testEnum(THREE) = '+IntToStr(Ord(ret)));
+
+ ret := client.testEnum(TNumberz.FIVE);
+ Expect( ret = TNumberz.FIVE, 'testEnum(FIVE) = '+IntToStr(Ord(ret)));
+
+ ret := client.testEnum(TNumberz.EIGHT);
+ Expect( ret = TNumberz.EIGHT, 'testEnum(EIGHT) = '+IntToStr(Ord(ret)));
+
+
+ // typedef
+ uid := client.testTypedef(309858235082523);
+ Expect( uid = 309858235082523, 'testTypedef(309858235082523) = '+IntToStr(uid));
+
+
+ // maps of maps
+ StartTestGroup( 'testMapMap(1)');
+ mm := client.testMapMap(1);
+ Console.Write(' = {');
+ for key in mm.Keys do
+ begin
+ Console.Write( IntToStr( key) + ' => {');
+ m2 := mm[key];
+ for k2 in m2.Keys do
+ begin
+ Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', ');
+ end;
+ Console.Write('}, ');
+ end;
+ Console.WriteLine('}');
+
+ // verify result data
+ Expect( mm.Count = 2, 'mm.Count = '+IntToStr(mm.Count));
+ pos := mm[4];
+ neg := mm[-4];
+ for j := 1 to 4 do
+ begin
+ Expect( pos[j] = j, 'pos[j] = '+IntToStr(pos[j]));
+ Expect( neg[-j] = -j, 'neg[-j] = '+IntToStr(neg[-j]));
+ end;
+
+
+
+ // insanity
+ StartTestGroup( 'testInsanity');
+ insane := TInsanityImpl.Create;
+ insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
+ insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);
+ truck := TXtructImpl.Create;
+ truck.String_thing := 'Truck';
+ truck.Byte_thing := 8;
+ truck.I32_thing := 8;
+ truck.I64_thing := 8;
+ insane.Xtructs := TThriftListImpl<IXtruct>.Create;
+ insane.Xtructs.Add( truck );
+ whoa := client.testInsanity( insane );
+ Console.Write(' = {');
+ for key64 in whoa.Keys do
+ begin
+ val := whoa[key64];
+ Console.Write( IntToStr( key64) + ' => {');
+ for k2_2 in val.Keys do
+ begin
+ v2 := val[k2_2];
+ Console.Write( IntToStr( Integer( k2_2)) + ' => {');
+ userMap := v2.UserMap;
+ Console.Write('{');
+ if userMap <> nil then
+ begin
+ for k3 in userMap.Keys do
+ begin
+ Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', ');
+ end;
+ end else
+ begin
+ Console.Write('null');
+ end;
+ Console.Write('}, ');
+ xtructs := v2.Xtructs;
+ Console.Write('{');
+
+ if xtructs <> nil then
+ begin
+ for x in xtructs do
+ begin
+ Console.Write('{"' + x.String_thing + '", ' +
+ IntToStr( x.Byte_thing) + ', ' +
+ IntToStr( x.I32_thing) + ', ' +
+ IntToStr( x.I32_thing) + '}, ');
+ end;
+ end else
+ begin
+ Console.Write('null');
+ end;
+ Console.Write('}');
+ Console.Write('}, ');
+ end;
+ Console.Write('}, ');
+ end;
+ Console.WriteLine('}');
+
+ // verify result data
+ Expect( whoa.Count = 2, 'whoa.Count = '+IntToStr(whoa.Count));
+ //
+ first_map := whoa[1];
+ second_map := whoa[2];
+ Expect( first_map.Count = 2, 'first_map.Count = '+IntToStr(first_map.Count));
+ Expect( second_map.Count = 1, 'second_map.Count = '+IntToStr(second_map.Count));
+ //
+ looney := second_map[TNumberz.SIX];
+ Expect( Assigned(looney), 'Assigned(looney) = '+BoolToString(Assigned(looney)));
+ Expect( not looney.__isset_UserMap, 'looney.__isset_UserMap = '+BoolToString(looney.__isset_UserMap));
+ Expect( not looney.__isset_Xtructs, 'looney.__isset_Xtructs = '+BoolToString(looney.__isset_Xtructs));
+ //
+ for ret in [TNumberz.TWO, TNumberz.THREE] do begin
+ crazy := first_map[ret];
+ Console.WriteLine('first_map['+intToStr(Ord(ret))+']');
+
+ Expect( crazy.__isset_UserMap, 'crazy.__isset_UserMap = '+BoolToString(crazy.__isset_UserMap));
+ Expect( crazy.__isset_Xtructs, 'crazy.__isset_Xtructs = '+BoolToString(crazy.__isset_Xtructs));
+
+ Expect( crazy.UserMap.Count = 2, 'crazy.UserMap.Count = '+IntToStr(crazy.UserMap.Count));
+ Expect( crazy.UserMap[TNumberz.FIVE] = 5, 'crazy.UserMap[TNumberz.FIVE] = '+IntToStr(crazy.UserMap[TNumberz.FIVE]));
+ Expect( crazy.UserMap[TNumberz.EIGHT] = 8, 'crazy.UserMap[TNumberz.EIGHT] = '+IntToStr(crazy.UserMap[TNumberz.EIGHT]));
+
+ Expect( crazy.Xtructs.Count = 2, 'crazy.Xtructs.Count = '+IntToStr(crazy.Xtructs.Count));
+ goodbye := crazy.Xtructs[0]; // lists are ordered, so we are allowed to assume this order
+ hello := crazy.Xtructs[1];
+
+ Expect( goodbye.String_thing = 'Goodbye4', 'goodbye.String_thing = "'+goodbye.String_thing+'"');
+ Expect( goodbye.Byte_thing = 4, 'goodbye.Byte_thing = '+IntToStr(goodbye.Byte_thing));
+ Expect( goodbye.I32_thing = 4, 'goodbye.I32_thing = '+IntToStr(goodbye.I32_thing));
+ Expect( goodbye.I64_thing = 4, 'goodbye.I64_thing = '+IntToStr(goodbye.I64_thing));
+ Expect( goodbye.__isset_String_thing, 'goodbye.__isset_String_thing = '+BoolToString(goodbye.__isset_String_thing));
+ Expect( goodbye.__isset_Byte_thing, 'goodbye.__isset_Byte_thing = '+BoolToString(goodbye.__isset_Byte_thing));
+ Expect( goodbye.__isset_I32_thing, 'goodbye.__isset_I32_thing = '+BoolToString(goodbye.__isset_I32_thing));
+ Expect( goodbye.__isset_I64_thing, 'goodbye.__isset_I64_thing = '+BoolToString(goodbye.__isset_I64_thing));
+
+ Expect( hello.String_thing = 'Hello2', 'hello.String_thing = "'+hello.String_thing+'"');
+ Expect( hello.Byte_thing = 2, 'hello.Byte_thing = '+IntToStr(hello.Byte_thing));
+ Expect( hello.I32_thing = 2, 'hello.I32_thing = '+IntToStr(hello.I32_thing));
+ Expect( hello.I64_thing = 2, 'hello.I64_thing = '+IntToStr(hello.I64_thing));
+ Expect( hello.__isset_String_thing, 'hello.__isset_String_thing = '+BoolToString(hello.__isset_String_thing));
+ Expect( hello.__isset_Byte_thing, 'hello.__isset_Byte_thing = '+BoolToString(hello.__isset_Byte_thing));
+ Expect( hello.__isset_I32_thing, 'hello.__isset_I32_thing = '+BoolToString(hello.__isset_I32_thing));
+ Expect( hello.__isset_I64_thing, 'hello.__isset_I64_thing = '+BoolToString(hello.__isset_I64_thing));
+ end;
+
+
+ // multi args
+ StartTestGroup( 'testMulti');
+ arg0 := 1;
+ arg1 := 2;
+ arg2 := High(Int64);
+ arg3 := TThriftDictionaryImpl<SmallInt, string>.Create;
+ arg3.AddOrSetValue( 1, 'one');
+ arg4 := TNumberz.FIVE;
+ arg5 := 5000000;
+ Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' +
+ IntToStr( arg1) + ',' + IntToStr( arg2) + ',' +
+ arg3.ToString + ',' + IntToStr( Integer( arg4)) + ',' +
+ IntToStr( arg5) + ')');
+
+ i := client.testMulti( arg0, arg1, arg2, arg3, arg4, arg5);
+ Expect( i.String_thing = 'Hello2', 'testMulti: i.String_thing = "'+i.String_thing+'"');
+ Expect( i.Byte_thing = arg0, 'testMulti: i.Byte_thing = '+IntToStr(i.Byte_thing));
+ Expect( i.I32_thing = arg1, 'testMulti: i.I32_thing = '+IntToStr(i.I32_thing));
+ Expect( i.I64_thing = arg2, 'testMulti: i.I64_thing = '+IntToStr(i.I64_thing));
+ Expect( i.__isset_String_thing, 'testMulti: i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
+ Expect( i.__isset_Byte_thing, 'testMulti: i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
+ Expect( i.__isset_I32_thing, 'testMulti: i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
+ Expect( i.__isset_I64_thing, 'testMulti: i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
+
+ // multi exception
+ StartTestGroup( 'testMultiException(1)');
+ 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+ '"');
+ Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
+ Expect( not i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
+ Expect( not i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
+ Expect( not i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
+ except
+ on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
+ end;
+
+ StartTestGroup( 'testMultiException(Xception)');
+ try
+ i := client.testMultiException( 'Xception', 'second test');
+ Expect( FALSE, 'testMultiException(''Xception''): must trow an exception');
+ except
+ on x:TXception do begin
+ Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
+ Expect( x.__isset_Message_, 'x.__isset_Message_ = '+BoolToString(x.__isset_Message_));
+ Expect( x.ErrorCode = 1001, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
+ Expect( x.Message_ = 'This is an Xception', 'x.Message = "'+x.Message_+'"');
+ end;
+ on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
+ end;
+
+ StartTestGroup( 'testMultiException(Xception2)');
+ try
+ i := client.testMultiException( 'Xception2', 'third test');
+ Expect( FALSE, 'testMultiException(''Xception2''): must trow an exception');
+ except
+ on x:TXception2 do begin
+ Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
+ Expect( x.__isset_Struct_thing, 'x.__isset_Struct_thing = '+BoolToString(x.__isset_Struct_thing));
+ Expect( x.ErrorCode = 2002, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
+ Expect( x.Struct_thing.String_thing = 'This is an Xception2', 'x.Struct_thing.String_thing = "'+x.Struct_thing.String_thing+'"');
+ Expect( x.Struct_thing.__isset_String_thing, 'x.Struct_thing.__isset_String_thing = '+BoolToString(x.Struct_thing.__isset_String_thing));
+ Expect( not x.Struct_thing.__isset_Byte_thing, 'x.Struct_thing.__isset_Byte_thing = '+BoolToString(x.Struct_thing.__isset_Byte_thing));
+ Expect( not x.Struct_thing.__isset_I32_thing, 'x.Struct_thing.__isset_I32_thing = '+BoolToString(x.Struct_thing.__isset_I32_thing));
+ Expect( not x.Struct_thing.__isset_I64_thing, 'x.Struct_thing.__isset_I64_thing = '+BoolToString(x.Struct_thing.__isset_I64_thing));
+ end;
+ on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
+ end;
+
+
+ // oneway functions
+ StartTestGroup( 'Test Oneway(1)');
+ client.testOneway(1);
+ Expect( TRUE, 'Test Oneway(1)'); // success := no exception
+
+ // call time
+ StartTestGroup( 'Test Calltime()');
+ StartTick := GetTIckCount;
+ for k := 0 to 1000 - 1 do
+ begin
+ client.testVoid();
+ end;
+ Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' );
+
+ // no more tests here
+ StartTestGroup( '');
+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
+// Note that passing this test does not imply, that our JSON is really compatible to what
+// other clients or servers expect as the real JSON. This is beyond the scope of this test.
+var prot : IProtocol;
+ stm : TStringStream;
+ list : IList;
+ binary, binRead : TBytes;
+ i,iErr : Integer;
+const
+ TEST_SHORT = ShortInt( $FE);
+ TEST_SMALL = SmallInt( $FEDC);
+ TEST_LONG = LongInt( $FEDCBA98);
+ TEST_I64 = Int64( $FEDCBA9876543210);
+ TEST_DOUBLE = -1.234e-56;
+ DELTA_DOUBLE = TEST_DOUBLE * 1e-14;
+ TEST_STRING = 'abc-'#$00E4#$00f6#$00fc; // german umlauts (en-us: "funny chars")
+begin
+ stm := TStringStream.Create;
+ try
+ StartTestGroup( 'JsonProtocolTest'); // no more tests here
+
+ // prepare binary data
+ SetLength( binary, $100);
+ for i := Low(binary) to High(binary) do binary[i] := i;
+
+ // output setup
+ prot := TJSONProtocolImpl.Create(
+ TStreamTransportImpl.Create(
+ nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));
+
+ // write
+ prot.WriteListBegin( TListImpl.Create( TType.String_, 9));
+ prot.WriteBool( TRUE);
+ prot.WriteBool( FALSE);
+ prot.WriteByte( TEST_SHORT);
+ prot.WriteI16( TEST_SMALL);
+ prot.WriteI32( TEST_LONG);
+ prot.WriteI64( TEST_I64);
+ prot.WriteDouble( TEST_DOUBLE);
+ prot.WriteString( TEST_STRING);
+ prot.WriteBinary( binary);
+ prot.WriteListEnd;
+
+ // input setup
+ Expect( stm.Position = stm.Size, 'Stream position/length after write');
+ stm.Position := 0;
+ prot := TJSONProtocolImpl.Create(
+ TStreamTransportImpl.Create(
+ TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
+
+ // read and compare
+ list := prot.ReadListBegin;
+ Expect( list.ElementType = TType.String_, 'list element type');
+ Expect( list.Count = 9, 'list element count');
+ Expect( prot.ReadBool, 'WriteBool/ReadBool: TRUE');
+ Expect( not prot.ReadBool, 'WriteBool/ReadBool: FALSE');
+ Expect( prot.ReadByte = TEST_SHORT, 'WriteByte/ReadByte');
+ Expect( prot.ReadI16 = TEST_SMALL, 'WriteI16/ReadI16');
+ Expect( prot.ReadI32 = TEST_LONG, 'WriteI32/ReadI32');
+ Expect( prot.ReadI64 = TEST_I64, 'WriteI64/ReadI64');
+ Expect( abs(prot.ReadDouble-TEST_DOUBLE) < abs(DELTA_DOUBLE), 'WriteDouble/ReadDouble');
+ Expect( prot.ReadString = TEST_STRING, 'WriteString/ReadString');
+ binRead := prot.ReadBinary;
+ prot.ReadListEnd;
+
+ // test binary data
+ Expect( Length(binary) = Length(binRead), 'Binary data length check');
+ iErr := -1;
+ for i := Low(binary) to High(binary) do begin
+ if binary[i] <> binRead[i] then begin
+ iErr := i;
+ Break;
+ end;
+ end;
+ if iErr < 0
+ then Expect( TRUE, 'Binary data check ('+IntToStr(Length(binary))+' Bytes)')
+ else Expect( FALSE, 'Binary data check at offset '+IntToStr(iErr));
+
+ Expect( stm.Position = stm.Size, 'Stream position after read');
+
+ finally
+ stm.Free;
+ prot := nil; //-> Release
+ StartTestGroup( ''); // no more tests here
+ end;
+end;
+
+
+procedure TClientThread.StartTestGroup( const aGroup : string);
+begin
+ FTestGroup := aGroup;
+ if FTestGroup <> '' then begin
+ Console.WriteLine('');
+ Console.WriteLine( aGroup+' tests');
+ Console.WriteLine( StringOfChar('-',60));
+ end;
+end;
+
+
+procedure TClientThread.Expect( aTestResult : Boolean; const aTestInfo : string);
+begin
+ if aTestResult then begin
+ Inc(FSuccesses);
+ Console.WriteLine( aTestInfo+': passed');
+ end
+ else begin
+ FErrors.Add( FTestGroup+': '+aTestInfo);
+ 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 asm int 3 end;
+ end;
+end;
+
+
+procedure TClientThread.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;
+
+
+constructor TClientThread.Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
+begin
+ inherited Create( True );
+ FNumIteration := ANumIteration;
+ FTransport := ATransport;
+ FProtocol := AProtocol;
+ FConsole := TThreadConsole.Create( Self );
+
+ // error list: keep correct order, allow for duplicates
+ FErrors := TStringList.Create;
+ FErrors.Sorted := FALSE;
+ FErrors.Duplicates := dupAccept;
+end;
+
+destructor TClientThread.Destroy;
+begin
+ FreeAndNil( FConsole);
+ FreeAndNil( FErrors);
+ inherited;
+end;
+
+procedure TClientThread.Execute;
+var
+ i : Integer;
+ proc : TThreadProcedure;
+begin
+ // perform all tests
+ try
+ for i := 0 to FNumIteration - 1 do
+ begin
+ ClientTest;
+ JSONProtocolReadWriteTest;
+ end;
+ except
+ on e:Exception do Expect( FALSE, 'unexpected exception: "'+e.message+'"');
+ end;
+
+ // report the outcome
+ ReportResults;
+
+ // shutdown
+ proc := procedure
+ begin
+ if FTransport <> nil then
+ begin
+ FTransport.Close;
+ FTransport := nil;
+ end;
+ end;
+
+ Synchronize( proc );
+end;
+
+{ TThreadConsole }
+
+constructor TThreadConsole.Create(AThread: TThread);
+begin
+ FThread := AThread;
+end;
+
+procedure TThreadConsole.Write(const S: string);
+var
+ proc : TThreadProcedure;
+begin
+ proc := procedure
+ begin
+ Console.Write( S );
+ end;
+ TThread.Synchronize( FThread, proc);
+end;
+
+procedure TThreadConsole.WriteLine(const S: string);
+var
+ proc : TThreadProcedure;
+begin
+ proc := procedure
+ begin
+ Console.WriteLine( S );
+ end;
+ TThread.Synchronize( FThread, proc);
+end;
+
+initialization
+begin
+ TTestClient.FNumIteration := 1;
+ TTestClient.FNumThread := 1;
+end;
+
+end.
diff --git a/lib/delphi/test/TestServer.pas b/lib/delphi/test/TestServer.pas
index fa48e81..5d003da 100644
--- a/lib/delphi/test/TestServer.pas
+++ b/lib/delphi/test/TestServer.pas
@@ -19,14 +19,17 @@
unit TestServer;
+{$WARN SYMBOL_PLATFORM OFF}
+
interface
uses
- SysUtils,
+ Windows, SysUtils,
Generics.Collections,
Thrift.Console,
Thrift.Server,
Thrift.Transport,
+ Thrift.Transport.Pipes,
Thrift.Protocol,
Thrift.Protocol.JSON,
Thrift.Collections,
@@ -75,6 +78,7 @@
procedure SetServer( const AServer : IServer );
end;
+ class procedure LaunchAnonPipeChild( const app : string; const transport : IPipeServer);
class procedure Execute( const args: array of string);
end;
@@ -397,17 +401,63 @@
Result := thing;
end;
+
{ TTestServer }
+
+class procedure TTestServer.LaunchAnonPipeChild( const app : string; const transport : IPipeServer);
+//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
+//advanced features.
+var pi : PROCESS_INFORMATION;
+ si : STARTUPINFO;
+ sArg, sHandles, sCmdLine : string;
+ i : Integer;
+begin
+ GetStartupInfo( si); //set startupinfo for the spawned process
+
+ // preformat handles args
+ sHandles := Format( '%d %d',
+ [ Integer(transport.ClientAnonRead),
+ Integer(transport.ClientAnonWrite)]);
+
+ // pass all settings to client
+ sCmdLine := app;
+ for i := 1 to ParamCount do begin
+ sArg := ParamStr(i);
+
+ // add anonymous handles and quote strings where appropriate
+ if sArg = '-anon'
+ then sArg := sArg +' '+ sHandles
+ else begin
+ if Pos(' ',sArg) > 0
+ then sArg := '"'+sArg+'"';
+ end;;
+
+ sCmdLine := sCmdLine +' '+ sArg;
+ end;
+
+ // spawn the child process
+ Console.WriteLine('Starting client '+sCmdLine);
+ Win32Check( CreateProcess( nil, PChar(sCmdLine), nil,nil,TRUE,0,nil,nil,si,pi));
+
+ CloseHandle( pi.hThread);
+ CloseHandle( pi.hProcess);
+end;
+
+
class procedure TTestServer.Execute( const args: array of string);
var
UseBufferedSockets : Boolean;
UseFramed : Boolean;
Port : Integer;
+ AnonPipe : Boolean;
+ sPipeName : string;
testHandler : ITestHandler;
testProcessor : IProcessor;
- ServerSocket : IServerTransport;
+ ServerTrans : IServerTransport;
ServerEngine : IServer;
+ pipeserver : IPipeServer;
TransportFactory : ITransportFactory;
ProtocolFactory : IProtocolFactory;
i : Integer;
@@ -417,8 +467,10 @@
try
UseBufferedSockets := False;
UseFramed := False;
+ AnonPipe := FALSE;
protType := prot_Binary;
Port := 9090;
+ sPipeName := '';
i := 0;
while ( i < Length(args) ) do begin
@@ -428,20 +480,29 @@
if StrToIntDef( s, -1) > 0 then
begin
Port := StrToIntDef( s, Port);
- end else
- if ( s = 'raw' ) then
+ end
+ else if ( s = 'raw' ) then
begin
// as default
- end else
- if ( s = 'buffered' ) then
+ end
+ else if ( s = 'buffered' ) then
begin
UseBufferedSockets := True;
- end else
- if ( s = 'framed' ) then
+ end
+ else if ( s = 'framed' ) then
begin
UseFramed := True;
- end else
- if (s = '-prot') then // -prot JSON|binary
+ end
+ else if (s = '-pipe') then
+ begin
+ sPipeName := args[i]; // -pipe <name>
+ Inc( i );
+ end
+ else if (s = '-anon') then
+ begin
+ AnonPipe := TRUE;
+ end
+ else if (s = '-prot') then // -prot JSON|binary
begin
s := args[i];
Inc( i );
@@ -458,6 +519,9 @@
end
end;
+
+ Console.WriteLine('Server configuration: ');
+
// create protocol factory, default to BinaryProtocol
case protType of
prot_Binary: ProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
@@ -466,29 +530,53 @@
ASSERT( FALSE); // unhandled case!
ProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
end;
+ ASSERT( ProtocolFactory <> nil);
+ Console.WriteLine('- '+KNOWN_PROTOCOLS[protType]+' protocol');
- testHandler := TTestHandlerImpl.Create;
+ if sPipeName <> '' then begin
+ Console.WriteLine('- named pipe ('+sPipeName+')');
+ pipeserver := TServerPipeImpl.Create( sPipeName);
+ servertrans := pipeserver;
+ end
+ else if AnonPipe then begin
+ Console.WriteLine('- anonymous pipes');
+ pipeserver := TServerPipeImpl.Create;
+ servertrans := pipeserver;
+ end
+ else begin
+ Console.WriteLine('- sockets (port '+IntToStr(port)+')');
+ if UseBufferedSockets then Console.WriteLine('- buffered sockets');
+ servertrans := TServerSocketImpl.Create( Port, 0, UseBufferedSockets);
+ end;
+ ASSERT( servertrans <> nil);
+
+ if UseFramed then begin
+ Console.WriteLine('- framed transport');
+ TransportFactory := TFramedTransportImpl.TFactory.Create
+ end
+ else begin
+ TransportFactory := TTransportFactoryImpl.Create;
+ end;
+ ASSERT( TransportFactory <> nil);
+
+ testHandler := TTestHandlerImpl.Create;
testProcessor := TThriftTest.TProcessorImpl.Create( testHandler );
- ServerSocket := TServerSocketImpl.Create( Port, 0, UseBufferedSockets );
-
- if UseFramed
- then TransportFactory := TFramedTransportImpl.TFactory.Create
- else TransportFactory := TTransportFactoryImpl.Create;
ServerEngine := TSimpleServer.Create( testProcessor,
- ServerSocket,
+ ServerTrans,
TransportFactory,
ProtocolFactory);
testHandler.SetServer( ServerEngine);
- Console.WriteLine('Starting the server on port ' + IntToStr( Port) +
- IfValue(UseBufferedSockets, ' with buffered socket', '') +
- IfValue(useFramed, ' with framed transport', '') +
- ' using '+KNOWN_PROTOCOLS[protType]+' protocol' +
- '...');
+ // start the client now when we have the anon handles, but before the server starts
+ if AnonPipe
+ then LaunchAnonPipeChild( ExtractFilePath(ParamStr(0))+'client.exe', pipeserver);
+
+ Console.WriteLine('');
+ Console.WriteLine('Starting the server ...');
serverEngine.Serve;
testHandler.SetServer( nil);
diff --git a/lib/delphi/test/client.dpr b/lib/delphi/test/client.dpr
index f12fe84..209e29d 100644
--- a/lib/delphi/test/client.dpr
+++ b/lib/delphi/test/client.dpr
@@ -25,16 +25,17 @@
uses
SysUtils,
TestClient in 'TestClient.pas',
- Thrift.Test in 'gen-delphi\Thrift.Test.pas',
- Thrift in '..\..\..\lib\delphi\src\Thrift.pas',
- Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',
- Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',
- Thrift.Protocol.JSON in '..\..\..\lib\delphi\src\Thrift.Protocol.JSON.pas',
- Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',
- Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',
- Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas',
- Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',
- Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas';
+ Thrift.Test, // in 'gen-delphi\Thrift.Test.pas',
+ Thrift in '..\src\Thrift.pas',
+ Thrift.Transport in '..\src\Thrift.Transport.pas',
+ Thrift.Transport.Pipes in '..\src\Thrift.Transport.Pipes.pas',
+ Thrift.Protocol in '..\src\Thrift.Protocol.pas',
+ Thrift.Protocol.JSON in '..\src\Thrift.Protocol.JSON.pas',
+ Thrift.Collections in '..\src\Thrift.Collections.pas',
+ Thrift.Server in '..\src\Thrift.Server.pas',
+ Thrift.Stream in '..\src\Thrift.Stream.pas',
+ Thrift.Console in '..\src\Thrift.Console.pas',
+ Thrift.Utils in '..\src\Thrift.Utils.pas';
var
nParamCount : Integer;
diff --git a/lib/delphi/test/server.dpr b/lib/delphi/test/server.dpr
index 832f825..a5568c4 100644
--- a/lib/delphi/test/server.dpr
+++ b/lib/delphi/test/server.dpr
@@ -25,15 +25,16 @@
SysUtils,
TestServer in 'TestServer.pas',
Thrift.Test in 'gen-delphi\Thrift.Test.pas',
- Thrift in '..\..\..\lib\delphi\src\Thrift.pas',
- Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',
- Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',
- Thrift.Protocol.JSON in '..\..\..\lib\delphi\src\Thrift.Protocol.JSON.pas',
- Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',
- Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',
- Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',
- Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas',
- Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas';
+ Thrift in '..\src\Thrift.pas',
+ Thrift.Transport in '..\src\Thrift.Transport.pas',
+ Thrift.Transport.Pipes in '..\src\Thrift.Transport.Pipes.pas',
+ Thrift.Protocol in '..\src\Thrift.Protocol.pas',
+ Thrift.Protocol.JSON in '..\src\Thrift.Protocol.JSON.pas',
+ Thrift.Collections in '..\src\Thrift.Collections.pas',
+ Thrift.Server in '..\src\Thrift.Server.pas',
+ Thrift.Console in '..\src\Thrift.Console.pas',
+ Thrift.Utils in '..\src\Thrift.Utils.pas',
+ Thrift.Stream in '..\src\Thrift.Stream.pas';
var
nParamCount : Integer;