diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | lib/delphi/src/Thrift.Serializer.pas | 50 | ||||
| -rw-r--r-- | lib/delphi/src/Thrift.Server.pas | 2 | ||||
| -rw-r--r-- | lib/delphi/src/Thrift.Transport.pas | 265 | ||||
| -rw-r--r-- | lib/delphi/test/serializer/TestSerializer.Tests.pas | 329 | ||||
| -rw-r--r-- | lib/delphi/test/serializer/TestSerializer.dpr | 228 |
6 files changed, 507 insertions, 368 deletions
diff --git a/.gitignore b/.gitignore index d10f769cb..4e2f4276d 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 71b695cde..b95cf61da 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 c9365c6db..654ab9942 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 3067bcd76..bede57cd8 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.Tests.pas b/lib/delphi/test/serializer/TestSerializer.Tests.pas new file mode 100644 index 000000000..ec8d86db8 --- /dev/null +++ b/lib/delphi/test/serializer/TestSerializer.Tests.pas @@ -0,0 +1,329 @@ +unit TestSerializer.Tests; +(* + * 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. + *) + +interface + +uses + Classes, + Windows, + SysUtils, + Generics.Collections, + 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 = ( + mt_Bytes, + mt_Stream + ); + + private + 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 : 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 : TFactoryPair; const stream : TFileStream); + procedure Test_CompactStruct( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream); + + public + constructor Create; + destructor Destroy; override; + + procedure RunTests; + end; + + +implementation + + +{ TTestSerializer } + +constructor TTestSerializer.Create; +begin + inherited 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; + + +destructor TTestSerializer.Destroy; +begin + try + FreeAndNil( FProtocols); + finally + inherited Destroy; + end; +end; + + +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; +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 : TFactoryPair; 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 : 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 + stream.Free; + end; +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.ClassName+': '+ e.Message); + Write('Hit ENTER to close ... '); Readln; + end; + end; +end; + + +class function TTestSerializer.Serialize(const input : IBase; const factory : TFactoryPair) : TBytes; +var serial : TSerializer; +begin + serial := TSerializer.Create( factory.prot, factory.trans); + try + result := serial.Serialize( input); + finally + serial.Free; + end; +end; + + +class procedure TTestSerializer.Serialize(const input : IBase; const factory : TFactoryPair; const aStream : TStream); +var serial : TSerializer; +begin + serial := TSerializer.Create( factory.prot, factory.trans); + try + serial.Serialize( input, aStream); + finally + serial.Free; + end; +end; + + +class procedure TTestSerializer.Deserialize( const input : TBytes; const target : IBase; const factory : TFactoryPair); +var serial : TDeserializer; +begin + serial := TDeserializer.Create( factory.prot, factory.trans); + try + serial.Deserialize( input, target); + finally + serial.Free; + end; +end; + + +class procedure TTestSerializer.Deserialize( const input : TStream; const target : IBase; const factory : TFactoryPair); +var serial : TDeserializer; +begin + serial := TDeserializer.Create( factory.prot, factory.trans); + try + serial.Deserialize( input, target); + finally + serial.Free; + end; +end; + + +end. diff --git a/lib/delphi/test/serializer/TestSerializer.dpr b/lib/delphi/test/serializer/TestSerializer.dpr index 39752cf70..bb4cc8926 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 |