diff options
author | Jens Geyer <jensg@apache.org> | 2022-09-03 14:50:06 +0200 |
---|---|---|
committer | Jens Geyer <jensg@apache.org> | 2022-09-04 01:36:10 +0200 |
commit | 07f4bb5a4af0fa74dfcbb2af07c8e4a2d889d8c2 (patch) | |
tree | 31ddb44a7ae9cb5e84f5577d919abd5465ddf872 | |
parent | 73f5bd4315bed33b6e3a24b6479305002aebeb24 (diff) | |
download | thrift-07f4bb5a4af0fa74dfcbb2af07c8e4a2d889d8c2.tar.gz |
THRIFT-5620 Option to force usage of COM types to allow for cross-module references
Client: Delphi
Patch: Jens Geyer
-rw-r--r-- | compiler/cpp/src/thrift/generate/t_delphi_generator.cc | 39 | ||||
-rw-r--r-- | lib/delphi/DelphiThrift.groupproj | 18 | ||||
-rw-r--r-- | lib/delphi/src/Thrift.Protocol.pas | 139 | ||||
-rw-r--r-- | lib/delphi/test/serializer/SerializerData.dpr | 82 | ||||
-rw-r--r-- | lib/delphi/test/serializer/SerializerData.dproj | 150 | ||||
-rw-r--r-- | lib/delphi/test/serializer/SerializerData.res | bin | 0 -> 91336 bytes | |||
-rw-r--r-- | lib/delphi/test/serializer/TestSerializer.Data.pas | 19 | ||||
-rw-r--r-- | lib/delphi/test/serializer/TestSerializer.Tests.pas | 73 | ||||
-rw-r--r-- | lib/delphi/test/serializer/TestSerializer.dpr | 3 | ||||
-rw-r--r-- | lib/delphi/test/serializer/TestSerializer.dproj | 5 |
10 files changed, 483 insertions, 45 deletions
diff --git a/compiler/cpp/src/thrift/generate/t_delphi_generator.cc b/compiler/cpp/src/thrift/generate/t_delphi_generator.cc index 4dfddc09b..2d0af119f 100644 --- a/compiler/cpp/src/thrift/generate/t_delphi_generator.cc +++ b/compiler/cpp/src/thrift/generate/t_delphi_generator.cc @@ -73,6 +73,7 @@ public: events_ = false; xmldoc_ = false; async_ = false; + com_types_ = false; for( iter = parsed_options.begin(); iter != parsed_options.end(); ++iter) { if( iter->first.compare("ansistr_binary") == 0) { ansistr_binary_ = true; @@ -86,11 +87,17 @@ public: xmldoc_ = true; } else if( iter->first.compare("async") == 0) { async_ = true; + } else if( iter->first.compare("com_types") == 0) { + com_types_ = true; } else { throw "unknown option delphi:" + iter->first; } } + if(com_types_ && ansistr_binary_) { + throw "com_types and ansistr_binary are mutually exclusive"; + } + out_dir_base_ = "gen-delphi"; escape_.clear(); escape_['\''] = "''"; @@ -417,6 +424,7 @@ private: bool events_; bool xmldoc_; bool async_; + bool com_types_; void indent_up_impl() { ++indent_impl_; }; void indent_down_impl() { --indent_impl_; }; std::string indent_impl() { @@ -804,6 +812,9 @@ void t_delphi_generator::close_generator() { generate_delphi_doc(f_all, program_); f_all << "unit " << unitname << ";" << endl << endl; f_all << "{$WARN SYMBOL_DEPRECATED OFF}" << endl << endl; + if(com_types_) { + f_all << "{$MINENUMSIZE 4}" << endl << endl; + } f_all << "interface" << endl << endl; f_all << "uses" << endl; @@ -831,18 +842,13 @@ void t_delphi_generator::close_generator() { f_all << "const" << endl; indent_up(); - indent(f_all) << "c" << tmp_unit - << "_Option_AnsiStr_Binary = " << (ansistr_binary_ ? "True" : "False") << ";" - << endl; - indent(f_all) << "c" << tmp_unit - << "_Option_Register_Types = " << (register_types_ ? "True" : "False") << ";" - << endl; - indent(f_all) << "c" << tmp_unit - << "_Option_ConstPrefix = " << (constprefix_ ? "True" : "False") << ";" << endl; - indent(f_all) << "c" << tmp_unit << "_Option_Events = " << (events_ ? "True" : "False") - << ";" << endl; - indent(f_all) << "c" << tmp_unit << "_Option_XmlDoc = " << (xmldoc_ ? "True" : "False") - << ";" << endl; + indent(f_all) << "c" << tmp_unit << "_Option_AnsiStr_Binary = " << (ansistr_binary_ ? "True" : "False") << ";" << endl; + indent(f_all) << "c" << tmp_unit << "_Option_Register_Types = " << (register_types_ ? "True" : "False") << ";" << endl; + indent(f_all) << "c" << tmp_unit << "_Option_ConstPrefix = " << (constprefix_ ? "True" : "False") << ";" << endl; + indent(f_all) << "c" << tmp_unit << "_Option_Events = " << (events_ ? "True" : "False") << ";" << endl; + indent(f_all) << "c" << tmp_unit << "_Option_XmlDoc = " << (xmldoc_ ? "True" : "False") << ";" << endl; + indent(f_all) << "c" << tmp_unit << "_Option_Async = " << (async_ ? "True" : "False") << ";" << endl; + indent(f_all) << "c" << tmp_unit << "_Option_COM_types = " << (com_types_ ? "True" : "False") << ";" << endl; indent_down(); f_all << endl; @@ -2697,7 +2703,7 @@ void t_delphi_generator::generate_deserialize_field(ostream& out, if (ansistr_binary_) { out << "ReadAnsiString();"; } else { - out << "ReadBinary();"; + out << (com_types_ ? "ReadBinaryCOM();" : "ReadBinary();"); } } else { out << "ReadString();"; @@ -3236,10 +3242,10 @@ string t_delphi_generator::base_type_name(t_base_type* tbase) { if (ansistr_binary_) { return "System.AnsiString"; } else { - return "SysUtils.TBytes"; + return com_types_ ? "IThriftBytes" : "SysUtils.TBytes"; } } else { - return "System.string"; + return com_types_ ? "System.WideString" : "System.string"; } case t_base_type::TYPE_BOOL: return "System.Boolean"; @@ -4114,4 +4120,5 @@ THRIFT_REGISTER_GENERATOR( " constprefix: Name TConstants classes after IDL to reduce ambiguities\n" " events: Enable and use processing events in the generated code.\n" " xmldoc: Enable XMLDoc comments for Help Insight etc.\n" - " async: Generate IAsync interface to use Parallel Programming Library (XE7+ only).\n") + " async: Generate IAsync interface to use Parallel Programming Library (XE7+ only).\n" + " com_types: Use COM-compatible data types (e.g. WideString).\n") diff --git a/lib/delphi/DelphiThrift.groupproj b/lib/delphi/DelphiThrift.groupproj index 179f68051..3a256dd43 100644 --- a/lib/delphi/DelphiThrift.groupproj +++ b/lib/delphi/DelphiThrift.groupproj @@ -48,6 +48,9 @@ <Projects Include="test\skip\skiptest_version2.dproj"> <Dependencies/> </Projects> + <Projects Include="test\serializer\SerializerData.dproj"> + <Dependencies/> + </Projects> <Projects Include="test\serializer\TestSerializer.dproj"> <Dependencies/> </Projects> @@ -143,6 +146,15 @@ <Target Name="skiptest_version2:Make"> <MSBuild Projects="test\skip\skiptest_version2.dproj" Targets="Make"/> </Target> + <Target Name="SerializerData"> + <MSBuild Projects="test\serializer\SerializerData.dproj"/> + </Target> + <Target Name="SerializerData:Clean"> + <MSBuild Projects="test\serializer\SerializerData.dproj" Targets="Clean"/> + </Target> + <Target Name="SerializerData:Make"> + <MSBuild Projects="test\serializer\SerializerData.dproj" Targets="Make"/> + </Target> <Target Name="TestSerializer"> <MSBuild Projects="test\serializer\TestSerializer.dproj"/> </Target> @@ -162,13 +174,13 @@ <MSBuild Projects="test\typeregistry\TestTypeRegistry.dproj" Targets="Make"/> </Target> <Target Name="Build"> - <CallTarget Targets="DelphiServer;DelphiClient;ReservedKeywords;client;server;Multiplex_Test_Client;Multiplex_Test_Server;skiptest_version1;skiptest_version2;TestSerializer;TestTypeRegistry"/> + <CallTarget Targets="DelphiServer;DelphiClient;ReservedKeywords;client;server;Multiplex_Test_Client;Multiplex_Test_Server;skiptest_version1;skiptest_version2;SerializerData;TestSerializer;TestTypeRegistry"/> </Target> <Target Name="Clean"> - <CallTarget Targets="DelphiServer:Clean;DelphiClient:Clean;ReservedKeywords:Clean;client:Clean;server:Clean;Multiplex_Test_Client:Clean;Multiplex_Test_Server:Clean;skiptest_version1:Clean;skiptest_version2:Clean;TestSerializer:Clean;TestTypeRegistry:Clean"/> + <CallTarget Targets="DelphiServer:Clean;DelphiClient:Clean;ReservedKeywords:Clean;client:Clean;server:Clean;Multiplex_Test_Client:Clean;Multiplex_Test_Server:Clean;skiptest_version1:Clean;skiptest_version2:Clean;SerializerData:Clean;TestSerializer:Clean;TestTypeRegistry:Clean"/> </Target> <Target Name="Make"> - <CallTarget Targets="DelphiServer:Make;DelphiClient:Make;ReservedKeywords:Make;client:Make;server:Make;Multiplex_Test_Client:Make;Multiplex_Test_Server:Make;skiptest_version1:Make;skiptest_version2:Make;TestSerializer:Make;TestTypeRegistry:Make"/> + <CallTarget Targets="DelphiServer:Make;DelphiClient:Make;ReservedKeywords:Make;client:Make;server:Make;Multiplex_Test_Client:Make;Multiplex_Test_Server:Make;skiptest_version1:Make;skiptest_version2:Make;SerializerData:Make;TestSerializer:Make;TestTypeRegistry:Make"/> </Target> <Import Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')" Project="$(BDS)\Bin\CodeGear.Group.Targets"/> </Project> diff --git a/lib/delphi/src/Thrift.Protocol.pas b/lib/delphi/src/Thrift.Protocol.pas index 03cc37182..9f2cac8d1 100644 --- a/lib/delphi/src/Thrift.Protocol.pas +++ b/lib/delphi/src/Thrift.Protocol.pas @@ -193,8 +193,10 @@ type destructor Destroy; override; end; + IThriftBytes = interface; // forward + IProtocol = interface - ['{F0040D99-937F-400D-9932-AF04F665899F}'] + ['{6067A28E-15BF-4C9D-9A6F-D991BB3DCB85}'] function GetTransport: ITransport; procedure WriteMessageBegin( const msg: TThriftMessage); procedure WriteMessageEnd; @@ -217,7 +219,8 @@ type procedure WriteDouble( const d: Double); procedure WriteString( const s: string ); procedure WriteAnsiString( const s: AnsiString); - procedure WriteBinary( const b: TBytes); + procedure WriteBinary( const b: TBytes); overload; + procedure WriteBinary( const b: IThriftBytes); overload; function ReadMessageBegin: TThriftMessage; procedure ReadMessageEnd(); @@ -237,7 +240,8 @@ type function ReadI32: Integer; function ReadI64: Int64; function ReadDouble:Double; - function ReadBinary: TBytes; + function ReadBinary: TBytes; // IMPORTANT: this is NOT safe across module boundaries + function ReadBinaryCOM : IThriftBytes; function ReadString: string; function ReadAnsiString: AnsiString; @@ -292,7 +296,7 @@ type procedure WriteDouble( const d: Double); virtual; abstract; procedure WriteString( const s: string ); virtual; procedure WriteAnsiString( const s: AnsiString); virtual; - procedure WriteBinary( const b: TBytes); virtual; abstract; + procedure WriteBinary( const b: TBytes); overload; virtual; abstract; function ReadMessageBegin: TThriftMessage; virtual; abstract; procedure ReadMessageEnd(); virtual; abstract; @@ -316,6 +320,10 @@ type function ReadString: string; virtual; function ReadAnsiString: AnsiString; virtual; + // provide generic implementation for all derived classes + procedure WriteBinary( const bytes : IThriftBytes); overload; virtual; + function ReadBinaryCOM : IThriftBytes; virtual; + property Transport: ITransport read GetTransport; public @@ -324,8 +332,38 @@ type IBase = interface( ISupportsToString) ['{AFF6CECA-5200-4540-950E-9B89E0C1C00C}'] - procedure Read( const iprot: IProtocol); - procedure Write( const iprot: IProtocol); + procedure Read( const prot: IProtocol); + procedure Write( const prot: IProtocol); + end; + + + IThriftBytes = interface( ISupportsToString) + ['{CDBEF7E8-BEF2-4A0A-983A-F334E3FF0016}'] + function GetCount : Integer; + procedure SetCount(const value : Integer); + + // WARNING: This returns a direct pointer to the underlying data structure + function QueryRawDataPtr : Pointer; + + property Count : Integer read GetCount write SetCount; + end; + + + TThriftBytesImpl = class( TInterfacedObject, IThriftBytes, ISupportsToString) + strict private + FData : TBytes; + + strict protected + function GetCount : Integer; + procedure SetCount(const value : Integer); + function QueryRawDataPtr : Pointer; + + public + constructor Create; overload; + constructor Create( const bytes : TBytes); overload; + constructor Create( var bytes : TBytes; const aTakeOwnership : Boolean = FALSE); overload; + + function ToString : string; override; end; @@ -653,6 +691,95 @@ begin FTrans.CheckReadBytesAvailable( value.Count * nPairSize); end; + +procedure TProtocolImpl.WriteBinary( const bytes : IThriftBytes); +var tmp : TBytes; +begin + SetLength( tmp, bytes.Count); + if Length(tmp) > 0 + then Move( bytes.QueryRawDataPtr^, tmp[0], Length(tmp)); + WriteBinary( tmp); +end; + + +function TProtocolImpl.ReadBinaryCOM : IThriftBytes; +var bytes : TBytes; +begin + bytes := ReadBinary; + result := TThriftBytesImpl.Create(bytes,TRUE); +end; + + +{ TThriftBytesImpl } + +constructor TThriftBytesImpl.Create; +begin + inherited Create; + ASSERT( Length(FData) = 0); +end; + + +constructor TThriftBytesImpl.Create( const bytes : TBytes); +begin + FData := bytes; // copies the data +end; + + +constructor TThriftBytesImpl.Create( var bytes : TBytes; const aTakeOwnership : Boolean); + + procedure SwapPointer( var one, two); + var + pOne : Pointer absolute one; + pTwo : Pointer absolute two; + pTmp : Pointer; + begin + pTmp := pOne; + pOne := pTwo; + pTwo := pTmp; + end; + +begin + inherited Create; + ASSERT( Length(FData) = 0); + + if aTakeOwnership + then SwapPointer( FData, bytes) + else FData := bytes; // copies the data +end; + + +function TThriftBytesImpl.ToString : string; +var sb : TThriftStringBuilder; +begin + sb := TThriftStringBuilder.Create(); + try + sb.Append('Bin: '); + sb.Append( FData); + + result := sb.ToString; + finally + sb.Free; + end; +end; + + +function TThriftBytesImpl.GetCount : Integer; +begin + result := Length(FData); +end; + + +procedure TThriftBytesImpl.SetCount(const value : Integer); +begin + SetLength( FData, value); +end; + + +function TThriftBytesImpl.QueryRawDataPtr : Pointer; +begin + result := FData; +end; + { TProtocolUtil } class procedure TProtocolUtil.Skip( prot: IProtocol; type_: TType); diff --git a/lib/delphi/test/serializer/SerializerData.dpr b/lib/delphi/test/serializer/SerializerData.dpr new file mode 100644 index 000000000..92ed00b00 --- /dev/null +++ b/lib/delphi/test/serializer/SerializerData.dpr @@ -0,0 +1,82 @@ +library SerializerData; +(* + * 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. + *) + +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.Configuration in '..\..\src\Thrift.Configuration.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', + System_ in 'gen-delphi\System_.pas', + SysUtils_ in 'gen-delphi\SysUtils_.pas', + DebugProtoTest in 'gen-delphi\DebugProtoTest.pas', + TestSerializer.Data in 'TestSerializer.Data.pas'; + +{$R *.res} + +function CreateOneOfEach : IOneOfEach; stdcall; +begin + result := Fixtures.CreateOneOfEach; +end; + + +function CreateNesting : INesting; stdcall; +begin + result := Fixtures.CreateNesting; +end; + + +function CreateHolyMoley : IHolyMoley; stdcall; +begin + result := Fixtures.CreateHolyMoley; +end; + + +function CreateCompactProtoTestStruct : ICompactProtoTestStruct; stdcall; +begin + result := Fixtures.CreateCompactProtoTestStruct; +end; + + +exports + CreateOneOfEach, + CreateNesting, + CreateHolyMoley, + CreateCompactProtoTestStruct; + +begin + IsMultiThread := TRUE; + ASSERT( cDebugProtoTest_Option_COM_types); + ASSERT( cSystem__Option_COM_types); +end. diff --git a/lib/delphi/test/serializer/SerializerData.dproj b/lib/delphi/test/serializer/SerializerData.dproj new file mode 100644 index 000000000..cfc27f878 --- /dev/null +++ b/lib/delphi/test/serializer/SerializerData.dproj @@ -0,0 +1,150 @@ +<!-- + 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. +--> + <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> + <PropertyGroup> + <ProjectGuid>{B523D1D7-2C9A-4B39-A6CF-69EF536D5079}</ProjectGuid> + <MainSource>SerializerData.dpr</MainSource> + <ProjectVersion>12.3</ProjectVersion> + <Basis>True</Basis> + <Config Condition="'$(Config)'==''">Debug</Config> + <Platform>Win32</Platform> + <AppType>Library</AppType> + <FrameworkType>None</FrameworkType> + <DCC_DCCCompiler>DCC32</DCC_DCCCompiler> + </PropertyGroup> + <PropertyGroup Condition="'$(Config)'=='Basis' or '$(Base)'!=''"> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''"> + <Cfg_1>true</Cfg_1> + <CfgParent>Base</CfgParent> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''"> + <Cfg_2>true</Cfg_2> + <CfgParent>Base</CfgParent> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="'$(Base)'!=''"> + <DCC_DcuOutput>.\$(Config)\$(Platform)</DCC_DcuOutput> + <DCC_E>false</DCC_E> + <DCC_ImageBase>00400000</DCC_ImageBase> + <DCC_UnitAlias>WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;$(DCC_UnitAlias)</DCC_UnitAlias> + <DCC_ExeOutput>bin\$(Config)\$(Platform)</DCC_ExeOutput> + <DCC_S>false</DCC_S> + <GenDll>true</GenDll> + <DCC_N>false</DCC_N> + <DCC_F>false</DCC_F> + <DCC_K>false</DCC_K> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_1)'!=''"> + <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define> + <DCC_Optimize>false</DCC_Optimize> + <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_2)'!=''"> + <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols> + <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define> + <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo> + <DCC_DebugInformation>false</DCC_DebugInformation> + </PropertyGroup> + <ItemGroup> + <DelphiCompile Include="SerializerData.dpr"> + <MainSource>MainSource</MainSource> + </DelphiCompile> + <DCCReference Include="..\..\src\Thrift.pas"/> + <DCCReference Include="..\..\src\Thrift.Exception.pas"/> + <DCCReference Include="..\..\src\Thrift.Socket.pas"/> + <DCCReference Include="..\..\src\Thrift.Transport.pas"/> + <DCCReference Include="..\..\src\Thrift.Protocol.pas"/> + <DCCReference Include="..\..\src\Thrift.Protocol.JSON.pas"/> + <DCCReference Include="..\..\src\Thrift.Protocol.Compact.pas"/> + <DCCReference Include="..\..\src\Thrift.Collections.pas"/> + <DCCReference Include="..\..\src\Thrift.Configuration.pas"/> + <DCCReference Include="..\..\src\Thrift.Server.pas"/> + <DCCReference Include="..\..\src\Thrift.Utils.pas"/> + <DCCReference Include="..\..\src\Thrift.Serializer.pas"/> + <DCCReference Include="..\..\src\Thrift.Stream.pas"/> + <DCCReference Include="..\..\src\Thrift.WinHTTP.pas"/> + <DCCReference Include="..\..\src\Thrift.TypeRegistry.pas"/> + <DCCReference Include="gen-delphi\System_.pas"/> + <DCCReference Include="gen-delphi\SysUtils_.pas"/> + <DCCReference Include="gen-delphi\DebugProtoTest.pas"/> + <DCCReference Include="TestSerializer.Data.pas"/> + <BuildConfiguration Include="Release"> + <Key>Cfg_2</Key> + <CfgParent>Base</CfgParent> + </BuildConfiguration> + <BuildConfiguration Include="Basis"> + <Key>Base</Key> + </BuildConfiguration> + <BuildConfiguration Include="Debug"> + <Key>Cfg_1</Key> + <CfgParent>Base</CfgParent> + </BuildConfiguration> + </ItemGroup> + <Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/> + <Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/> + <PropertyGroup> + <PreBuildEvent><![CDATA[thrift.exe -r -gen delphi:com_types ..\keywords\ReservedKeywords.thrift +thrift.exe -r -gen delphi:com_types ..\..\..\..\test\DebugProtoTest.thrift]]></PreBuildEvent> + </PropertyGroup> + <ProjectExtensions> + <Borland.Personality>Delphi.Personality.12</Borland.Personality> + <Borland.ProjectType/> + <BorlandProject> + <Delphi.Personality> + <VersionInfo> + <VersionInfo Name="IncludeVerInfo">False</VersionInfo> + <VersionInfo Name="AutoIncBuild">False</VersionInfo> + <VersionInfo Name="MajorVer">1</VersionInfo> + <VersionInfo Name="MinorVer">0</VersionInfo> + <VersionInfo Name="Release">0</VersionInfo> + <VersionInfo Name="Build">0</VersionInfo> + <VersionInfo Name="Debug">False</VersionInfo> + <VersionInfo Name="PreRelease">False</VersionInfo> + <VersionInfo Name="Special">False</VersionInfo> + <VersionInfo Name="Private">False</VersionInfo> + <VersionInfo Name="DLL">False</VersionInfo> + <VersionInfo Name="Locale">1031</VersionInfo> + <VersionInfo Name="CodePage">1252</VersionInfo> + </VersionInfo> + <VersionInfoKeys> + <VersionInfoKeys Name="CompanyName"/> + <VersionInfoKeys Name="FileDescription"/> + <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys> + <VersionInfoKeys Name="InternalName"/> + <VersionInfoKeys Name="LegalCopyright"/> + <VersionInfoKeys Name="LegalTrademarks"/> + <VersionInfoKeys Name="OriginalFilename"/> + <VersionInfoKeys Name="ProductName"/> + <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> + <VersionInfoKeys Name="Comments"/> + </VersionInfoKeys> + <Source> + <Source Name="MainSource">SerializerData.dpr</Source> + </Source> + </Delphi.Personality> + <Platforms> + <Platform value="Win32">True</Platform> + </Platforms> + </BorlandProject> + <ProjectFileVersion>12</ProjectFileVersion> + </ProjectExtensions> + </Project> diff --git a/lib/delphi/test/serializer/SerializerData.res b/lib/delphi/test/serializer/SerializerData.res Binary files differnew file mode 100644 index 000000000..231eb70e7 --- /dev/null +++ b/lib/delphi/test/serializer/SerializerData.res diff --git a/lib/delphi/test/serializer/TestSerializer.Data.pas b/lib/delphi/test/serializer/TestSerializer.Data.pas index af366fd7b..4b8cc6696 100644 --- a/lib/delphi/test/serializer/TestSerializer.Data.pas +++ b/lib/delphi/test/serializer/TestSerializer.Data.pas @@ -23,6 +23,7 @@ interface uses SysUtils, + Thrift.Protocol, Thrift.Collections, DebugProtoTest; @@ -194,6 +195,8 @@ begin {$IF cDebugProtoTest_Option_AnsiStr_Binary} result.SetBase64('base64'); + {$ELSEIF cDebugProtoTest_Option_COM_Types} + result.SetBase64( TThriftBytesImpl.Create( TEncoding.UTF8.GetBytes('base64'))); {$ELSE} result.SetBase64( TEncoding.UTF8.GetBytes('base64')); {$IFEND} @@ -216,8 +219,10 @@ end; class function Fixtures.CreateHolyMoley : IHolyMoley; +type + TStringType = {$IF cDebugProtoTest_Option_COM_Types} WideString {$ELSE} String {$IFEND}; var big : IThriftList<IOneOfEach>; - stage1 : IThriftList<String>; + stage1 : IThriftList<TStringType>; stage2 : IThriftList<IBonk>; b : IBonk; begin @@ -230,23 +235,23 @@ begin result.Big[0].setA_bite( $22); result.Big[0].setA_bite( $23); - result.Contain := TThriftHashSetImpl< IThriftList<string>>.Create; - stage1 := TThriftListImpl<String>.Create; + result.Contain := TThriftHashSetImpl< IThriftList<TStringType>>.Create; + stage1 := TThriftListImpl<TStringType>.Create; stage1.add( 'and a one'); stage1.add( 'and a two'); result.Contain.add( stage1); - stage1 := TThriftListImpl<String>.Create; + stage1 := TThriftListImpl<TStringType>.Create; stage1.add( 'then a one, two'); stage1.add( 'three!'); stage1.add( 'FOUR!!'); result.Contain.add( stage1); - stage1 := TThriftListImpl<String>.Create; + stage1 := TThriftListImpl<TStringType>.Create; result.Contain.add( stage1); stage2 := TThriftListImpl<IBonk>.Create; - result.Bonks := TThriftDictionaryImpl< String, IThriftList< IBonk>>.Create; + result.Bonks := TThriftDictionaryImpl< TStringType, IThriftList< IBonk>>.Create; // one empty result.Bonks.Add( 'zero', stage2); @@ -342,6 +347,8 @@ begin {$IF cDebugProtoTest_Option_AnsiStr_Binary} result.A_binary := AnsiString( #0#1#2#3#4#5#6#7#8); + {$ELSEIF cDebugProtoTest_Option_COM_Types} + result.A_binary := TThriftBytesImpl.Create( TEncoding.UTF8.GetBytes( #0#1#2#3#4#5#6#7#8)); {$ELSE} result.A_binary := TEncoding.UTF8.GetBytes( #0#1#2#3#4#5#6#7#8); {$IFEND} diff --git a/lib/delphi/test/serializer/TestSerializer.Tests.pas b/lib/delphi/test/serializer/TestSerializer.Tests.pas index 83d67b1dc..443a22d5f 100644 --- a/lib/delphi/test/serializer/TestSerializer.Tests.pas +++ b/lib/delphi/test/serializer/TestSerializer.Tests.pas @@ -41,8 +41,7 @@ uses Thrift.WinHTTP, Thrift.TypeRegistry, System_, - DebugProtoTest, - TestSerializer.Data; + DebugProtoTest; type @@ -58,7 +57,7 @@ type mt_Stream ); - private + strict private FProtocols : TList< TFactoryPair>; procedure AddFactoryCombination( const aProto : IProtocolFactory; const aTrans : ITransportFactory); class function UserFriendlyName( const factory : TFactoryPair) : string; overload; @@ -73,7 +72,14 @@ type class procedure ValidateReadToEnd( const input : TBytes; const serial : TDeserializer); overload; class procedure ValidateReadToEnd( const input : TStream; const serial : TDeserializer); overload; + class function LengthOf( const bytes : TBytes) : Integer; overload; inline; + class function LengthOf( const bytes : IThriftBytes) : Integer; overload; inline; + + class function DataPtrOf( const bytes : TBytes) : Pointer; overload; inline; + class function DataPtrOf( const bytes : IThriftBytes) : Pointer; overload; inline; + procedure Test_Serializer_Deserializer; + procedure Test_COM_Types; procedure Test_OneOfEach( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream); procedure Test_CompactStruct( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream); @@ -87,6 +93,12 @@ type implementation +const SERIALIZERDATA_DLL = 'SerializerData.dll'; +function CreateOneOfEach : IOneOfEach; stdcall; external SERIALIZERDATA_DLL; +function CreateNesting : INesting; stdcall; external SERIALIZERDATA_DLL; +function CreateHolyMoley : IHolyMoley; stdcall; external SERIALIZERDATA_DLL; +function CreateCompactProtoTestStruct : ICompactProtoTestStruct; stdcall; external SERIALIZERDATA_DLL; + { TTestSerializer } @@ -128,13 +140,41 @@ begin end; +class function TTestSerializer.LengthOf( const bytes : TBytes) : Integer; +begin + result := Length(bytes); +end; + + +class function TTestSerializer.LengthOf( const bytes : IThriftBytes) : Integer; +begin + if bytes <> nil + then result := bytes.Count + else result := 0; +end; + + +class function TTestSerializer.DataPtrOf( const bytes : TBytes) : Pointer; +begin + result := bytes; +end; + + +class function TTestSerializer.DataPtrOf( const bytes : IThriftBytes) : Pointer; +begin + if bytes <> nil + then result := bytes.QueryRawDataPtr + else result := nil; +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; + tested := CreateOneOfEach; case method of mt_Bytes: bytes := Serialize( tested, factory); mt_Stream: begin @@ -158,7 +198,7 @@ begin end; // check - correct := Fixtures.CreateOneOfEach; + correct := CreateOneOfEach; ASSERT( tested.Im_true = correct.Im_true); ASSERT( tested.Im_false = correct.Im_false); ASSERT( tested.A_bite = correct.A_bite); @@ -170,8 +210,8 @@ begin 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( LengthOf(tested.Base64) = LengthOf(correct.Base64)); + ASSERT( CompareMem( DataPtrOf(tested.Base64), DataPtrOf(correct.Base64), LengthOf(correct.Base64))); ASSERT( tested.Byte_list.Count = correct.Byte_list.Count); for i := 0 to tested.Byte_list.Count-1 @@ -192,7 +232,7 @@ var tested, correct : ICompactProtoTestStruct; bytes : TBytes; begin // write - tested := Fixtures.CreateCompactProtoTestStruct; + tested := CreateCompactProtoTestStruct; case method of mt_Bytes: bytes := Serialize( tested, factory); mt_Stream: begin @@ -216,7 +256,7 @@ begin end; // check - correct := Fixtures.CreateCompactProtoTestStruct; + correct := CreateCompactProtoTestStruct; ASSERT( correct.Field500 = tested.Field500); ASSERT( correct.Field5000 = tested.Field5000); ASSERT( correct.Field20000 = tested.Field20000); @@ -269,10 +309,25 @@ begin end; +procedure TTestSerializer.Test_COM_Types; +var tested : IOneOfEach; +begin + {$IF cDebugProtoTest_Option_COM_types} + ASSERT( SizeOf(TSomeEnum) = SizeOf(Int32)); // -> MINENUMSIZE 4 + + // try to set values that allocate memory + tested := CreateOneOfEach; + tested.Zomg_unicode := 'This is a test'; + tested.Base64 := TThriftBytesImpl.Create( TEncoding.UTF8.GetBytes('abc')); + {$IFEND} +end; + + procedure TTestSerializer.RunTests; begin try Test_Serializer_Deserializer; + Test_COM_Types; except on e:Exception do begin Writeln( e.ClassName+': '+ e.Message); diff --git a/lib/delphi/test/serializer/TestSerializer.dpr b/lib/delphi/test/serializer/TestSerializer.dpr index 971401ea1..b78c0db05 100644 --- a/lib/delphi/test/serializer/TestSerializer.dpr +++ b/lib/delphi/test/serializer/TestSerializer.dpr @@ -44,8 +44,7 @@ uses System_ in 'gen-delphi\System_.pas', SysUtils_ in 'gen-delphi\SysUtils_.pas', DebugProtoTest in 'gen-delphi\DebugProtoTest.pas', - TestSerializer.Tests in 'TestSerializer.Tests.pas', - TestSerializer.Data in 'TestSerializer.Data.pas'; + TestSerializer.Tests in 'TestSerializer.Tests.pas'; var test : TTestSerializer; diff --git a/lib/delphi/test/serializer/TestSerializer.dproj b/lib/delphi/test/serializer/TestSerializer.dproj index 5f26264f5..1d98d3a68 100644 --- a/lib/delphi/test/serializer/TestSerializer.dproj +++ b/lib/delphi/test/serializer/TestSerializer.dproj @@ -86,7 +86,6 @@ <DCCReference Include="gen-delphi\SysUtils_.pas"/> <DCCReference Include="gen-delphi\DebugProtoTest.pas"/> <DCCReference Include="TestSerializer.Tests.pas"/> - <DCCReference Include="TestSerializer.Data.pas"/> <BuildConfiguration Include="Debug"> <Key>Cfg_2</Key> <CfgParent>Base</CfgParent> @@ -102,8 +101,8 @@ <Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/> <Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/> <PropertyGroup> - <PreBuildEvent><![CDATA[thrift.exe -r -gen delphi ..\keywords\ReservedKeywords.thrift -thrift.exe -r -gen delphi ..\..\..\..\test\DebugProtoTest.thrift]]></PreBuildEvent> + <PreBuildEvent><![CDATA[thrift.exe -r -gen delphi:com_types ..\keywords\ReservedKeywords.thrift +thrift.exe -r -gen delphi:com_types ..\..\..\..\test\DebugProtoTest.thrift]]></PreBuildEvent> </PropertyGroup> <ProjectExtensions> <Borland.Personality>Delphi.Personality.12</Borland.Personality> |