--- /dev/null
+(*
+ * 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.
+
+
+
-(*\r
- * Licensed to the Apache Software Foundation (ASF) under one\r
- * or more contributor license agreements. See the NOTICE file\r
- * distributed with this work for additional information\r
- * regarding copyright ownership. The ASF licenses this file\r
- * to you under the Apache License, Version 2.0 (the\r
- * "License"); you may not use this file except in compliance\r
- * with the License. You may obtain a copy of the License at\r
- *\r
- * http://www.apache.org/licenses/LICENSE-2.0\r
- *\r
- * Unless required by applicable law or agreed to in writing,\r
- * software distributed under the License is distributed on an\r
- * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
- * KIND, either express or implied. See the License for the\r
- * specific language governing permissions and limitations\r
- * under the License.\r
- *)\r
-\r
-unit TestClient;\r
-\r
-interface\r
-\r
-uses\r
- Windows, SysUtils, Classes,\r
- DateUtils,\r
- Generics.Collections,\r
- TestConstants,\r
- Thrift,\r
- Thrift.Protocol.JSON,\r
- Thrift.Protocol,\r
- Thrift.Transport,\r
- Thrift.Stream,\r
- Thrift.Test,\r
- Thrift.Collections,\r
- Thrift.Console;\r
-\r
-type\r
- TThreadConsole = class\r
- private\r
- FThread : TThread;\r
- public\r
- procedure Write( const S : string);\r
- procedure WriteLine( const S : string);\r
- constructor Create( AThread: TThread);\r
- end;\r
-\r
- TClientThread = class( TThread )\r
- private\r
- FTransport : ITransport;\r
- FProtocol : IProtocol;\r
- FNumIteration : Integer;\r
- FConsole : TThreadConsole;\r
-\r
- // test reporting, will be refactored out into separate class later\r
- FTestGroup : string;\r
- FSuccesses : Integer;\r
- FErrors : TStringList;\r
- procedure StartTestGroup( const aGroup : string);\r
- procedure Expect( aTestResult : Boolean; const aTestInfo : string);\r
- procedure ReportResults;\r
- \r
- procedure ClientTest;\r
- procedure JSONProtocolReadWriteTest;\r
- protected\r
- procedure Execute; override;\r
- public\r
- constructor Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);\r
- destructor Destroy; override;\r
- end;\r
-\r
- TTestClient = class\r
- private\r
- class var\r
- FNumIteration : Integer;\r
- FNumThread : Integer;\r
- public\r
- class procedure Execute( const args: array of string);\r
- end;\r
-\r
-implementation\r
-\r
-function BoolToString( b : Boolean) : string;\r
-// overrides global BoolToString()\r
-begin\r
- if b\r
- then result := 'true'\r
- else result := 'false';\r
-end;\r
-\r
-// not available in all versions, so make sure we have this one imported\r
-function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent';\r
-\r
-{ TTestClient }\r
-\r
-class procedure TTestClient.Execute(const args: array of string);\r
-var\r
- i : Integer;\r
- host : string;\r
- port : Integer;\r
- url : string;\r
- bBuffered : Boolean;\r
- bFramed : Boolean;\r
- s : string;\r
- n : Integer;\r
- threads : array of TThread;\r
- dtStart : TDateTime;\r
- test : Integer;\r
- thread : TThread;\r
- trans : ITransport;\r
- prot : IProtocol;\r
- streamtrans : IStreamTransport;\r
- http : IHTTPClient;\r
- protType, p : TKnownProtocol;\r
-begin\r
- bBuffered := False;;\r
- bFramed := False;\r
- protType := prot_Binary;\r
- try\r
- host := 'localhost';\r
- port := 9090;\r
- url := '';\r
- i := 0;\r
- try\r
- while ( i < Length(args) ) do\r
- begin\r
- try\r
- if ( args[i] = '-h') then\r
- begin\r
- Inc( i );\r
- s := args[i];\r
- n := Pos( ':', s);\r
- if ( n > 0 ) then\r
- begin\r
- host := Copy( s, 1, n - 1);\r
- port := StrToInt( Copy( s, n + 1, MaxInt));\r
- end else\r
- begin\r
- host := s;\r
- end;\r
- end else\r
- if (args[i] = '-u') then\r
- begin\r
- Inc( i );\r
- url := args[i];\r
- end else\r
- if (args[i] = '-n') then\r
- begin\r
- Inc( i );\r
- FNumIteration := StrToInt( args[i] );\r
- end else\r
- if (args[i] = '-b') then\r
- begin\r
- bBuffered := True;\r
- Console.WriteLine('Using buffered transport');\r
- end else\r
- if (args[i] = '-f' ) or ( args[i] = '-framed') then\r
- begin\r
- bFramed := True;\r
- Console.WriteLine('Using framed transport');\r
- end else\r
- if (args[i] = '-t') then\r
- begin\r
- Inc( i );\r
- FNumThread := StrToInt( args[i] );\r
- end else\r
- if (args[i] = '-prot') then // -prot JSON|binary\r
- begin\r
- Inc( i );\r
- s := args[i];\r
- for p:= Low(TKnownProtocol) to High(TKnownProtocol) do begin\r
- if SameText( s, KNOWN_PROTOCOLS[p]) then begin\r
- protType := p;\r
- Console.WriteLine('Using '+KNOWN_PROTOCOLS[protType]+' protocol');\r
- Break;\r
- end;\r
- end;\r
- end;\r
- finally\r
- Inc( i );\r
- end;\r
- end;\r
- except\r
- on E: Exception do\r
- begin\r
- Console.WriteLine( E.Message );\r
- end;\r
- end;\r
-\r
- SetLength( threads, FNumThread);\r
- dtStart := Now;\r
-\r
- for test := 0 to FNumThread - 1 do\r
- begin\r
- if url = '' then\r
- begin\r
- streamtrans := TSocketImpl.Create( host, port );\r
- trans := streamtrans;\r
- if bBuffered then\r
- begin\r
- trans := TBufferedTransportImpl.Create( streamtrans );\r
- end;\r
-\r
- if bFramed then\r
- begin\r
- trans := TFramedTransportImpl.Create( trans );\r
- end;\r
- end else\r
- begin\r
- http := THTTPClientImpl.Create( url );\r
- trans := http;\r
- end;\r
-\r
- // create protocol instance, default to BinaryProtocol\r
- case protType of\r
- prot_Binary: prot := TBinaryProtocolImpl.Create( trans);\r
- prot_JSON : prot := TJSONProtocolImpl.Create( trans);\r
- else\r
- ASSERT( FALSE); // unhandled case!\r
- prot := TBinaryProtocolImpl.Create( trans); // use default\r
- end;\r
-\r
- thread := TClientThread.Create( trans, prot, FNumIteration);\r
- threads[test] := thread;\r
-{$WARN SYMBOL_DEPRECATED OFF}\r
- thread.Resume;\r
-{$WARN SYMBOL_DEPRECATED ON}\r
- end;\r
-\r
- for test := 0 to FNumThread - 1 do\r
- begin\r
- threads[test].WaitFor;\r
- end;\r
-\r
- for test := 0 to FNumThread - 1 do\r
- begin\r
- threads[test].Free;\r
- end;\r
-\r
- Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));\r
-\r
- except\r
- on E: Exception do\r
- begin\r
- Console.WriteLine( E.Message + ' ST: ' + E.StackTrace );\r
- end;\r
- end;\r
-\r
- Console.WriteLine('');\r
- Console.WriteLine('done!');\r
-end;\r
-\r
-{ TClientThread }\r
-\r
-procedure TClientThread.ClientTest;\r
-var\r
- client : TThriftTest.Iface;\r
- s : string;\r
- i8 : ShortInt;\r
- i32 : Integer;\r
- i64 : Int64;\r
- dub : Double;\r
- o : IXtruct;\r
- o2 : IXtruct2;\r
- i : IXtruct;\r
- i2 : IXtruct2;\r
- mapout : IThriftDictionary<Integer,Integer>;\r
- mapin : IThriftDictionary<Integer,Integer>;\r
- strmapout : IThriftDictionary<string,string>;\r
- strmapin : IThriftDictionary<string,string>;\r
- j : Integer;\r
- first : Boolean;\r
- key : Integer;\r
- strkey : string;\r
- listout : IThriftList<Integer>;\r
- listin : IThriftList<Integer>;\r
- setout : IHashSet<Integer>;\r
- setin : IHashSet<Integer>;\r
- ret : TNumberz;\r
- uid : Int64;\r
- mm : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;\r
- pos : IThriftDictionary<Integer, Integer>;\r
- neg : IThriftDictionary<Integer, Integer>;\r
- m2 : IThriftDictionary<Integer, Integer>;\r
- k2 : Integer;\r
- insane : IInsanity;\r
- truck : IXtruct;\r
- whoa : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;\r
- key64 : Int64;\r
- val : IThriftDictionary<TNumberz, IInsanity>;\r
- k2_2 : TNumberz;\r
- k3 : TNumberz;\r
- v2 : IInsanity;\r
- userMap : IThriftDictionary<TNumberz, Int64>;\r
- xtructs : IThriftList<IXtruct>;\r
- x : IXtruct;\r
- arg0 : ShortInt;\r
- arg1 : Integer;\r
- arg2 : Int64;\r
- arg3 : IThriftDictionary<SmallInt, string>;\r
- arg4 : TNumberz;\r
- arg5 : Int64;\r
- StartTick : Cardinal;\r
- k : Integer;\r
- proc : TThreadProcedure;\r
- hello, goodbye : IXtruct;\r
- crazy : IInsanity;\r
- looney : IInsanity;\r
- first_map : IThriftDictionary<TNumberz, IInsanity>;\r
- second_map : IThriftDictionary<TNumberz, IInsanity>;\r
-\r
-begin\r
- client := TThriftTest.TClient.Create( FProtocol);\r
- FTransport.Open;\r
-\r
- // in-depth exception test\r
- // (1) do we get an exception at all?\r
- // (2) do we get the right exception?\r
- // (3) does the exception contain the expected data?\r
- StartTestGroup( 'testException');\r
- // case 1: exception type declared in IDL at the function call\r
- try\r
- client.testException('Xception');\r
- Expect( FALSE, 'testException(''Xception''): must trow an exception');\r
- except\r
- on e:TXception do begin\r
- Expect( e.ErrorCode = 1001, 'error code');\r
- Expect( e.Message_ = 'Xception', 'error message');\r
- Console.WriteLine( ' = ' + IntToStr(e.ErrorCode) + ', ' + e.Message_ );\r
- end;\r
- on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');\r
- on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');\r
- end;\r
-\r
- // case 2: exception type NOT declared in IDL at the function call\r
- // this will close the connection\r
- try\r
- client.testException('TException');\r
- Expect( FALSE, 'testException(''TException''): must trow an exception');\r
- except\r
- on e:TTransportException do begin\r
- Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get\r
- if FTransport.IsOpen then FTransport.Close;\r
- FTransport.Open; // re-open connection, server has already closed\r
- end;\r
- on e:TException do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');\r
- on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');\r
- end;\r
-\r
- // case 3: no exception\r
- try\r
- client.testException('something');\r
- Expect( TRUE, 'testException(''something''): must not trow an exception');\r
- except\r
- on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');\r
- on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');\r
- end;\r
-\r
-\r
- // simple things\r
- StartTestGroup( 'simple Thrift calls');\r
- client.testVoid();\r
- Expect( TRUE, 'testVoid()'); // success := no exception\r
-\r
- s := client.testString('Test');\r
- Expect( s = 'Test', 'testString(''Test'') = "'+s+'"');\r
-\r
- i8 := client.testByte(1);\r
- Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));\r
-\r
- i32 := client.testI32(-1);\r
- Expect( i32 = -1, 'testI32(-1) = ' + IntToStr(i32));\r
-\r
- Console.WriteLine('testI64(-34359738368)');\r
- i64 := client.testI64(-34359738368);\r
- Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64));\r
-\r
- Console.WriteLine('testDouble(5.325098235)');\r
- dub := client.testDouble(5.325098235);\r
- Expect( abs(dub-5.325098235) < 1e-14, 'testDouble(5.325098235) = ' + FloatToStr( dub));\r
-\r
- // structs\r
- StartTestGroup( 'testStruct');\r
- Console.WriteLine('testStruct({''Zero'', 1, -3, -5})');\r
- o := TXtructImpl.Create;\r
- o.String_thing := 'Zero';\r
- o.Byte_thing := 1;\r
- o.I32_thing := -3;\r
- o.I64_thing := -5;\r
- i := client.testStruct(o);\r
- Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');\r
- Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));\r
- Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));\r
- Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));\r
- Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));\r
- Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));\r
- Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));\r
- Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));\r
-\r
- // nested structs\r
- StartTestGroup( 'testNest');\r
- Console.WriteLine('testNest({1, {''Zero'', 1, -3, -5}, 5})');\r
- o2 := TXtruct2Impl.Create;\r
- o2.Byte_thing := 1;\r
- o2.Struct_thing := o;\r
- o2.I32_thing := 5;\r
- i2 := client.testNest(o2);\r
- i := i2.Struct_thing;\r
- Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');\r
- Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));\r
- Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));\r
- Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));\r
- Expect( i2.Byte_thing = 1, 'i2.Byte_thing = '+IntToStr(i2.Byte_thing));\r
- Expect( i2.I32_thing = 5, 'i2.I32_thing = '+IntToStr(i2.I32_thing));\r
- Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));\r
- Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));\r
- Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));\r
- Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));\r
- Expect( i2.__isset_Byte_thing, 'i2.__isset_Byte_thing');\r
- Expect( i2.__isset_I32_thing, 'i2.__isset_I32_thing');\r
-\r
- // map<type1,type2>: A map of strictly unique keys to values.\r
- // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.\r
- StartTestGroup( 'testMap');\r
- mapout := TThriftDictionaryImpl<Integer,Integer>.Create;\r
- for j := 0 to 4 do\r
- begin\r
- mapout.AddOrSetValue( j, j - 10);\r
- end;\r
- Console.Write('testMap({');\r
- first := True;\r
- for key in mapout.Keys do\r
- begin\r
- if first\r
- then first := False\r
- else Console.Write( ', ' );\r
- Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key]));\r
- end;\r
- Console.WriteLine('})');\r
-\r
- mapin := client.testMap( mapout );\r
- Expect( mapin.Count = mapout.Count, 'testMap: mapin.Count = mapout.Count');\r
- for j := 0 to 4 do\r
- begin\r
- Expect( mapout.ContainsKey(j), 'testMap: mapout.ContainsKey('+IntToStr(j)+') = '+BoolToString(mapout.ContainsKey(j)));\r
- end;\r
- for key in mapin.Keys do\r
- begin\r
- Expect( mapin[key] = mapout[key], 'testMap: '+IntToStr(key) + ' => ' + IntToStr( mapin[key]));\r
- Expect( mapin[key] = key - 10, 'testMap: mapin['+IntToStr(key)+'] = '+IntToStr( mapin[key]));\r
- end;\r
-\r
-\r
- // map<type1,type2>: A map of strictly unique keys to values.\r
- // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.\r
- StartTestGroup( 'testStringMap');\r
- strmapout := TThriftDictionaryImpl<string,string>.Create;\r
- for j := 0 to 4 do\r
- begin\r
- strmapout.AddOrSetValue( IntToStr(j), IntToStr(j - 10));\r
- end;\r
- Console.Write('testStringMap({');\r
- first := True;\r
- for strkey in strmapout.Keys do\r
- begin\r
- if first\r
- then first := False\r
- else Console.Write( ', ' );\r
- Console.Write( strkey + ' => ' + strmapout[strkey]);\r
- end;\r
- Console.WriteLine('})');\r
-\r
- strmapin := client.testStringMap( strmapout );\r
- Expect( strmapin.Count = strmapout.Count, 'testStringMap: strmapin.Count = strmapout.Count');\r
- for j := 0 to 4 do\r
- begin\r
- Expect( strmapout.ContainsKey(IntToStr(j)),\r
- 'testStringMap: strmapout.ContainsKey('+IntToStr(j)+') = '\r
- + BoolToString(strmapout.ContainsKey(IntToStr(j))));\r
- end;\r
- for strkey in strmapin.Keys do\r
- begin\r
- Expect( strmapin[strkey] = strmapout[strkey], 'testStringMap: '+strkey + ' => ' + strmapin[strkey]);\r
- Expect( strmapin[strkey] = IntToStr( StrToInt(strkey) - 10), 'testStringMap: strmapin['+strkey+'] = '+strmapin[strkey]);\r
- end;\r
-\r
-\r
- // set<type>: An unordered set of unique elements.\r
- // Translates to an STL set, Java HashSet, set in Python, etc.\r
- // Note: PHP does not support sets, so it is treated similar to a List\r
- StartTestGroup( 'testSet');\r
- setout := THashSetImpl<Integer>.Create;\r
- for j := -2 to 2 do\r
- begin\r
- setout.Add( j );\r
- end;\r
- Console.Write('testSet({');\r
- first := True;\r
- for j in setout do\r
- begin\r
- if first\r
- then first := False\r
- else Console.Write(', ');\r
- Console.Write(IntToStr( j));\r
- end;\r
- Console.WriteLine('})');\r
-\r
- setin := client.testSet(setout);\r
- Expect( setin.Count = setout.Count, 'testSet: setin.Count = setout.Count');\r
- Expect( setin.Count = 5, 'testSet: setin.Count = '+IntToStr(setin.Count));\r
- for j := -2 to 2 do // unordered, we can't rely on the order => test for known elements only\r
- begin\r
- Expect( setin.Contains(j), 'testSet: setin.Contains('+IntToStr(j)+') => '+BoolToString(setin.Contains(j)));\r
- end;\r
-\r
- // list<type>: An ordered list of elements.\r
- // Translates to an STL vector, Java ArrayList, native arrays in scripting languages, etc.\r
- StartTestGroup( 'testList');\r
- listout := TThriftListImpl<Integer>.Create;\r
- listout.Add( +1);\r
- listout.Add( -2);\r
- listout.Add( +3);\r
- listout.Add( -4);\r
- listout.Add( 0);\r
- Console.Write('testList({');\r
- first := True;\r
- for j in listout do\r
- begin\r
- if first\r
- then first := False\r
- else Console.Write(', ');\r
- Console.Write(IntToStr( j));\r
- end;\r
- Console.WriteLine('})');\r
-\r
- listin := client.testList(listout);\r
- Expect( listin.Count = listout.Count, 'testList: listin.Count = listout.Count');\r
- Expect( listin.Count = 5, 'testList: listin.Count = '+IntToStr(listin.Count));\r
- Expect( listin[0] = +1, 'listin[0] = '+IntToStr( listin[0]));\r
- Expect( listin[1] = -2, 'listin[1] = '+IntToStr( listin[1]));\r
- Expect( listin[2] = +3, 'listin[2] = '+IntToStr( listin[2]));\r
- Expect( listin[3] = -4, 'listin[3] = '+IntToStr( listin[3]));\r
- Expect( listin[4] = 0, 'listin[4] = '+IntToStr( listin[4]));\r
-\r
- // enums\r
- ret := client.testEnum(TNumberz.ONE);\r
- Expect( ret = TNumberz.ONE, 'testEnum(ONE) = '+IntToStr(Ord(ret)));\r
-\r
- ret := client.testEnum(TNumberz.TWO);\r
- Expect( ret = TNumberz.TWO, 'testEnum(TWO) = '+IntToStr(Ord(ret)));\r
-\r
- ret := client.testEnum(TNumberz.THREE);\r
- Expect( ret = TNumberz.THREE, 'testEnum(THREE) = '+IntToStr(Ord(ret)));\r
-\r
- ret := client.testEnum(TNumberz.FIVE);\r
- Expect( ret = TNumberz.FIVE, 'testEnum(FIVE) = '+IntToStr(Ord(ret)));\r
-\r
- ret := client.testEnum(TNumberz.EIGHT);\r
- Expect( ret = TNumberz.EIGHT, 'testEnum(EIGHT) = '+IntToStr(Ord(ret)));\r
-\r
-\r
- // typedef\r
- uid := client.testTypedef(309858235082523);\r
- Expect( uid = 309858235082523, 'testTypedef(309858235082523) = '+IntToStr(uid));\r
-\r
-\r
- // maps of maps\r
- StartTestGroup( 'testMapMap(1)');\r
- mm := client.testMapMap(1);\r
- Console.Write(' = {');\r
- for key in mm.Keys do\r
- begin\r
- Console.Write( IntToStr( key) + ' => {');\r
- m2 := mm[key];\r
- for k2 in m2.Keys do\r
- begin\r
- Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', ');\r
- end;\r
- Console.Write('}, ');\r
- end;\r
- Console.WriteLine('}');\r
-\r
- // verify result data\r
- Expect( mm.Count = 2, 'mm.Count = '+IntToStr(mm.Count));\r
- pos := mm[4];\r
- neg := mm[-4];\r
- for j := 1 to 4 do\r
- begin\r
- Expect( pos[j] = j, 'pos[j] = '+IntToStr(pos[j]));\r
- Expect( neg[-j] = -j, 'neg[-j] = '+IntToStr(neg[-j]));\r
- end;\r
-\r
-\r
-\r
- // insanity\r
- StartTestGroup( 'testInsanity');\r
- insane := TInsanityImpl.Create;\r
- insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;\r
- insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);\r
- truck := TXtructImpl.Create;\r
- truck.String_thing := 'Truck';\r
- truck.Byte_thing := 8;\r
- truck.I32_thing := 8;\r
- truck.I64_thing := 8;\r
- insane.Xtructs := TThriftListImpl<IXtruct>.Create;\r
- insane.Xtructs.Add( truck );\r
- whoa := client.testInsanity( insane );\r
- Console.Write(' = {');\r
- for key64 in whoa.Keys do\r
- begin\r
- val := whoa[key64];\r
- Console.Write( IntToStr( key64) + ' => {');\r
- for k2_2 in val.Keys do\r
- begin\r
- v2 := val[k2_2];\r
- Console.Write( IntToStr( Integer( k2_2)) + ' => {');\r
- userMap := v2.UserMap;\r
- Console.Write('{');\r
- if userMap <> nil then\r
- begin\r
- for k3 in userMap.Keys do\r
- begin\r
- Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', ');\r
- end;\r
- end else\r
- begin\r
- Console.Write('null');\r
- end;\r
- Console.Write('}, ');\r
- xtructs := v2.Xtructs;\r
- Console.Write('{');\r
-\r
- if xtructs <> nil then\r
- begin\r
- for x in xtructs do\r
- begin\r
- Console.Write('{"' + x.String_thing + '", ' +\r
- IntToStr( x.Byte_thing) + ', ' +\r
- IntToStr( x.I32_thing) + ', ' +\r
- IntToStr( x.I32_thing) + '}, ');\r
- end;\r
- end else\r
- begin\r
- Console.Write('null');\r
- end;\r
- Console.Write('}');\r
- Console.Write('}, ');\r
- end;\r
- Console.Write('}, ');\r
- end;\r
- Console.WriteLine('}');\r
-\r
- // verify result data\r
- Expect( whoa.Count = 2, 'whoa.Count = '+IntToStr(whoa.Count));\r
- //\r
- first_map := whoa[1];\r
- second_map := whoa[2];\r
- Expect( first_map.Count = 2, 'first_map.Count = '+IntToStr(first_map.Count));\r
- Expect( second_map.Count = 1, 'second_map.Count = '+IntToStr(second_map.Count));\r
- //\r
- looney := second_map[TNumberz.SIX];\r
- Expect( Assigned(looney), 'Assigned(looney) = '+BoolToString(Assigned(looney)));\r
- Expect( not looney.__isset_UserMap, 'looney.__isset_UserMap = '+BoolToString(looney.__isset_UserMap));\r
- Expect( not looney.__isset_Xtructs, 'looney.__isset_Xtructs = '+BoolToString(looney.__isset_Xtructs));\r
- //\r
- for ret in [TNumberz.TWO, TNumberz.THREE] do begin\r
- crazy := first_map[ret];\r
- Console.WriteLine('first_map['+intToStr(Ord(ret))+']');\r
-\r
- Expect( crazy.__isset_UserMap, 'crazy.__isset_UserMap = '+BoolToString(crazy.__isset_UserMap));\r
- Expect( crazy.__isset_Xtructs, 'crazy.__isset_Xtructs = '+BoolToString(crazy.__isset_Xtructs));\r
-\r
- Expect( crazy.UserMap.Count = 2, 'crazy.UserMap.Count = '+IntToStr(crazy.UserMap.Count));\r
- Expect( crazy.UserMap[TNumberz.FIVE] = 5, 'crazy.UserMap[TNumberz.FIVE] = '+IntToStr(crazy.UserMap[TNumberz.FIVE]));\r
- Expect( crazy.UserMap[TNumberz.EIGHT] = 8, 'crazy.UserMap[TNumberz.EIGHT] = '+IntToStr(crazy.UserMap[TNumberz.EIGHT]));\r
-\r
- Expect( crazy.Xtructs.Count = 2, 'crazy.Xtructs.Count = '+IntToStr(crazy.Xtructs.Count));\r
- goodbye := crazy.Xtructs[0]; // lists are ordered, so we are allowed to assume this order\r
- hello := crazy.Xtructs[1];\r
-\r
- Expect( goodbye.String_thing = 'Goodbye4', 'goodbye.String_thing = "'+goodbye.String_thing+'"');\r
- Expect( goodbye.Byte_thing = 4, 'goodbye.Byte_thing = '+IntToStr(goodbye.Byte_thing));\r
- Expect( goodbye.I32_thing = 4, 'goodbye.I32_thing = '+IntToStr(goodbye.I32_thing));\r
- Expect( goodbye.I64_thing = 4, 'goodbye.I64_thing = '+IntToStr(goodbye.I64_thing));\r
- Expect( goodbye.__isset_String_thing, 'goodbye.__isset_String_thing = '+BoolToString(goodbye.__isset_String_thing));\r
- Expect( goodbye.__isset_Byte_thing, 'goodbye.__isset_Byte_thing = '+BoolToString(goodbye.__isset_Byte_thing));\r
- Expect( goodbye.__isset_I32_thing, 'goodbye.__isset_I32_thing = '+BoolToString(goodbye.__isset_I32_thing));\r
- Expect( goodbye.__isset_I64_thing, 'goodbye.__isset_I64_thing = '+BoolToString(goodbye.__isset_I64_thing));\r
-\r
- Expect( hello.String_thing = 'Hello2', 'hello.String_thing = "'+hello.String_thing+'"');\r
- Expect( hello.Byte_thing = 2, 'hello.Byte_thing = '+IntToStr(hello.Byte_thing));\r
- Expect( hello.I32_thing = 2, 'hello.I32_thing = '+IntToStr(hello.I32_thing));\r
- Expect( hello.I64_thing = 2, 'hello.I64_thing = '+IntToStr(hello.I64_thing));\r
- Expect( hello.__isset_String_thing, 'hello.__isset_String_thing = '+BoolToString(hello.__isset_String_thing));\r
- Expect( hello.__isset_Byte_thing, 'hello.__isset_Byte_thing = '+BoolToString(hello.__isset_Byte_thing));\r
- Expect( hello.__isset_I32_thing, 'hello.__isset_I32_thing = '+BoolToString(hello.__isset_I32_thing));\r
- Expect( hello.__isset_I64_thing, 'hello.__isset_I64_thing = '+BoolToString(hello.__isset_I64_thing));\r
- end;\r
-\r
-\r
- // multi args\r
- StartTestGroup( 'testMulti');\r
- arg0 := 1;\r
- arg1 := 2;\r
- arg2 := High(Int64);\r
- arg3 := TThriftDictionaryImpl<SmallInt, string>.Create;\r
- arg3.AddOrSetValue( 1, 'one');\r
- arg4 := TNumberz.FIVE;\r
- arg5 := 5000000;\r
- Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' +\r
- IntToStr( arg1) + ',' + IntToStr( arg2) + ',' +\r
- arg3.ToString + ',' + IntToStr( Integer( arg4)) + ',' +\r
- IntToStr( arg5) + ')');\r
-\r
- i := client.testMulti( arg0, arg1, arg2, arg3, arg4, arg5);\r
- Expect( i.String_thing = 'Hello2', 'testMulti: i.String_thing = "'+i.String_thing+'"');\r
- Expect( i.Byte_thing = arg0, 'testMulti: i.Byte_thing = '+IntToStr(i.Byte_thing));\r
- Expect( i.I32_thing = arg1, 'testMulti: i.I32_thing = '+IntToStr(i.I32_thing));\r
- Expect( i.I64_thing = arg2, 'testMulti: i.I64_thing = '+IntToStr(i.I64_thing));\r
- Expect( i.__isset_String_thing, 'testMulti: i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));\r
- Expect( i.__isset_Byte_thing, 'testMulti: i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));\r
- Expect( i.__isset_I32_thing, 'testMulti: i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));\r
- Expect( i.__isset_I64_thing, 'testMulti: i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));\r
-\r
- // multi exception\r
- StartTestGroup( 'testMultiException(1)');\r
- try\r
- i := client.testMultiException( 'need more pizza', 'run out of beer');\r
- Expect( i.String_thing = 'run out of beer', 'i.String_thing = "' +i.String_thing+ '"');\r
- Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));\r
- Expect( not i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));\r
- Expect( not i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));\r
- Expect( not i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));\r
- except\r
- on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');\r
- end;\r
-\r
- StartTestGroup( 'testMultiException(Xception)');\r
- try\r
- i := client.testMultiException( 'Xception', 'second test');\r
- Expect( FALSE, 'testMultiException(''Xception''): must trow an exception');\r
- except\r
- on x:TXception do begin\r
- Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));\r
- Expect( x.__isset_Message_, 'x.__isset_Message_ = '+BoolToString(x.__isset_Message_));\r
- Expect( x.ErrorCode = 1001, 'x.ErrorCode = '+IntToStr(x.ErrorCode));\r
- Expect( x.Message_ = 'This is an Xception', 'x.Message = "'+x.Message_+'"');\r
- end;\r
- on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');\r
- end;\r
-\r
- StartTestGroup( 'testMultiException(Xception2)');\r
- try\r
- i := client.testMultiException( 'Xception2', 'third test');\r
- Expect( FALSE, 'testMultiException(''Xception2''): must trow an exception');\r
- except\r
- on x:TXception2 do begin\r
- Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));\r
- Expect( x.__isset_Struct_thing, 'x.__isset_Struct_thing = '+BoolToString(x.__isset_Struct_thing));\r
- Expect( x.ErrorCode = 2002, 'x.ErrorCode = '+IntToStr(x.ErrorCode));\r
- Expect( x.Struct_thing.String_thing = 'This is an Xception2', 'x.Struct_thing.String_thing = "'+x.Struct_thing.String_thing+'"');\r
- Expect( x.Struct_thing.__isset_String_thing, 'x.Struct_thing.__isset_String_thing = '+BoolToString(x.Struct_thing.__isset_String_thing));\r
- Expect( not x.Struct_thing.__isset_Byte_thing, 'x.Struct_thing.__isset_Byte_thing = '+BoolToString(x.Struct_thing.__isset_Byte_thing));\r
- Expect( not x.Struct_thing.__isset_I32_thing, 'x.Struct_thing.__isset_I32_thing = '+BoolToString(x.Struct_thing.__isset_I32_thing));\r
- Expect( not x.Struct_thing.__isset_I64_thing, 'x.Struct_thing.__isset_I64_thing = '+BoolToString(x.Struct_thing.__isset_I64_thing));\r
- end;\r
- on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');\r
- end;\r
-\r
-\r
- // oneway functions\r
- StartTestGroup( 'Test Oneway(1)');\r
- client.testOneway(1);\r
- Expect( TRUE, 'Test Oneway(1)'); // success := no exception\r
-\r
- // call time\r
- StartTestGroup( 'Test Calltime()');\r
- StartTick := GetTIckCount;\r
- for k := 0 to 1000 - 1 do\r
- begin\r
- client.testVoid();\r
- end;\r
- Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' );\r
-\r
- // no more tests here\r
- StartTestGroup( '');\r
-end;\r
-\r
-\r
-procedure TClientThread.JSONProtocolReadWriteTest;\r
-// Tests only then read/write procedures of the JSON protocol\r
-// All tests succeed, if we can read what we wrote before\r
-// Note that passing this test does not imply, that our JSON is really compatible to what\r
-// other clients or servers expect as the real JSON. This is beyond the scope of this test.\r
-var prot : IProtocol;\r
- stm : TStringStream;\r
- list : IList;\r
- binary, binRead : TBytes;\r
- i,iErr : Integer;\r
-const\r
- TEST_SHORT = ShortInt( $FE);\r
- TEST_SMALL = SmallInt( $FEDC);\r
- TEST_LONG = LongInt( $FEDCBA98);\r
- TEST_I64 = Int64( $FEDCBA9876543210);\r
- TEST_DOUBLE = -1.234e-56;\r
- DELTA_DOUBLE = TEST_DOUBLE * 1e-14;\r
- TEST_STRING = 'abc-'#$00E4#$00f6#$00fc; // german umlauts (en-us: "funny chars")\r
-begin\r
- stm := TStringStream.Create;\r
- try\r
- StartTestGroup( 'JsonProtocolTest'); // no more tests here\r
-\r
- // prepare binary data\r
- SetLength( binary, $100);\r
- for i := Low(binary) to High(binary) do binary[i] := i;\r
-\r
- // output setup\r
- prot := TJSONProtocolImpl.Create(\r
- TStreamTransportImpl.Create(\r
- nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));\r
-\r
- // write\r
- prot.WriteListBegin( TListImpl.Create( TType.String_, 9));\r
- prot.WriteBool( TRUE);\r
- prot.WriteBool( FALSE);\r
- prot.WriteByte( TEST_SHORT);\r
- prot.WriteI16( TEST_SMALL);\r
- prot.WriteI32( TEST_LONG);\r
- prot.WriteI64( TEST_I64);\r
- prot.WriteDouble( TEST_DOUBLE);\r
- prot.WriteString( TEST_STRING);\r
- prot.WriteBinary( binary);\r
- prot.WriteListEnd;\r
-\r
- // input setup\r
- Expect( stm.Position = stm.Size, 'Stream position/length after write');\r
- stm.Position := 0;\r
- prot := TJSONProtocolImpl.Create(\r
- TStreamTransportImpl.Create(\r
- TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));\r
-\r
- // read and compare\r
- list := prot.ReadListBegin;\r
- Expect( list.ElementType = TType.String_, 'list element type');\r
- Expect( list.Count = 9, 'list element count');\r
- Expect( prot.ReadBool, 'WriteBool/ReadBool: TRUE');\r
- Expect( not prot.ReadBool, 'WriteBool/ReadBool: FALSE');\r
- Expect( prot.ReadByte = TEST_SHORT, 'WriteByte/ReadByte');\r
- Expect( prot.ReadI16 = TEST_SMALL, 'WriteI16/ReadI16');\r
- Expect( prot.ReadI32 = TEST_LONG, 'WriteI32/ReadI32');\r
- Expect( prot.ReadI64 = TEST_I64, 'WriteI64/ReadI64');\r
- Expect( abs(prot.ReadDouble-TEST_DOUBLE) < abs(DELTA_DOUBLE), 'WriteDouble/ReadDouble');\r
- Expect( prot.ReadString = TEST_STRING, 'WriteString/ReadString');\r
- binRead := prot.ReadBinary;\r
- prot.ReadListEnd;\r
-\r
- // test binary data\r
- Expect( Length(binary) = Length(binRead), 'Binary data length check');\r
- iErr := -1;\r
- for i := Low(binary) to High(binary) do begin\r
- if binary[i] <> binRead[i] then begin\r
- iErr := i;\r
- Break;\r
- end;\r
- end;\r
- if iErr < 0\r
- then Expect( TRUE, 'Binary data check ('+IntToStr(Length(binary))+' Bytes)')\r
- else Expect( FALSE, 'Binary data check at offset '+IntToStr(iErr));\r
-\r
- Expect( stm.Position = stm.Size, 'Stream position after read');\r
-\r
- finally\r
- stm.Free;\r
- prot := nil; //-> Release\r
- StartTestGroup( ''); // no more tests here\r
- end;\r
-end;\r
-\r
-\r
-procedure TClientThread.StartTestGroup( const aGroup : string);\r
-begin\r
- FTestGroup := aGroup;\r
- if FTestGroup <> '' then begin\r
- Console.WriteLine('');\r
- Console.WriteLine( aGroup+' tests');\r
- Console.WriteLine( StringOfChar('-',60));\r
- end;\r
-end;\r
-\r
-\r
-procedure TClientThread.Expect( aTestResult : Boolean; const aTestInfo : string);\r
-begin\r
- if aTestResult then begin\r
- Inc(FSuccesses);\r
- Console.WriteLine( aTestInfo+': passed');\r
- end\r
- else begin\r
- FErrors.Add( FTestGroup+': '+aTestInfo);\r
- Console.WriteLine( aTestInfo+': *** FAILED ***');\r
-\r
- // We have a failed test!\r
- // -> issue DebugBreak ONLY if a debugger is attached,\r
- // -> unhandled DebugBreaks would cause Windows to terminate the app otherwise\r
- if IsDebuggerPresent then asm int 3 end;\r
- end;\r
-end;\r
-\r
-\r
-procedure TClientThread.ReportResults;\r
-var nTotal : Integer;\r
- sLine : string;\r
-begin\r
- // prevent us from stupid DIV/0 errors\r
- nTotal := FSuccesses + FErrors.Count;\r
- if nTotal = 0 then begin\r
- Console.WriteLine('No results logged');\r
- Exit;\r
- end;\r
-\r
- Console.WriteLine('');\r
- Console.WriteLine( StringOfChar('=',60));\r
- Console.WriteLine( IntToStr(nTotal)+' tests performed');\r
- Console.WriteLine( IntToStr(FSuccesses)+' tests succeeded ('+IntToStr(round(100*FSuccesses/nTotal))+'%)');\r
- Console.WriteLine( IntToStr(FErrors.Count)+' tests failed ('+IntToStr(round(100*FErrors.Count/nTotal))+'%)');\r
- Console.WriteLine( StringOfChar('=',60));\r
- if FErrors.Count > 0 then begin\r
- Console.WriteLine('FAILED TESTS:');\r
- for sLine in FErrors do Console.WriteLine('- '+sLine);\r
- Console.WriteLine( StringOfChar('=',60));\r
- InterlockedIncrement( ExitCode); // return <> 0 on errors\r
- end;\r
- Console.WriteLine('');\r
-end;\r
-\r
-\r
-constructor TClientThread.Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);\r
-begin\r
- inherited Create( True );\r
- FNumIteration := ANumIteration;\r
- FTransport := ATransport;\r
- FProtocol := AProtocol;\r
- FConsole := TThreadConsole.Create( Self );\r
-\r
- // error list: keep correct order, allow for duplicates\r
- FErrors := TStringList.Create;\r
- FErrors.Sorted := FALSE;\r
- FErrors.Duplicates := dupAccept;\r
-end;\r
-\r
-destructor TClientThread.Destroy;\r
-begin\r
- FreeAndNil( FConsole);\r
- FreeAndNil( FErrors);\r
- inherited;\r
-end;\r
-\r
-procedure TClientThread.Execute;\r
-var\r
- i : Integer;\r
- proc : TThreadProcedure;\r
-begin\r
- // perform all tests\r
- try\r
- for i := 0 to FNumIteration - 1 do\r
- begin\r
- ClientTest;\r
- JSONProtocolReadWriteTest;\r
- end;\r
- except\r
- on e:Exception do Expect( FALSE, 'unexpected exception: "'+e.message+'"');\r
- end;\r
-\r
- // report the outcome\r
- ReportResults;\r
-\r
- // shutdown\r
- proc := procedure\r
- begin\r
- if FTransport <> nil then\r
- begin\r
- FTransport.Close;\r
- FTransport := nil;\r
- end;\r
- end;\r
-\r
- Synchronize( proc );\r
-end;\r
-\r
-{ TThreadConsole }\r
-\r
-constructor TThreadConsole.Create(AThread: TThread);\r
-begin\r
- FThread := AThread;\r
-end;\r
-\r
-procedure TThreadConsole.Write(const S: string);\r
-var\r
- proc : TThreadProcedure;\r
-begin\r
- proc := procedure\r
- begin\r
- Console.Write( S );\r
- end;\r
- TThread.Synchronize( FThread, proc);\r
-end;\r
-\r
-procedure TThreadConsole.WriteLine(const S: string);\r
-var\r
- proc : TThreadProcedure;\r
-begin\r
- proc := procedure\r
- begin\r
- Console.WriteLine( S );\r
- end;\r
- TThread.Synchronize( FThread, proc);\r
-end;\r
-\r
-initialization\r
-begin\r
- TTestClient.FNumIteration := 1;\r
- TTestClient.FNumThread := 1;\r
-end;\r
-\r
-end.\r
+(*
+ * 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.
Code Review / common / thrift.git / commitdiff
