THRIFT-5837 Delphi implementation for THRIFT-5835

Client: Delphi
Patch: Jens Geyer

This closes #3068

lib/delphi/test/serializer/SerializerData.dpr

@@ -40,6 +40,8 @@ uses
   Thrift.TypeRegistry in '..\..\src\Thrift.TypeRegistry.pas',
   System_ in 'gen-delphi\System_.pas',
   SysUtils_ in 'gen-delphi\SysUtils_.pas',
+  test.ExceptionStruct in 'gen-delphi\test.ExceptionStruct.pas',
+  test.SimpleException in 'gen-delphi\test.SimpleException.pas',
   DebugProtoTest in 'gen-delphi\DebugProtoTest.pas',
   TestSerializer.Data in 'TestSerializer.Data.pas';
 
@@ -69,11 +71,26 @@ begin
 end;
 
 
+function CreateBatchGetResponse : IBatchGetResponse; stdcall;
+begin
+  result := Fixtures.CreateBatchGetResponse;
+end;
+
+
+function CreateSimpleException : IError; stdcall;
+begin
+  result := Fixtures.CreateSimpleException;
+end;
+
+
 exports
   CreateOneOfEach,
   CreateNesting,
   CreateHolyMoley,
-  CreateCompactProtoTestStruct;
+  CreateCompactProtoTestStruct,
+  CreateBatchGetResponse,
+  CreateSimpleException;
+
 
 begin
   IsMultiThread := TRUE;

lib/delphi/test/serializer/SerializerData.dproj

@@ -1,22 +1,4 @@
-<!--
- 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">
+	<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
 		<PropertyGroup>
 			<ProjectGuid>{B523D1D7-2C9A-4B39-A6CF-69EF536D5079}</ProjectGuid>
 			<MainSource>SerializerData.dpr</MainSource>
@@ -85,6 +67,8 @@
 			<DCCReference Include="..\..\src\Thrift.TypeRegistry.pas"/>
 			<DCCReference Include="gen-delphi\System_.pas"/>
 			<DCCReference Include="gen-delphi\SysUtils_.pas"/>
+			<DCCReference Include="gen-delphi\test.ExceptionStruct.pas"/>
+			<DCCReference Include="gen-delphi\test.SimpleException.pas"/>
 			<DCCReference Include="gen-delphi\DebugProtoTest.pas"/>
 			<DCCReference Include="TestSerializer.Data.pas"/>
 			<BuildConfiguration Include="Release">
@@ -100,10 +84,12 @@
 			</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"/>
+		<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\8.0\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\8.0\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>
+			<PreBuildEvent><![CDATA[thrift.exe -r -gen delphi:com_types,rtti ..\keywords\ReservedKeywords.thrift
+thrift.exe -r -gen delphi:com_types ..\..\..\..\test\DebugProtoTest.thrift
+thrift.exe -r -gen delphi:com_types ..\..\..\..\test\ExceptionStruct.thrift
+thrift.exe -r -gen delphi:com_types SimpleException.thrift]]></PreBuildEvent>
 		</PropertyGroup>
 		<ProjectExtensions>
 			<Borland.Personality>Delphi.Personality.12</Borland.Personality>
@@ -140,6 +126,9 @@ thrift.exe -r -gen delphi:com_types ..\..\..\..\test\DebugProtoTest.thrift]]></P
 					<Source>
 						<Source Name="MainSource">SerializerData.dpr</Source>
 					</Source>
+					<Parameters>
+						<Parameters Name="HostApplication">bin\Debug\Win32\TestSerializer.exe</Parameters>
+					</Parameters>
 				</Delphi.Personality>
 				<Platforms>
 					<Platform value="Win32">True</Platform>

lib/delphi/test/serializer/SimpleException.thrift

@@ -0,0 +1,32 @@
+/*
+ * 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.
+ */
+
+namespace * test.SimpleException
+
+exception Error {
+  1: i32    ErrorCode = 42
+  /** test name collision with Exception class */
+  2: Error  InnerException                  
+  /** test name collisions with Thrift Delphi implementation details */
+  3: uuid   ExceptionData = '00000000-4444-CCCC-ffff-0123456789ab'    
+}
+
+
+
+// EOF

lib/delphi/test/serializer/TestSerializer.Data.pas

@@ -27,6 +27,8 @@ interface
   ComObj,
   Thrift.Protocol,
   Thrift.Collections,
+  test.ExceptionStruct,
+  test.SimpleException,
   DebugProtoTest;
 
 
@@ -37,6 +39,8 @@   Fixtures = class
     class function CreateNesting : INesting;
     class function CreateHolyMoley : IHolyMoley;
     class function CreateCompactProtoTestStruct : ICompactProtoTestStruct;
+    class function CreateBatchGetResponse : IBatchGetResponse;
+    class function CreateSimpleException : IError;
 
   // These byte arrays are serialized versions of the above structs.
   // They were serialized in binary protocol using thrift 0.6.x and are used to
@@ -359,6 +363,51 @@ class function Fixtures.CreateCompactProtoTestStruct : ICompactProtoTestStruct;
 end;
 
 
+class function Fixtures.CreateBatchGetResponse : IBatchGetResponse;
+var
+  data : IGetRequest;
+  error : ISomeException;
+const
+  REQUEST_ID = '123';
+begin
+  data := TGetRequestImpl.Create;
+  data.Id := REQUEST_ID;
+  data.Data := TThriftBytesImpl.Create( TEncoding.UTF8.GetBytes( #0#1#2#3#4#5#6#7#8));
+
+  error := TSomeExceptionImpl.Create;
+  error.Error := TErrorCode.GenericError;
+
+  result := TBatchGetResponseImpl.Create;
+  result.Responses := TThriftDictionaryImpl<WideString, IGetRequest>.Create;
+  result.Responses.Add( REQUEST_ID, data);
+  result.Errors := TThriftDictionaryImpl<WideString, ISomeException>.Create;
+  result.Errors.Add( REQUEST_ID, error);
+end;
+
+
+class function Fixtures.CreateSimpleException : IError;
+var i : Integer;
+    inner : IError;
+    guid : TGuid;
+const
+  IDL_GUID_VALUE : TGuid = '{00000000-4444-CCCC-ffff-0123456789ab}';
+begin
+  result := nil;
+  for i := 0 to 4 do begin
+    inner := result;
+    result := TErrorImpl.Create;
+
+    // validate const values set in IDL
+    ASSERT( result.ErrorCode = 42);  // IDL default value
+    ASSERT( IsEqualGUID( result.ExceptionData, IDL_GUID_VALUE));
+
+    // set fresh, but reproducible values
+    FillChar( guid, SizeOf(guid), i);
+    result.ErrorCode := i;
+    result.ExceptionData := guid;
+    result.InnerException := inner;
+  end;
+end;
 
 
 end.

lib/delphi/test/serializer/TestSerializer.Tests.pas

@@ -41,6 +41,8 @@ interface
   Thrift.WinHTTP,
   Thrift.TypeRegistry,
   System_,
+  test.ExceptionStruct,
+  test.SimpleException,
   DebugProtoTest;
 
 {$TYPEINFO ON}
@@ -82,8 +84,11 @@   TTestSerializer = class //extends TestCase {
     procedure Test_Serializer_Deserializer;
     procedure Test_COM_Types;
     procedure Test_ThriftBytesCTORs;
-    procedure Test_OneOfEach(     const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
-    procedure Test_CompactStruct( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
+
+    procedure Test_OneOfEach(       const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
+    procedure Test_CompactStruct(   const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
+    procedure Test_ExceptionStruct( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
+    procedure Test_SimpleException( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
 
   public
     constructor Create;
@@ -100,6 +105,8 @@ 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;
+function CreateBatchGetResponse : IBatchGetResponse; stdcall; external SERIALIZERDATA_DLL;
+function CreateSimpleException : IError; stdcall; external SERIALIZERDATA_DLL;
 
 
 { TTestSerializer }
@@ -266,6 +273,105 @@ procedure TTestSerializer.Test_CompactStruct( const method : TMethod; const fact
 end;
 
 
+procedure TTestSerializer.Test_ExceptionStruct( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
+var tested, correct : IBatchGetResponse;
+    bytes   : TBytes;
+    corrDP, testDP : TPair<WideString, IGetRequest>;
+    corrEP, testEP : TPair<WideString, ISomeException>;
+begin
+  // write
+  tested := CreateBatchGetResponse;
+  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 := TBatchGetResponseImpl.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 := CreateBatchGetResponse;
+
+  // rewrite the following test if not
+  ASSERT( tested.Responses.Count = 1);
+  ASSERT( correct.Responses.Count = tested.Responses.Count);
+  for corrDP in correct.Responses do begin
+    for testDP in tested.Responses do begin
+      ASSERT( corrDP.Key = testDP.Key);
+      ASSERT( corrDP.Value.Id = testDP.Value.Id);
+      ASSERT( corrDP.Value.Data.Count = testDP.Value.Data.Count);
+    end;
+  end;
+
+  // rewrite the following test if not
+  ASSERT( tested.Errors.Count = 1);
+  ASSERT( correct.Errors.Count = tested.Errors.Count);
+  for corrEP in correct.Errors do begin
+    for testEP in tested.Errors do begin
+      ASSERT( corrEP.Key = testEP.Key);
+      ASSERT( corrEP.Value.Error = testEP.Value.Error);
+    end;
+  end;
+end;
+
+
+procedure TTestSerializer.Test_SimpleException( const method : TMethod; const factory : TFactoryPair; const stream : TFileStream);
+var tested, correct : IError;
+    bytes   : TBytes;
+begin
+  // write
+  tested := CreateSimpleException;
+  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 := TErrorImpl.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 := CreateSimpleException;
+  while correct <> nil do begin
+    // validate
+    ASSERT( correct.ErrorCode = tested.ErrorCode);
+    ASSERT( IsEqualGUID( correct.ExceptionData, tested.ExceptionData));
+
+    // iterate
+    correct := correct.InnerException;
+    tested  := tested.InnerException;
+    ASSERT( (tested <> nil) xor (correct = nil));  // both or none
+  end;
+end;
+
+
 procedure TTestSerializer.Test_Serializer_Deserializer;
 var factory : TFactoryPair;
     stream  : TFileStream;
@@ -279,8 +385,10 @@ procedure TTestSerializer.Test_Serializer_Deserializer;
       for factory in FProtocols do begin
         Writeln('- '+UserFriendlyName(factory));
 
-        Test_OneOfEach(     method, factory, stream);
-        Test_CompactStruct( method, factory, stream);
+        Test_OneOfEach(       method, factory, stream);
+        Test_CompactStruct(   method, factory, stream);
+        Test_ExceptionStruct( method, factory, stream);
+        Test_SimpleException( method, factory, stream);
       end;
 
       Writeln;

lib/delphi/test/serializer/TestSerializer.dpr

@@ -44,6 +44,8 @@ uses
   System_ in 'gen-delphi\System_.pas',
   SysUtils_ in 'gen-delphi\SysUtils_.pas',
   DebugProtoTest in 'gen-delphi\DebugProtoTest.pas',
+  test.ExceptionStruct in 'gen-delphi\test.ExceptionStruct.pas',
+  test.SimpleException in 'gen-delphi\test.SimpleException.pas',
   TestSerializer.Tests in 'TestSerializer.Tests.pas';