{ TProtocolUtil }\r
\r
class procedure TProtocolUtil.Skip( prot: IProtocol; type_: TType);\r
-begin\r
+var field : IField;\r
+ map : IMap;\r
+ set_ : ISet;\r
+ list : IList;\r
+ i : Integer;\r
+begin\r
+ case type_ of\r
+ // simple types\r
+ TType.Bool_ : prot.ReadBool();\r
+ TType.Byte_ : prot.ReadByte();\r
+ TType.I16 : prot.ReadI16();\r
+ TType.I32 : prot.ReadI32();\r
+ TType.I64 : prot.ReadI64();\r
+ TType.Double_ : prot.ReadDouble();\r
+ TType.String_ : prot.ReadBinary();// Don't try to decode the string, just skip it.\r
+\r
+ // structured types\r
+ TType.Struct : begin\r
+ prot.ReadStructBegin();\r
+ while TRUE do begin\r
+ field := prot.ReadFieldBegin();\r
+ if (field.Type_ = TType.Stop) then Break;\r
+ Skip(prot, field.Type_);\r
+ prot.ReadFieldEnd();\r
+ end;\r
+ prot.ReadStructEnd();\r
+ end;\r
+\r
+ TType.Map : begin\r
+ map := prot.ReadMapBegin();\r
+ for i := 0 to map.Count-1 do begin\r
+ Skip(prot, map.KeyType);\r
+ Skip(prot, map.ValueType);\r
+ end;\r
+ prot.ReadMapEnd();\r
+ end;\r
\r
+ TType.Set_ : begin\r
+ set_ := prot.ReadSetBegin();\r
+ for i := 0 to set_.Count-1\r
+ do Skip( prot, set_.ElementType);\r
+ prot.ReadSetEnd();\r
+ end;\r
+\r
+ TType.List : begin\r
+ list := prot.ReadListBegin();\r
+ for i := 0 to list.Count-1\r
+ do Skip( prot, list.ElementType);\r
+ prot.ReadListEnd();\r
+ end;\r
+\r
+ else\r
+ ASSERT( FALSE); // any new types?\r
+ end;\r
end;\r
\r
{ TStructImpl }\r
version := VERSION_1 or Cardinal( msg.Type_);\r
WriteI32( Integer( version) );\r
WriteString( msg.Name);\r
- WriteI32( msg.SeqID);\r
+ WriteI32( msg.SeqID);\r
end else\r
begin\r
WriteString( msg.Name);\r
--- /dev/null
+These two projects belong together. Both programs
+simulate server and client for different versions
+of the same protocol.
+
+The intention of this test is to ensure fully
+working compatibilty features of the Delphi Thrift
+implementation.
+
+The expected test result is, that no errors occur
+with both programs, regardless in which order they
+might be started.
--- /dev/null
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+
+
+ // version 1 of the interface
+
+namespace * Skiptest.One
+
+const i32 SKIPTESTSERVICE_VERSION = 1
+
+struct Pong {
+ 1 : optional i32 version1
+}
+
+struct Ping {
+ 1 : optional i32 version1
+}
+
+exception PongFailed {
+ 222 : optional i32 pongErrorCode
+}
+
+
+service SkipTestService {
+ void PingPong( 1: Ping pong) throws (444: PongFailed pof);
+}
+
+
+// EOF
\ No newline at end of file
--- /dev/null
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+
+
+ // version 2 of the interface
+
+namespace * Skiptest.Two
+
+const i32 SKIPTESTSERVICE_VERSION = 2
+
+struct Pong {
+ 1 : optional i32 version1
+ 2 : optional i16 version2
+}
+
+struct Ping {
+ 1 : optional i32 version1
+ 10 : optional bool boolVal
+ 11 : optional byte byteVal
+ 12 : optional double dbVal
+ 13 : optional i16 i16Val
+ 14 : optional i32 i32Val
+ 15 : optional i64 i64Val
+ 16 : optional string strVal
+ 17 : optional Pong structVal
+ 18 : optional map< list< Pong>, set< string>> mapVal
+}
+
+exception PingFailed {
+ 1 : optional i32 pingErrorCode
+}
+
+exception PongFailed {
+ 222 : optional i32 pongErrorCode
+ 10 : optional bool boolVal
+ 11 : optional byte byteVal
+ 12 : optional double dbVal
+ 13 : optional i16 i16Val
+ 14 : optional i32 i32Val
+ 15 : optional i64 i64Val
+ 16 : optional string strVal
+ 17 : optional Pong structVal
+ 18 : optional map< list< Pong>, set< string>> mapVal
+}
+
+
+service SkipTestService {
+ Ping PingPong( 1: Ping ping, 3: Pong pong) throws (1: PingFailed pif, 444: PongFailed pof);
+}
+
+
+// EOF
+
--- /dev/null
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+
+program skiptest_version1;
+
+{$APPTYPE CONSOLE}
+
+uses
+ Classes, Windows, SysUtils,
+ Skiptest.One,
+ Thrift in '..\..\..\lib\delphi\src\Thrift.pas',
+ Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',
+ Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',
+ Thrift.Protocol.JSON in '..\..\..\lib\delphi\src\Thrift.Protocol.JSON.pas',
+ Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',
+ Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',
+ Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',
+ Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas',
+ Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas';
+
+const
+ REQUEST_EXT = '.request';
+ RESPONSE_EXT = '.response';
+
+
+function CreatePing : IPing;
+begin
+ result := TPingImpl.Create;
+ result.Version1 := Skiptest.One.TConstants.SKIPTESTSERVICE_VERSION;
+end;
+
+
+type
+ TDummyServer = class( TInterfacedObject, TSkipTestService.Iface)
+ protected
+ // TSkipTestService.Iface
+ procedure PingPong(const ping: IPing);
+ end;
+
+
+procedure TDummyServer.PingPong(const ping: IPing);
+// TSkipTestService.Iface
+begin
+ Writeln('- performing request from version '+IntToStr(ping.Version1)+' client');
+end;
+
+
+function CreateProtocol( protfact : IProtocolFactory; stm : TStream; aForInput : Boolean) : IProtocol;
+var adapt : IThriftStream;
+ trans : ITransport;
+begin
+ adapt := TThriftStreamAdapterDelphi.Create( stm, FALSE);
+ if aForInput
+ then trans := TStreamTransportImpl.Create( adapt, nil)
+ else trans := TStreamTransportImpl.Create( nil, adapt);
+ result := protfact.GetProtocol( trans);
+end;
+
+
+procedure CreateRequest( protfact : IProtocolFactory; fname : string);
+var stm : TFileStream;
+ ping : IPing;
+ proto : IProtocol;
+ client : TSkipTestService.TClient; // we need access to send/recv_pingpong()
+ cliRef : IUnknown; // holds the refcount
+begin
+ Writeln('- creating new request');
+ stm := TFileStream.Create( fname+REQUEST_EXT+'.tmp', fmCreate);
+ try
+ ping := CreatePing;
+
+ // save request data
+ proto := CreateProtocol( protfact, stm, FALSE);
+ client := TSkipTestService.TClient.Create( nil, proto);
+ cliRef := client as IUnknown;
+ client.send_PingPong( ping);
+
+ finally
+ client := nil; // not Free!
+ cliRef := nil;
+ stm.Free;
+ if client = nil then {warning supressed};
+ end;
+
+ DeleteFile( fname+REQUEST_EXT);
+ RenameFile( fname+REQUEST_EXT+'.tmp', fname+REQUEST_EXT);
+end;
+
+
+procedure ReadResponse( protfact : IProtocolFactory; fname : string);
+var stm : TFileStream;
+ ping : IPing;
+ proto : IProtocol;
+ client : TSkipTestService.TClient; // we need access to send/recv_pingpong()
+ cliRef : IUnknown; // holds the refcount
+begin
+ Writeln('- reading response');
+ stm := TFileStream.Create( fname+RESPONSE_EXT, fmOpenRead);
+ try
+ // save request data
+ proto := CreateProtocol( protfact, stm, TRUE);
+ client := TSkipTestService.TClient.Create( proto, nil);
+ cliRef := client as IUnknown;
+ client.recv_PingPong;
+
+ finally
+ client := nil; // not Free!
+ cliRef := nil;
+ stm.Free;
+ if client = nil then {warning supressed};
+ end;
+end;
+
+
+procedure ProcessFile( protfact : IProtocolFactory; fname : string);
+var stmIn, stmOut : TFileStream;
+ protIn, protOut : IProtocol;
+ server : IProcessor;
+begin
+ Writeln('- processing request');
+ stmOut := nil;
+ stmIn := TFileStream.Create( fname+REQUEST_EXT, fmOpenRead);
+ try
+ stmOut := TFileStream.Create( fname+RESPONSE_EXT+'.tmp', fmCreate);
+
+ // process request and write response data
+ protIn := CreateProtocol( protfact, stmIn, TRUE);
+ protOut := CreateProtocol( protfact, stmOut, FALSE);
+
+ server := TSkipTestService.TProcessorImpl.Create( TDummyServer.Create);
+ server.Process( protIn, protOut);
+
+ finally
+ server := nil; // not Free!
+ stmIn.Free;
+ stmOut.Free;
+ if server = nil then {warning supressed};
+ end;
+
+ DeleteFile( fname+RESPONSE_EXT);
+ RenameFile( fname+RESPONSE_EXT+'.tmp', fname+RESPONSE_EXT);
+end;
+
+
+procedure Test( protfact : IProtocolFactory; fname : string);
+begin
+ // try to read an existing request
+ if FileExists( fname + REQUEST_EXT) then begin
+ ProcessFile( protfact, fname);
+ ReadResponse( protfact, fname);
+ end;
+
+ // create a new request and try to process
+ CreateRequest( protfact, fname);
+ ProcessFile( protfact, fname);
+ ReadResponse( protfact, fname);
+end;
+
+
+const
+ FILE_BINARY = 'pingpong.bin';
+ FILE_JSON = 'pingpong.json';
+begin
+ try
+ Writeln( 'Delphi SkipTest '+IntToStr(TConstants.SKIPTESTSERVICE_VERSION)+' using '+Thrift.Version);
+
+ Writeln;
+ Writeln('Binary protocol');
+ Test( TBinaryProtocolImpl.TFactory.Create, FILE_BINARY);
+
+ Writeln;
+ Writeln('JSON protocol');
+ Test( TJSONProtocolImpl.TFactory.Create, FILE_JSON);
+
+ Writeln;
+ Writeln('Test completed without errors.');
+ Writeln;
+ Write('Press ENTER to close ...'); Readln;
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
+
--- /dev/null
+
\feff <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <PropertyGroup>
+ <ProjectGuid>{EEF476C6-43AE-4CC3-AE51-10C5B35071F1}</ProjectGuid>
+ <MainSource>skiptest_version1.dpr</MainSource>
+ <Basis>True</Basis>
+ <Config Condition="'$(Config)'==''">Debug</Config>
+ <Platform>Win32</Platform>
+ <AppType>Console</AppType>
+ <FrameworkType>None</FrameworkType>
+ <DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
+ <ProjectVersion>12.3</ProjectVersion>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Basis' or '$(Base)'!=''">
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
+ <Cfg_1>true</Cfg_1>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
+ <Cfg_2>true</Cfg_2>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Base)'!=''">
+ <DCC_UnitSearchPath>C:\D\TPCPP\X_ThirdParty\Thrift\wc-XE-all\thrift-testing\gen-delphi;C:\D\TPCPP\X_ThirdParty\Thrift\wc-XE-all\trunk\lib\delphi\src;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
+ <DCC_E>false</DCC_E>
+ <DCC_ImageBase>00400000</DCC_ImageBase>
+ <DCC_UnitAlias>WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;WinTypes=Windows;WinProcs=Windows;$(DCC_UnitAlias)</DCC_UnitAlias>
+ <DCC_F>false</DCC_F>
+ <DCC_S>false</DCC_S>
+ <DCC_N>false</DCC_N>
+ <DCC_K>false</DCC_K>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_1)'!=''">
+ <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
+ <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
+ <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
+ <DCC_DebugInformation>false</DCC_DebugInformation>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_2)'!=''">
+ <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
+ <DCC_Optimize>false</DCC_Optimize>
+ <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
+ </PropertyGroup>
+ <ItemGroup>
+ <DelphiCompile Include="skiptest_version1.dpr">
+ <MainSource>MainSource</MainSource>
+ </DelphiCompile>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Transport.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Protocol.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Protocol.JSON.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Collections.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Server.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Console.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Utils.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Stream.pas"/>
+ <BuildConfiguration Include="Debug">
+ <Key>Cfg_2</Key>
+ <CfgParent>Base</CfgParent>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Basis">
+ <Key>Base</Key>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Release">
+ <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"/>
+ <ProjectExtensions>
+ <Borland.Personality>Delphi.Personality.12</Borland.Personality>
+ <Borland.ProjectType>VCLApplication</Borland.ProjectType>
+ <BorlandProject>
+ <Delphi.Personality>
+ <Source>
+ <Source Name="MainSource">skiptest_version1.dpr</Source>
+ </Source>
+ <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>
+ </Delphi.Personality>
+ <Platforms>
+ <Platform value="Win32">True</Platform>
+ </Platforms>
+ </BorlandProject>
+ <ProjectFileVersion>12</ProjectFileVersion>
+ </ProjectExtensions>
+ </Project>
--- /dev/null
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+
+program skiptest_version2;
+
+{$APPTYPE CONSOLE}
+
+uses
+ Classes, Windows, SysUtils,
+ Skiptest.Two,
+ Thrift in '..\..\..\lib\delphi\src\Thrift.pas',
+ Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',
+ Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',
+ Thrift.Protocol.JSON in '..\..\..\lib\delphi\src\Thrift.Protocol.JSON.pas',
+ Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',
+ Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',
+ Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',
+ Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas',
+ Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas';
+
+const
+ REQUEST_EXT = '.request';
+ RESPONSE_EXT = '.response';
+
+function CreatePing : IPing;
+var list : IThriftList<IPong>;
+ set_ : IHashSet<string>;
+begin
+ result := TPingImpl.Create;
+ result.Version1 := Skiptest.Two.TConstants.SKIPTESTSERVICE_VERSION;
+ result.BoolVal := TRUE;
+ result.ByteVal := 2;
+ result.DbVal := 3;
+ result.I16Val := 4;
+ result.I32Val := 5;
+ result.I64Val := 6;
+ result.StrVal := 'seven';
+
+ result.StructVal := TPongImpl.Create;
+ result.StructVal.Version1 := -1;
+ result.StructVal.Version2 := -2;
+
+ list := TThriftListImpl<IPong>.Create;
+ list.Add( result.StructVal);
+ list.Add( result.StructVal);
+
+ set_ := THashSetImpl<string>.Create;
+ set_.Add( 'one');
+ set_.Add( 'uno');
+ set_.Add( 'eins');
+ set_.Add( 'een');
+
+ result.MapVal := TThriftDictionaryImpl< IThriftList<IPong>, IHashSet<string>>.Create;
+ result.MapVal.Add( list, set_);
+end;
+
+
+type
+ TDummyServer = class( TInterfacedObject, TSkipTestService.Iface)
+ protected
+ // TSkipTestService.Iface
+ function PingPong(const ping: IPing; const pong: IPong): IPing;
+ end;
+
+
+function TDummyServer.PingPong(const ping: IPing; const pong: IPong): IPing;
+// TSkipTestService.Iface
+begin
+ Writeln('- performing request from version '+IntToStr(ping.Version1)+' client');
+ result := CreatePing;
+end;
+
+
+function CreateProtocol( protfact : IProtocolFactory; stm : TStream; aForInput : Boolean) : IProtocol;
+var adapt : IThriftStream;
+ trans : ITransport;
+begin
+ adapt := TThriftStreamAdapterDelphi.Create( stm, FALSE);
+ if aForInput
+ then trans := TStreamTransportImpl.Create( adapt, nil)
+ else trans := TStreamTransportImpl.Create( nil, adapt);
+ result := protfact.GetProtocol( trans);
+end;
+
+
+procedure CreateRequest( protfact : IProtocolFactory; fname : string);
+var stm : TFileStream;
+ ping : IPing;
+ proto : IProtocol;
+ client : TSkipTestService.TClient; // we need access to send/recv_pingpong()
+ cliRef : IUnknown; // holds the refcount
+begin
+ Writeln('- creating new request');
+ stm := TFileStream.Create( fname+REQUEST_EXT+'.tmp', fmCreate);
+ try
+ ping := CreatePing;
+
+ // save request data
+ proto := CreateProtocol( protfact, stm, FALSE);
+ client := TSkipTestService.TClient.Create( nil, proto);
+ cliRef := client as IUnknown;
+ client.send_PingPong( ping, ping.StructVal);
+
+ finally
+ client := nil; // not Free!
+ cliRef := nil;
+ stm.Free;
+ if client = nil then {warning supressed};
+ end;
+
+ DeleteFile( fname+REQUEST_EXT);
+ RenameFile( fname+REQUEST_EXT+'.tmp', fname+REQUEST_EXT);
+end;
+
+
+procedure ReadResponse( protfact : IProtocolFactory; fname : string);
+var stm : TFileStream;
+ ping : IPing;
+ proto : IProtocol;
+ client : TSkipTestService.TClient; // we need access to send/recv_pingpong()
+ cliRef : IUnknown; // holds the refcount
+begin
+ Writeln('- reading response');
+ stm := TFileStream.Create( fname+RESPONSE_EXT, fmOpenRead);
+ try
+ // save request data
+ proto := CreateProtocol( protfact, stm, TRUE);
+ client := TSkipTestService.TClient.Create( proto, nil);
+ cliRef := client as IUnknown;
+ ping := client.recv_PingPong;
+
+ finally
+ client := nil; // not Free!
+ cliRef := nil;
+ stm.Free;
+ if client = nil then {warning supressed};
+ end;
+end;
+
+
+procedure ProcessFile( protfact : IProtocolFactory; fname : string);
+var stmIn, stmOut : TFileStream;
+ protIn, protOut : IProtocol;
+ server : IProcessor;
+begin
+ Writeln('- processing request');
+ stmOut := nil;
+ stmIn := TFileStream.Create( fname+REQUEST_EXT, fmOpenRead);
+ try
+ stmOut := TFileStream.Create( fname+RESPONSE_EXT+'.tmp', fmCreate);
+
+ // process request and write response data
+ protIn := CreateProtocol( protfact, stmIn, TRUE);
+ protOut := CreateProtocol( protfact, stmOut, FALSE);
+
+ server := TSkipTestService.TProcessorImpl.Create( TDummyServer.Create);
+ server.Process( protIn, protOut);
+
+ finally
+ server := nil; // not Free!
+ stmIn.Free;
+ stmOut.Free;
+ if server = nil then {warning supressed};
+ end;
+
+ DeleteFile( fname+RESPONSE_EXT);
+ RenameFile( fname+RESPONSE_EXT+'.tmp', fname+RESPONSE_EXT);
+end;
+
+
+procedure Test( protfact : IProtocolFactory; fname : string);
+begin
+ // try to read an existing request
+ if FileExists( fname + REQUEST_EXT) then begin
+ ProcessFile( protfact, fname);
+ ReadResponse( protfact, fname);
+ end;
+
+ // create a new request and try to process
+ CreateRequest( protfact, fname);
+ ProcessFile( protfact, fname);
+ ReadResponse( protfact, fname);
+end;
+
+
+const
+ FILE_BINARY = 'pingpong.bin';
+ FILE_JSON = 'pingpong.json';
+begin
+ try
+ Writeln( 'Delphi SkipTest '+IntToStr(TConstants.SKIPTESTSERVICE_VERSION)+' using '+Thrift.Version);
+
+ Writeln;
+ Writeln('Binary protocol');
+ Test( TBinaryProtocolImpl.TFactory.Create, FILE_BINARY);
+
+ Writeln;
+ Writeln('JSON protocol');
+ Test( TJSONProtocolImpl.TFactory.Create, FILE_JSON);
+
+ Writeln;
+ Writeln('Test completed without errors.');
+ Writeln;
+ Write('Press ENTER to close ...'); Readln;
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
+
--- /dev/null
+
\feff <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <PropertyGroup>
+ <ProjectGuid>{EEF476C6-43AE-4CC3-AE51-10C5B35071F1}</ProjectGuid>
+ <MainSource>skiptest_version2.dpr</MainSource>
+ <Basis>True</Basis>
+ <Config Condition="'$(Config)'==''">Debug</Config>
+ <Platform>Win32</Platform>
+ <AppType>Console</AppType>
+ <FrameworkType>None</FrameworkType>
+ <DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
+ <ProjectVersion>12.3</ProjectVersion>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Basis' or '$(Base)'!=''">
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
+ <Cfg_1>true</Cfg_1>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
+ <Cfg_2>true</Cfg_2>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Base)'!=''">
+ <DCC_UnitSearchPath>C:\D\TPCPP\X_ThirdParty\Thrift\wc-XE-all\thrift-testing\gen-delphi;C:\D\TPCPP\X_ThirdParty\Thrift\wc-XE-all\trunk\lib\delphi\src;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
+ <DCC_E>false</DCC_E>
+ <DCC_ImageBase>00400000</DCC_ImageBase>
+ <DCC_UnitAlias>WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;WinTypes=Windows;WinProcs=Windows;$(DCC_UnitAlias)</DCC_UnitAlias>
+ <DCC_F>false</DCC_F>
+ <DCC_S>false</DCC_S>
+ <DCC_N>false</DCC_N>
+ <DCC_K>false</DCC_K>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_1)'!=''">
+ <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
+ <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
+ <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
+ <DCC_DebugInformation>false</DCC_DebugInformation>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_2)'!=''">
+ <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
+ <DCC_Optimize>false</DCC_Optimize>
+ <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
+ </PropertyGroup>
+ <ItemGroup>
+ <DelphiCompile Include="skiptest_version2.dpr">
+ <MainSource>MainSource</MainSource>
+ </DelphiCompile>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Transport.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Protocol.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Protocol.JSON.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Collections.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Server.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Console.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Utils.pas"/>
+ <DCCReference Include="..\..\..\lib\delphi\src\Thrift.Stream.pas"/>
+ <BuildConfiguration Include="Debug">
+ <Key>Cfg_2</Key>
+ <CfgParent>Base</CfgParent>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Basis">
+ <Key>Base</Key>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Release">
+ <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"/>
+ <ProjectExtensions>
+ <Borland.Personality>Delphi.Personality.12</Borland.Personality>
+ <Borland.ProjectType>VCLApplication</Borland.ProjectType>
+ <BorlandProject>
+ <Delphi.Personality>
+ <Source>
+ <Source Name="MainSource">skiptest_version2.dpr</Source>
+ </Source>
+ <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>
+ </Delphi.Personality>
+ <Platforms>
+ <Platform value="Win32">True</Platform>
+ </Platforms>
+ </BorlandProject>
+ <ProjectFileVersion>12</ProjectFileVersion>
+ </ProjectExtensions>
+ </Project>
Code Review / common / thrift.git / commitdiff
