You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@thrift.apache.org by je...@apache.org on 2019/11/14 21:19:55 UTC
[thrift] branch master updated: THRIFT-5009 Serializer implemtation
lacks support for layered transports Client: Delphi Patch: Jens Geyer
This is an automated email from the ASF dual-hosted git repository.
jensg pushed a commit to branch master
in repository https://gitbox.apache.org/repos/asf/thrift.git
The following commit(s) were added to refs/heads/master by this push:
new ed99455 THRIFT-5009 Serializer implemtation lacks support for layered transports Client: Delphi Patch: Jens Geyer
ed99455 is described below
commit ed99455e2ec8ec9c8ed95540c63018d395737f30
Author: Jens Geyer <je...@apache.org>
AuthorDate: Sat Nov 9 23:24:52 2019 +0100
THRIFT-5009 Serializer implemtation lacks support for layered transports
Client: Delphi
Patch: Jens Geyer
---
.gitignore | 1 +
lib/delphi/src/Thrift.Serializer.pas | 50 +++-
lib/delphi/src/Thrift.Server.pas | 2 +-
lib/delphi/src/Thrift.Transport.pas | 265 ++++++++++-----------
...TestSerializer.dpr => TestSerializer.Tests.pas} | 145 +++++++----
lib/delphi/test/serializer/TestSerializer.dpr | 228 +-----------------
6 files changed, 273 insertions(+), 418 deletions(-)
diff --git a/.gitignore b/.gitignore
index d10f769..4e2f427 100644
--- a/.gitignore
+++ b/.gitignore
@@ -205,6 +205,7 @@ project.lock.json
/lib/dart/**/pubspec.lock
/lib/delphi/test/skip/*.request
/lib/delphi/test/skip/*.response
+/lib/delphi/test/serializer/*.dat
/lib/delphi/**/*.identcache
/lib/delphi/**/*.local
/lib/delphi/**/*.dcu
diff --git a/lib/delphi/src/Thrift.Serializer.pas b/lib/delphi/src/Thrift.Serializer.pas
index 71b695c..b95cf61 100644
--- a/lib/delphi/src/Thrift.Serializer.pas
+++ b/lib/delphi/src/Thrift.Serializer.pas
@@ -49,6 +49,10 @@ type
// It will use the TProtocol specified by the factory that is passed in.
constructor Create( const factory : IProtocolFactory); overload;
+ // Create a new TSerializer.
+ // It will use the TProtocol and layered transports specified by the factories that are passed in.
+ constructor Create( const protfact : IProtocolFactory; const transfact : ITransportFactory); overload;
+
// DTOR
destructor Destroy; override;
@@ -73,6 +77,10 @@ type
// It will use the TProtocol specified by the factory that is passed in.
constructor Create( const factory : IProtocolFactory); overload;
+ // Create a new TDeserializer.
+ // It will use the TProtocol and layered transports specified by the factories that are passed in.
+ constructor Create( const protfact : IProtocolFactory; const transfact : ITransportFactory); overload;
+
// DTOR
destructor Destroy; override;
@@ -89,24 +97,37 @@ implementation
{ TSerializer }
-constructor TSerializer.Create();
+constructor TSerializer.Create;
// Create a new TSerializer that uses the TBinaryProtocol by default.
begin
//no inherited;
- Create( TBinaryProtocolImpl.TFactory.Create);
+ Create( TBinaryProtocolImpl.TFactory.Create, nil);
end;
constructor TSerializer.Create( const factory : IProtocolFactory);
// Create a new TSerializer.
// It will use the TProtocol specified by the factory that is passed in.
+begin
+ //no inherited;
+ Create( factory, nil);
+end;
+
+
+constructor TSerializer.Create( const protfact : IProtocolFactory; const transfact : ITransportFactory);
+// Create a new TSerializer.
+// It will use the TProtocol specified by the factory that is passed in.
var adapter : IThriftStream;
begin
inherited Create;
FStream := TMemoryStream.Create;
adapter := TThriftStreamAdapterDelphi.Create( FStream, FALSE);
FTransport := TStreamTransportImpl.Create( nil, adapter);
- FProtocol := factory.GetProtocol( FTransport);
+ if transfact <> nil then FTransport := transfact.GetTransport( FTransport);
+ FProtocol := protfact.GetProtocol( FTransport);
+
+ if not FTransport.IsOpen
+ then FTransport.Open;
end;
@@ -131,6 +152,8 @@ begin
try
FStream.Size := 0;
input.Write( FProtocol);
+ FTransport.Flush;
+
SetLength( result, FStream.Size);
iBytes := Length(result);
if iBytes > 0
@@ -150,6 +173,8 @@ begin
try
FStream.Size := 0;
input.Write( FProtocol);
+ FTransport.Flush;
+
aStm.CopyFrom( FStream, COPY_ENTIRE_STREAM);
finally
FStream.Size := 0; // free any allocated memory
@@ -160,24 +185,37 @@ end;
{ TDeserializer }
-constructor TDeserializer.Create();
+constructor TDeserializer.Create;
// Create a new TDeserializer that uses the TBinaryProtocol by default.
begin
//no inherited;
- Create( TBinaryProtocolImpl.TFactory.Create);
+ Create( TBinaryProtocolImpl.TFactory.Create, nil);
end;
constructor TDeserializer.Create( const factory : IProtocolFactory);
// Create a new TDeserializer.
// It will use the TProtocol specified by the factory that is passed in.
+begin
+ //no inherited;
+ Create( factory, nil);
+end;
+
+
+constructor TDeserializer.Create( const protfact : IProtocolFactory; const transfact : ITransportFactory);
+// Create a new TDeserializer.
+// It will use the TProtocol specified by the factory that is passed in.
var adapter : IThriftStream;
begin
inherited Create;
FStream := TMemoryStream.Create;
adapter := TThriftStreamAdapterDelphi.Create( FStream, FALSE);
FTransport := TStreamTransportImpl.Create( adapter, nil);
- FProtocol := factory.GetProtocol( FTransport);
+ if transfact <> nil then FTransport := transfact.GetTransport( FTransport);
+ FProtocol := protfact.GetProtocol( FTransport);
+
+ if not FTransport.IsOpen
+ then FTransport.Open;
end;
diff --git a/lib/delphi/src/Thrift.Server.pas b/lib/delphi/src/Thrift.Server.pas
index c9365c6..654ab99 100644
--- a/lib/delphi/src/Thrift.Server.pas
+++ b/lib/delphi/src/Thrift.Server.pas
@@ -61,7 +61,7 @@ type
public
type
TLogDelegate = reference to procedure( const str: string);
- protected
+ strict protected
FProcessor : IProcessor;
FServerTransport : IServerTransport;
FInputTransportFactory : ITransportFactory;
diff --git a/lib/delphi/src/Thrift.Transport.pas b/lib/delphi/src/Thrift.Transport.pas
index 3067bcd..bede57c 100644
--- a/lib/delphi/src/Thrift.Transport.pas
+++ b/lib/delphi/src/Thrift.Transport.pas
@@ -200,7 +200,7 @@ type
end;
TTransportFactoryImpl = class( TInterfacedObject, ITransportFactory)
- function GetTransport( const ATrans: ITransport): ITransport; virtual;
+ function GetTransport( const aTransport: ITransport): ITransport; virtual;
end;
TTcpSocketStreamImpl = class( TThriftStreamImpl )
@@ -253,17 +253,19 @@ type
function GetInputStream: IThriftStream;
function GetOutputStream: IThriftStream;
- public
- property InputStream : IThriftStream read GetInputStream;
- property OutputStream : IThriftStream read GetOutputStream;
+ protected
procedure Open; override;
procedure Close; override;
procedure Flush; override;
function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override;
procedure Write( const pBuf : Pointer; off, len : Integer); override;
- constructor Create( const AInputStream : IThriftStream; const AOutputStream : IThriftStream);
+ public
+ constructor Create( const aInputStream, aOutputStream : IThriftStream);
destructor Destroy; override;
+
+ property InputStream : IThriftStream read GetInputStream;
+ property OutputStream : IThriftStream read GetOutputStream;
end;
TBufferedStreamImpl = class( TThriftStreamImpl)
@@ -281,7 +283,7 @@ type
function IsOpen: Boolean; override;
function ToArray: TBytes; override;
public
- constructor Create( const AStream: IThriftStream; ABufSize: Integer);
+ constructor Create( const aStream: IThriftStream; const aBufSize : Integer);
destructor Destroy; override;
end;
@@ -300,11 +302,11 @@ type
function Accept( const fnAccepting: TProc) : ITransport; override;
public
{$IFDEF OLD_SOCKETS}
- constructor Create( const AServer: TTcpServer; AClientTimeout: Integer = 0); overload;
- constructor Create( APort: Integer; AClientTimeout: Integer = 0; AUseBufferedSockets: Boolean = FALSE); overload;
+ constructor Create( const aServer: TTcpServer; const aClientTimeout: Integer = 0); overload;
+ constructor Create( const aPort: Integer; const aClientTimeout: Integer = 0; const aUseBufferedSockets: Boolean = FALSE); overload;
{$ELSE}
- constructor Create( const AServer: TServerSocket; AClientTimeout: Longword = 0); overload;
- constructor Create( APort: Integer; AClientTimeout: Longword = 0; AUseBufferedSockets: Boolean = FALSE); overload;
+ constructor Create( const aServer: TServerSocket; const aClientTimeout: Longword = 0); overload;
+ constructor Create( const aPort: Integer; const aClientTimeout: Longword = 0; const aUseBufferedSockets: Boolean = FALSE); overload;
{$ENDIF}
destructor Destroy; override;
procedure Listen; override;
@@ -324,12 +326,17 @@ type
function GetIsOpen: Boolean; override;
procedure Flush; override;
public
+ type
+ TFactory = class( TTransportFactoryImpl )
+ public
+ function GetTransport( const aTransport: ITransport): ITransport; override;
+ end;
+
+ constructor Create( const aTransport : IStreamTransport; const aBufSize: Integer = 1024);
procedure Open(); override;
procedure Close(); override;
function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override;
procedure Write( const pBuf : Pointer; off, len : Integer); override;
- constructor Create( const ATransport : IStreamTransport ); overload;
- constructor Create( const ATransport : IStreamTransport; ABufSize: Integer); overload;
property UnderlyingTransport: ITransport read GetUnderlyingTransport;
property IsOpen: Boolean read GetIsOpen;
end;
@@ -356,11 +363,11 @@ type
public
procedure Open; override;
{$IFDEF OLD_SOCKETS}
- constructor Create( const AClient : TCustomIpClient; aOwnsClient : Boolean; ATimeout: Integer = 0); overload;
- constructor Create( const AHost: string; APort: Integer; ATimeout: Integer = 0); overload;
+ constructor Create( const aClient : TCustomIpClient; const aOwnsClient : Boolean; const aTimeout: Integer = 0); overload;
+ constructor Create( const aHost: string; const aPort: Integer; const aTimeout: Integer = 0); overload;
{$ELSE}
- constructor Create(const AClient: TSocket; aOwnsClient: Boolean); overload;
- constructor Create( const AHost: string; APort: Integer; ATimeout: Longword = 0); overload;
+ constructor Create( const aClient: TSocket; const aOwnsClient: Boolean); overload;
+ constructor Create( const aHost: string; const aPort: Integer; const aTimeout: Longword = 0); overload;
{$ENDIF}
destructor Destroy; override;
procedure Close; override;
@@ -387,16 +394,6 @@ type
procedure InitMaxFrameSize;
procedure InitWriteBuffer;
procedure ReadFrame;
- public
- type
- TFactory = class( TTransportFactoryImpl )
- public
- function GetTransport( const ATrans: ITransport): ITransport; override;
- end;
-
- constructor Create; overload;
- constructor Create( const ATrans: ITransport); overload;
- destructor Destroy; override;
procedure Open(); override;
function GetIsOpen: Boolean; override;
@@ -405,6 +402,15 @@ type
function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override;
procedure Write( const pBuf : Pointer; off, len : Integer); override;
procedure Flush; override;
+ public
+ type
+ TFactory = class( TTransportFactoryImpl )
+ public
+ function GetTransport( const aTransport: ITransport): ITransport; override;
+ end;
+
+ constructor Create( const aTransport: ITransport); overload;
+ destructor Destroy; override;
end;
@@ -412,10 +418,9 @@ const
DEFAULT_THRIFT_TIMEOUT = 5 * 1000; // ms
DEFAULT_THRIFT_SECUREPROTOCOLS = [ TSecureProtocol.TLS_1_1, TSecureProtocol.TLS_1_2];
-
-
implementation
+
{ TTransportImpl }
procedure TTransportImpl.Flush;
@@ -442,18 +447,6 @@ begin
else result := 0;
end;
-procedure TTransportImpl.Write( const buf: TBytes);
-begin
- if Length(buf) > 0
- then Write( @buf[0], 0, Length(buf));
-end;
-
-procedure TTransportImpl.Write( const buf: TBytes; off: Integer; len: Integer);
-begin
- if Length(buf) > 0
- then Write( @buf[0], off, len);
-end;
-
function TTransportImpl.ReadAll(const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
var ret : Integer;
begin
@@ -466,11 +459,24 @@ begin
end;
end;
+procedure TTransportImpl.Write( const buf: TBytes);
+begin
+ if Length(buf) > 0
+ then Write( @buf[0], 0, Length(buf));
+end;
+
+procedure TTransportImpl.Write( const buf: TBytes; off: Integer; len: Integer);
+begin
+ if Length(buf) > 0
+ then Write( @buf[0], off, len);
+end;
+
procedure TTransportImpl.Write( const pBuf : Pointer; len : Integer);
begin
Self.Write( pBuf, 0, len);
end;
+
{ TTransportException }
constructor TTransportException.HiddenCreate(const Msg: string);
@@ -478,17 +484,17 @@ begin
inherited Create(Msg);
end;
-class function TTransportException.Create(AType: TExceptionType): TTransportException;
+class function TTransportException.Create(aType: TExceptionType): TTransportException;
begin
//no inherited;
{$WARN SYMBOL_DEPRECATED OFF}
- Result := Create(AType, '')
+ Result := Create(aType, '')
{$WARN SYMBOL_DEPRECATED DEFAULT}
end;
class function TTransportException.Create(aType: TExceptionType; const msg: string): TTransportException;
begin
- case AType of
+ case aType of
TExceptionType.NotOpen: Result := TTransportExceptionNotOpen.Create(msg);
TExceptionType.AlreadyOpen: Result := TTransportExceptionAlreadyOpen.Create(msg);
TExceptionType.TimedOut: Result := TTransportExceptionTimedOut.Create(msg);
@@ -557,40 +563,44 @@ end;
{ TTransportFactoryImpl }
-function TTransportFactoryImpl.GetTransport( const ATrans: ITransport): ITransport;
+function TTransportFactoryImpl.GetTransport( const aTransport: ITransport): ITransport;
begin
- Result := ATrans;
+ Result := aTransport;
end;
{ TServerSocket }
{$IFDEF OLD_SOCKETS}
-constructor TServerSocketImpl.Create( const AServer: TTcpServer; AClientTimeout: Integer);
-begin
- inherited Create;
- FServer := AServer;
- FClientTimeout := AClientTimeout;
-end;
+constructor TServerSocketImpl.Create( const aServer: TTcpServer; const aClientTimeout : Integer);
{$ELSE}
-constructor TServerSocketImpl.Create( const AServer: TServerSocket; AClientTimeout: Longword);
+constructor TServerSocketImpl.Create( const aServer: TServerSocket; const aClientTimeout: Longword);
+{$ENDIF}
begin
inherited Create;
- FServer := AServer;
- FServer.RecvTimeout := AClientTimeout;
- FServer.SendTimeout := AClientTimeout;
-end;
+ FServer := aServer;
+
+{$IFDEF OLD_SOCKETS}
+ FClientTimeout := aClientTimeout;
+{$ELSE}
+ FServer.RecvTimeout := aClientTimeout;
+ FServer.SendTimeout := aClientTimeout;
{$ENDIF}
+end;
+
{$IFDEF OLD_SOCKETS}
-constructor TServerSocketImpl.Create(APort, AClientTimeout: Integer; AUseBufferedSockets: Boolean);
+constructor TServerSocketImpl.Create( const aPort: Integer; const aClientTimeout: Integer; const aUseBufferedSockets: Boolean);
{$ELSE}
-constructor TServerSocketImpl.Create(APort: Integer; AClientTimeout: Longword; AUseBufferedSockets: Boolean);
+constructor TServerSocketImpl.Create( const aPort: Integer; const aClientTimeout: Longword; const aUseBufferedSockets: Boolean);
{$ENDIF}
begin
inherited Create;
+
{$IFDEF OLD_SOCKETS}
- FPort := APort;
- FClientTimeout := AClientTimeout;
+ FPort := aPort;
+ FClientTimeout := aClientTimeout;
+
+ FOwnsServer := True;
FServer := TTcpServer.Create( nil );
FServer.BlockMode := bmBlocking;
{$IF CompilerVersion >= 21.0}
@@ -599,10 +609,11 @@ begin
FServer.LocalPort := IntToStr( FPort);
{$IFEND}
{$ELSE}
- FServer := TServerSocket.Create(APort, AClientTimeout, AClientTimeout);
-{$ENDIF}
- FUseBufferedSocket := AUseBufferedSockets;
FOwnsServer := True;
+ FServer := TServerSocket.Create(aPort, aClientTimeout, aClientTimeout);
+{$ENDIF}
+
+ FUseBufferedSocket := aUseBufferedSockets;
end;
destructor TServerSocketImpl.Destroy;
@@ -665,7 +676,7 @@ begin
client := FServer.Accept;
try
- trans := TSocketImpl.Create(client, True);
+ trans := TSocketImpl.Create(client, MaxMessageSize, True);
client := nil;
if FUseBufferedSocket then
@@ -714,37 +725,35 @@ end;
{ TSocket }
{$IFDEF OLD_SOCKETS}
-constructor TSocketImpl.Create( const AClient : TCustomIpClient; aOwnsClient : Boolean; ATimeout: Integer = 0);
+constructor TSocketImpl.Create( const aClient : TCustomIpClient; const aOwnsClient : Boolean; const aTimeout: Integer);
+{$ELSE}
+constructor TSocketImpl.Create(const aClient: TSocket; const aOwnsClient: Boolean);
+{$ENDIF}
var stream : IThriftStream;
begin
- FClient := AClient;
- FTimeout := ATimeout;
+ FClient := aClient;
FOwnsClient := aOwnsClient;
+
+{$IFDEF OLD_SOCKETS}
+ FTimeout := aTimeout;
+{$ELSE}
+ FTimeout := aClient.RecvTimeout;
+{$ENDIF}
+
stream := TTcpSocketStreamImpl.Create( FClient, FTimeout);
inherited Create( stream, stream);
end;
-{$ELSE}
-constructor TSocketImpl.Create(const AClient: TSocket; aOwnsClient: Boolean);
-var stream : IThriftStream;
-begin
- FClient := AClient;
- FTimeout := AClient.RecvTimeout;
- FOwnsClient := aOwnsClient;
- stream := TTcpSocketStreamImpl.Create(FClient, FTimeout);
- inherited Create(stream, stream);
-end;
-{$ENDIF}
{$IFDEF OLD_SOCKETS}
-constructor TSocketImpl.Create(const AHost: string; APort, ATimeout: Integer);
+constructor TSocketImpl.Create(const aHost: string; const aPort, aTimeout: Integer);
{$ELSE}
-constructor TSocketImpl.Create(const AHost: string; APort: Integer; ATimeout: Longword);
+constructor TSocketImpl.Create(const aHost: string; const aPort : Integer; const aTimeout: Longword);
{$ENDIF}
begin
inherited Create(nil,nil);
- FHost := AHost;
- FPort := APort;
- FTimeout := ATimeout;
+ FHost := aHost;
+ FPort := aPort;
+ FTimeout := aTimeout;
InitSocket;
end;
@@ -839,11 +848,11 @@ begin
FWriteBuffer := nil;
end;
-constructor TBufferedStreamImpl.Create( const AStream: IThriftStream; ABufSize: Integer);
+constructor TBufferedStreamImpl.Create( const aStream: IThriftStream; const aBufSize : Integer);
begin
inherited Create;
- FStream := AStream;
- FBufSize := ABufSize;
+ FStream := aStream;
+ FBufSize := aBufSize;
FReadBuffer := TMemoryStream.Create;
FWriteBuffer := TMemoryStream.Create;
end;
@@ -918,6 +927,7 @@ begin
end;
end;
+
function TBufferedStreamImpl.ToArray: TBytes;
var len : Integer;
begin
@@ -953,11 +963,11 @@ end;
{ TStreamTransportImpl }
-constructor TStreamTransportImpl.Create( const AInputStream : IThriftStream; const AOutputStream : IThriftStream);
+constructor TStreamTransportImpl.Create( const aInputStream, aOutputStream : IThriftStream);
begin
inherited Create;
- FInputStream := AInputStream;
- FOutputStream := AOutputStream;
+ FInputStream := aInputStream;
+ FOutputStream := aOutputStream;
end;
destructor TStreamTransportImpl.Destroy;
@@ -1004,35 +1014,29 @@ end;
function TStreamTransportImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
begin
- if FInputStream = nil then begin
- raise TTransportExceptionNotOpen.Create('Cannot read from null inputstream' );
- end;
+ if FInputStream = nil
+ then raise TTransportExceptionNotOpen.Create('Cannot read from null inputstream' );
Result := FInputStream.Read( pBuf,buflen, off, len );
end;
procedure TStreamTransportImpl.Write( const pBuf : Pointer; off, len : Integer);
begin
- if FOutputStream = nil then begin
- raise TTransportExceptionNotOpen.Create('Cannot write to null outputstream' );
- end;
+ if FOutputStream = nil
+ then raise TTransportExceptionNotOpen.Create('Cannot write to null outputstream' );
FOutputStream.Write( pBuf, off, len );
end;
-{ TBufferedTransportImpl }
-constructor TBufferedTransportImpl.Create( const ATransport: IStreamTransport);
-begin
- //no inherited;
- Create( ATransport, 1024 );
-end;
+{ TBufferedTransportImpl }
-constructor TBufferedTransportImpl.Create( const ATransport: IStreamTransport; ABufSize: Integer);
+constructor TBufferedTransportImpl.Create( const aTransport : IStreamTransport; const aBufSize: Integer);
begin
+ ASSERT( aTransport <> nil);
inherited Create;
- FTransport := ATransport;
- FBufSize := ABufSize;
+ FTransport := aTransport;
+ FBufSize := aBufSize;
InitBuffers;
end;
@@ -1040,7 +1044,7 @@ procedure TBufferedTransportImpl.Close;
begin
FTransport.Close;
FInputBuffer := nil;
- FOutputBuffer := nil;
+ FOutputBuffer := nil;
end;
procedure TBufferedTransportImpl.Flush;
@@ -1078,10 +1082,9 @@ end;
function TBufferedTransportImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
begin
- Result := 0;
- if FInputBuffer <> nil then begin
- Result := FInputBuffer.Read( pBuf,buflen, off, len );
- end;
+ if FInputBuffer <> nil
+ then Result := FInputBuffer.Read( pBuf,buflen, off, len)
+ else Result := 0;
end;
procedure TBufferedTransportImpl.Write( const pBuf : Pointer; off, len : Integer);
@@ -1091,23 +1094,24 @@ begin
end;
end;
-{ TFramedTransportImpl }
+{ TBufferedTransportImpl.TFactory }
-constructor TFramedTransportImpl.Create;
+function TBufferedTransportImpl.TFactory.GetTransport( const aTransport: ITransport): ITransport;
begin
- inherited Create;
-
- InitMaxFrameSize;
- InitWriteBuffer;
+ Result := TFramedTransportImpl.Create( aTransport);
end;
-constructor TFramedTransportImpl.Create( const ATrans: ITransport);
+
+{ TFramedTransportImpl }
+
+constructor TFramedTransportImpl.Create( const aTransport: ITransport);
begin
+ ASSERT( aTransport <> nil);
inherited Create;
InitMaxFrameSize;
InitWriteBuffer;
- FTransport := ATrans;
+ FTransport := aTransport;
end;
destructor TFramedTransportImpl.Destroy;
@@ -1189,9 +1193,7 @@ begin
if (FReadBuffer <> nil) and (len > 0) then begin
result := FReadBuffer.Read( pTmp^, len);
- if result > 0 then begin
- Exit;
- end;
+ if result > 0 then Exit;
end;
ReadFrame;
@@ -1225,7 +1227,8 @@ begin
SetLength( buff, size );
FTransport.ReadAll( buff, 0, size );
- FReadBuffer.Free;
+
+ FreeAndNil( FReadBuffer);
FReadBuffer := TMemoryStream.Create;
if Length(buff) > 0
then FReadBuffer.Write( Pointer(@buff[0])^, size );
@@ -1243,11 +1246,12 @@ begin
end;
end;
+
{ TFramedTransport.TFactory }
-function TFramedTransportImpl.TFactory.GetTransport( const ATrans: ITransport): ITransport;
+function TFramedTransportImpl.TFactory.GetTransport( const aTransport: ITransport): ITransport;
begin
- Result := TFramedTransportImpl.Create( ATrans );
+ Result := TFramedTransportImpl.Create( aTransport);
end;
{ TTcpSocketStreamImpl }
@@ -1258,17 +1262,17 @@ begin
end;
{$IFDEF OLD_SOCKETS}
-constructor TTcpSocketStreamImpl.Create( const ATcpClient: TCustomIpClient; const aTimeout : Integer);
+constructor TTcpSocketStreamImpl.Create( const aTcpClient: TCustomIpClient; const aTimeout : Integer);
begin
inherited Create;
- FTcpClient := ATcpClient;
+ FTcpClient := aTcpClient;
FTimeout := aTimeout;
end;
{$ELSE}
-constructor TTcpSocketStreamImpl.Create( const ATcpClient: TSocket; const aTimeout : Longword);
+constructor TTcpSocketStreamImpl.Create( const aTcpClient: TSocket; const aTimeout : Longword);
begin
inherited Create;
- FTcpClient := ATcpClient;
+ FTcpClient := aTcpClient;
if aTimeout = 0 then
FTcpClient.RecvTimeout := SLEEP_TIME
else
@@ -1574,12 +1578,5 @@ end;
{$ENDIF}
-{$IF CompilerVersion < 21.0}
-initialization
-begin
- TFramedTransportImpl_Initialize;
-end;
-{$IFEND}
-
end.
diff --git a/lib/delphi/test/serializer/TestSerializer.dpr b/lib/delphi/test/serializer/TestSerializer.Tests.pas
similarity index 62%
copy from lib/delphi/test/serializer/TestSerializer.dpr
copy to lib/delphi/test/serializer/TestSerializer.Tests.pas
index 39752cf..ec8d86d 100644
--- a/lib/delphi/test/serializer/TestSerializer.dpr
+++ b/lib/delphi/test/serializer/TestSerializer.Tests.pas
@@ -1,3 +1,4 @@
+unit TestSerializer.Tests;
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
@@ -17,34 +18,38 @@
* under the License.
*)
-program TestSerializer;
-
-{$APPTYPE CONSOLE}
+interface
uses
Classes,
Windows,
SysUtils,
Generics.Collections,
- Thrift in '..\..\src\Thrift.pas',
- Thrift.Exception in '..\..\src\Thrift.Exception.pas',
- Thrift.Socket in '..\..\src\Thrift.Socket.pas',
- Thrift.Transport in '..\..\src\Thrift.Transport.pas',
- Thrift.Protocol in '..\..\src\Thrift.Protocol.pas',
- Thrift.Protocol.JSON in '..\..\src\Thrift.Protocol.JSON.pas',
- Thrift.Protocol.Compact in '..\..\src\Thrift.Protocol.Compact.pas',
- Thrift.Collections in '..\..\src\Thrift.Collections.pas',
- Thrift.Server in '..\..\src\Thrift.Server.pas',
- Thrift.Utils in '..\..\src\Thrift.Utils.pas',
- Thrift.Serializer in '..\..\src\Thrift.Serializer.pas',
- Thrift.Stream in '..\..\src\Thrift.Stream.pas',
- Thrift.WinHTTP in '..\..\src\Thrift.WinHTTP.pas',
- Thrift.TypeRegistry in '..\..\src\Thrift.TypeRegistry.pas',
+ Thrift,
+ Thrift.Exception,
+ Thrift.Socket,
+ Thrift.Transport,
+ Thrift.Protocol,
+ Thrift.Protocol.JSON,
+ Thrift.Protocol.Compact,
+ Thrift.Collections,
+ Thrift.Server,
+ Thrift.Utils,
+ Thrift.Serializer,
+ Thrift.Stream,
+ Thrift.WinHTTP,
+ Thrift.TypeRegistry,
System_,
DebugProtoTest,
TestSerializer.Data;
+
type
+ TFactoryPair = record
+ prot : IProtocolFactory;
+ trans : ITransportFactory;
+ end;
+
TTestSerializer = class //extends TestCase {
private type
TMethod = (
@@ -53,16 +58,20 @@ type
);
private
- FProtocols : TList< IProtocolFactory>;
+ FProtocols : TList< TFactoryPair>;
+ procedure AddFactoryCombination( const aProto : IProtocolFactory; const aTrans : ITransportFactory);
+ class function UserFriendlyName( const factory : TFactoryPair) : string; overload;
+ class function UserFriendlyName( const method : TMethod) : string; overload;
- class function Serialize(const input : IBase; const factory : IProtocolFactory) : TBytes; overload;
- class procedure Serialize(const input : IBase; const factory : IProtocolFactory; const aStream : TStream); overload;
- class procedure Deserialize( const input : TBytes; const target : IBase; const factory : IProtocolFactory); overload;
- class procedure Deserialize( const input : TStream; const target : IBase; const factory : IProtocolFactory); overload;
+ class function Serialize(const input : IBase; const factory : TFactoryPair) : TBytes; overload;
+ class procedure Serialize(const input : IBase; const factory : TFactoryPair; const aStream : TStream); overload;
+
+ class procedure Deserialize( const input : TBytes; const target : IBase; const factory : TFactoryPair); overload;
+ class procedure Deserialize( const input : TStream; const target : IBase; const factory : TFactoryPair); overload;
procedure Test_Serializer_Deserializer;
- procedure Test_OneOfEach( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream);
- procedure Test_CompactStruct( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream);
+ procedure Test_OneOfEach( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
+ procedure Test_CompactStruct( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
public
constructor Create;
@@ -72,16 +81,27 @@ type
end;
+implementation
+
{ TTestSerializer }
constructor TTestSerializer.Create;
begin
inherited Create;
- FProtocols := TList< IProtocolFactory>.Create;
- FProtocols.Add( TBinaryProtocolImpl.TFactory.Create);
- FProtocols.Add( TCompactProtocolImpl.TFactory.Create);
- FProtocols.Add( TJSONProtocolImpl.TFactory.Create);
+ FProtocols := TList< TFactoryPair>.Create;
+
+ AddFactoryCombination( TBinaryProtocolImpl.TFactory.Create, nil);
+ AddFactoryCombination( TCompactProtocolImpl.TFactory.Create, nil);
+ AddFactoryCombination( TJSONProtocolImpl.TFactory.Create, nil);
+
+ AddFactoryCombination( TBinaryProtocolImpl.TFactory.Create, TFramedTransportImpl.TFactory.Create);
+ AddFactoryCombination( TCompactProtocolImpl.TFactory.Create, TFramedTransportImpl.TFactory.Create);
+ AddFactoryCombination( TJSONProtocolImpl.TFactory.Create, TFramedTransportImpl.TFactory.Create);
+
+ AddFactoryCombination( TBinaryProtocolImpl.TFactory.Create, TBufferedTransportImpl.TFactory.Create);
+ AddFactoryCombination( TCompactProtocolImpl.TFactory.Create, TBufferedTransportImpl.TFactory.Create);
+ AddFactoryCombination( TJSONProtocolImpl.TFactory.Create, TBufferedTransportImpl.TFactory.Create);
end;
@@ -95,7 +115,16 @@ begin
end;
-procedure TTestSerializer.Test_OneOfEach( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream);
+procedure TTestSerializer.AddFactoryCombination( const aProto : IProtocolFactory; const aTrans : ITransportFactory);
+var rec : TFactoryPair;
+begin
+ rec.prot := aProto;
+ rec.trans := aTrans;
+ FProtocols.Add( rec);
+end;
+
+
+procedure TTestSerializer.Test_OneOfEach( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
var tested, correct : IOneOfEach;
bytes : TBytes;
i : Integer;
@@ -154,7 +183,7 @@ begin
end;
-procedure TTestSerializer.Test_CompactStruct( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream);
+procedure TTestSerializer.Test_CompactStruct( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
var tested, correct : ICompactProtoTestStruct;
bytes : TBytes;
begin
@@ -191,19 +220,23 @@ end;
procedure TTestSerializer.Test_Serializer_Deserializer;
-var factory : IProtocolFactory;
+var factory : TFactoryPair;
stream : TFileStream;
method : TMethod;
begin
stream := TFileStream.Create( 'TestSerializer.dat', fmCreate);
try
-
for method in [Low(TMethod)..High(TMethod)] do begin
+ Writeln( UserFriendlyName(method));
+
for factory in FProtocols do begin
+ Writeln('- '+UserFriendlyName(factory));
Test_OneOfEach( method, factory, stream);
Test_CompactStruct( method, factory, stream);
end;
+
+ Writeln;
end;
finally
@@ -212,23 +245,43 @@ begin
end;
+class function TTestSerializer.UserFriendlyName( const factory : TFactoryPair) : string;
+begin
+ result := Copy( (factory.prot as TObject).ClassName, 2, MAXINT);
+
+ if factory.trans <> nil
+ then result := Copy( (factory.trans as TObject).ClassName, 2, MAXINT) +' '+ result;
+
+ result := StringReplace( result, 'Impl', '', [rfReplaceAll]);
+ result := StringReplace( result, 'Transport.TFactory', '', [rfReplaceAll]);
+ result := StringReplace( result, 'Protocol.TFactory', '', [rfReplaceAll]);
+end;
+
+
+class function TTestSerializer.UserFriendlyName( const method : TMethod) : string;
+begin
+ result := EnumUtils<TMethod>.ToString(Ord(method));
+ result := StringReplace( result, 'mt_', '', [rfReplaceAll]);
+end;
+
+
procedure TTestSerializer.RunTests;
begin
try
Test_Serializer_Deserializer;
except
on e:Exception do begin
- Writeln( e.Message);
+ Writeln( e.ClassName+': '+ e.Message);
Write('Hit ENTER to close ... '); Readln;
end;
end;
end;
-class function TTestSerializer.Serialize(const input : IBase; const factory : IProtocolFactory) : TBytes;
+class function TTestSerializer.Serialize(const input : IBase; const factory : TFactoryPair) : TBytes;
var serial : TSerializer;
begin
- serial := TSerializer.Create( factory);
+ serial := TSerializer.Create( factory.prot, factory.trans);
try
result := serial.Serialize( input);
finally
@@ -237,10 +290,10 @@ begin
end;
-class procedure TTestSerializer.Serialize(const input : IBase; const factory : IProtocolFactory; const aStream : TStream);
+class procedure TTestSerializer.Serialize(const input : IBase; const factory : TFactoryPair; const aStream : TStream);
var serial : TSerializer;
begin
- serial := TSerializer.Create( factory);
+ serial := TSerializer.Create( factory.prot, factory.trans);
try
serial.Serialize( input, aStream);
finally
@@ -249,10 +302,10 @@ begin
end;
-class procedure TTestSerializer.Deserialize( const input : TBytes; const target : IBase; const factory : IProtocolFactory);
+class procedure TTestSerializer.Deserialize( const input : TBytes; const target : IBase; const factory : TFactoryPair);
var serial : TDeserializer;
begin
- serial := TDeserializer.Create( factory);
+ serial := TDeserializer.Create( factory.prot, factory.trans);
try
serial.Deserialize( input, target);
finally
@@ -260,10 +313,11 @@ begin
end;
end;
-class procedure TTestSerializer.Deserialize( const input : TStream; const target : IBase; const factory : IProtocolFactory);
+
+class procedure TTestSerializer.Deserialize( const input : TStream; const target : IBase; const factory : TFactoryPair);
var serial : TDeserializer;
begin
- serial := TDeserializer.Create( factory);
+ serial := TDeserializer.Create( factory.prot, factory.trans);
try
serial.Deserialize( input, target);
finally
@@ -272,13 +326,4 @@ begin
end;
-var test : TTestSerializer;
-begin
- test := TTestSerializer.Create;
- try
- test.RunTests;
- finally
- test.Free;
- end;
end.
-
diff --git a/lib/delphi/test/serializer/TestSerializer.dpr b/lib/delphi/test/serializer/TestSerializer.dpr
index 39752cf..bb4cc89 100644
--- a/lib/delphi/test/serializer/TestSerializer.dpr
+++ b/lib/delphi/test/serializer/TestSerializer.dpr
@@ -42,235 +42,9 @@ uses
Thrift.TypeRegistry in '..\..\src\Thrift.TypeRegistry.pas',
System_,
DebugProtoTest,
+ TestSerializer.Tests,
TestSerializer.Data;
-type
- TTestSerializer = class //extends TestCase {
- private type
- TMethod = (
- mt_Bytes,
- mt_Stream
- );
-
- private
- FProtocols : TList< IProtocolFactory>;
-
- class function Serialize(const input : IBase; const factory : IProtocolFactory) : TBytes; overload;
- class procedure Serialize(const input : IBase; const factory : IProtocolFactory; const aStream : TStream); overload;
- class procedure Deserialize( const input : TBytes; const target : IBase; const factory : IProtocolFactory); overload;
- class procedure Deserialize( const input : TStream; const target : IBase; const factory : IProtocolFactory); overload;
-
- procedure Test_Serializer_Deserializer;
- procedure Test_OneOfEach( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream);
- procedure Test_CompactStruct( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream);
-
- public
- constructor Create;
- destructor Destroy; override;
-
- procedure RunTests;
- end;
-
-
-
-{ TTestSerializer }
-
-constructor TTestSerializer.Create;
-begin
- inherited Create;
- FProtocols := TList< IProtocolFactory>.Create;
- FProtocols.Add( TBinaryProtocolImpl.TFactory.Create);
- FProtocols.Add( TCompactProtocolImpl.TFactory.Create);
- FProtocols.Add( TJSONProtocolImpl.TFactory.Create);
-end;
-
-
-destructor TTestSerializer.Destroy;
-begin
- try
- FreeAndNil( FProtocols);
- finally
- inherited Destroy;
- end;
-end;
-
-
-procedure TTestSerializer.Test_OneOfEach( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream);
-var tested, correct : IOneOfEach;
- bytes : TBytes;
- i : Integer;
-begin
- // write
- tested := Fixtures.CreateOneOfEach;
- case method of
- mt_Bytes: bytes := Serialize( tested, factory);
- mt_Stream: begin
- stream.Size := 0;
- Serialize( tested, factory, stream);
- end
- else
- ASSERT( FALSE);
- end;
-
- // init + read
- tested := TOneOfEachImpl.Create;
- case method of
- mt_Bytes: Deserialize( bytes, tested, factory);
- mt_Stream: begin
- stream.Position := 0;
- Deserialize( stream, tested, factory);
- end
- else
- ASSERT( FALSE);
- end;
-
- // check
- correct := Fixtures.CreateOneOfEach;
- ASSERT( tested.Im_true = correct.Im_true);
- ASSERT( tested.Im_false = correct.Im_false);
- ASSERT( tested.A_bite = correct.A_bite);
- ASSERT( tested.Integer16 = correct.Integer16);
- ASSERT( tested.Integer32 = correct.Integer32);
- ASSERT( tested.Integer64 = correct.Integer64);
- ASSERT( Abs( tested.Double_precision - correct.Double_precision) < 1E-12);
- ASSERT( tested.Some_characters = correct.Some_characters);
- ASSERT( tested.Zomg_unicode = correct.Zomg_unicode);
- ASSERT( tested.What_who = correct.What_who);
-
- ASSERT( Length(tested.Base64) = Length(correct.Base64));
- ASSERT( CompareMem( @tested.Base64[0], @correct.Base64[0], Length(correct.Base64)));
-
- ASSERT( tested.Byte_list.Count = correct.Byte_list.Count);
- for i := 0 to tested.Byte_list.Count-1
- do ASSERT( tested.Byte_list[i] = correct.Byte_list[i]);
-
- ASSERT( tested.I16_list.Count = correct.I16_list.Count);
- for i := 0 to tested.I16_list.Count-1
- do ASSERT( tested.I16_list[i] = correct.I16_list[i]);
-
- ASSERT( tested.I64_list.Count = correct.I64_list.Count);
- for i := 0 to tested.I64_list.Count-1
- do ASSERT( tested.I64_list[i] = correct.I64_list[i]);
-end;
-
-
-procedure TTestSerializer.Test_CompactStruct( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream);
-var tested, correct : ICompactProtoTestStruct;
- bytes : TBytes;
-begin
- // write
- tested := Fixtures.CreateCompactProtoTestStruct;
- case method of
- mt_Bytes: bytes := Serialize( tested, factory);
- mt_Stream: begin
- stream.Size := 0;
- Serialize( tested, factory, stream);
- end
- else
- ASSERT( FALSE);
- end;
-
- // init + read
- correct := TCompactProtoTestStructImpl.Create;
- case method of
- mt_Bytes: Deserialize( bytes, tested, factory);
- mt_Stream: begin
- stream.Position := 0;
- Deserialize( stream, tested, factory);
- end
- else
- ASSERT( FALSE);
- end;
-
- // check
- correct := Fixtures.CreateCompactProtoTestStruct;
- ASSERT( correct.Field500 = tested.Field500);
- ASSERT( correct.Field5000 = tested.Field5000);
- ASSERT( correct.Field20000 = tested.Field20000);
-end;
-
-
-procedure TTestSerializer.Test_Serializer_Deserializer;
-var factory : IProtocolFactory;
- stream : TFileStream;
- method : TMethod;
-begin
- stream := TFileStream.Create( 'TestSerializer.dat', fmCreate);
- try
-
- for method in [Low(TMethod)..High(TMethod)] do begin
- for factory in FProtocols do begin
-
- Test_OneOfEach( method, factory, stream);
- Test_CompactStruct( method, factory, stream);
- end;
- end;
-
- finally
- stream.Free;
- end;
-end;
-
-
-procedure TTestSerializer.RunTests;
-begin
- try
- Test_Serializer_Deserializer;
- except
- on e:Exception do begin
- Writeln( e.Message);
- Write('Hit ENTER to close ... '); Readln;
- end;
- end;
-end;
-
-
-class function TTestSerializer.Serialize(const input : IBase; const factory : IProtocolFactory) : TBytes;
-var serial : TSerializer;
-begin
- serial := TSerializer.Create( factory);
- try
- result := serial.Serialize( input);
- finally
- serial.Free;
- end;
-end;
-
-
-class procedure TTestSerializer.Serialize(const input : IBase; const factory : IProtocolFactory; const aStream : TStream);
-var serial : TSerializer;
-begin
- serial := TSerializer.Create( factory);
- try
- serial.Serialize( input, aStream);
- finally
- serial.Free;
- end;
-end;
-
-
-class procedure TTestSerializer.Deserialize( const input : TBytes; const target : IBase; const factory : IProtocolFactory);
-var serial : TDeserializer;
-begin
- serial := TDeserializer.Create( factory);
- try
- serial.Deserialize( input, target);
- finally
- serial.Free;
- end;
-end;
-
-class procedure TTestSerializer.Deserialize( const input : TStream; const target : IBase; const factory : IProtocolFactory);
-var serial : TDeserializer;
-begin
- serial := TDeserializer.Create( factory);
- try
- serial.Deserialize( input, target);
- finally
- serial.Free;
- end;
-end;
-
var test : TTestSerializer;
begin