Skip to content

Commit

Permalink
THRIFT-5749 Option to enable RTTI info (2nd attempt)
Browse files Browse the repository at this point in the history
Client: Delphi
Patch: Jens Geyer
  • Loading branch information
Jens-G committed Dec 18, 2023
1 parent f1584f5 commit 9d76f28
Show file tree
Hide file tree
Showing 5 changed files with 57 additions and 49 deletions.
18 changes: 11 additions & 7 deletions compiler/cpp/src/thrift/generate/t_delphi_generator.cc
Original file line number Diff line number Diff line change
Expand Up @@ -1672,9 +1672,11 @@ void t_delphi_generator::generate_delphi_struct_definition(ostream& out,
generate_delphi_doc(out, tstruct);
if(rtti_) {
indent(out) << "{$TYPEINFO ON}" << endl;
indent(out) << "{$RTTI INHERIT}" << endl;
indent(out) << "{$RTTI EXPLICIT METHODS([vcPublic, vcPublished]) PROPERTIES([vcPublic, vcPublished])}" << endl;
indent(out) << struct_intf_name << " = interface(IBaseWithTypeInfo)" << endl;
} else {
indent(out) << struct_intf_name << " = interface(IBase)" << endl;
}
indent(out) << struct_intf_name << " = interface(IBase)" << endl;
indent_up();

generate_guid(out);
Expand Down Expand Up @@ -3177,13 +3179,15 @@ string t_delphi_generator::base_type_name(t_base_type* tbase) {
return "";
case t_base_type::TYPE_STRING:
if (tbase->is_binary()) {
if (ansistr_binary_) {
if (ansistr_binary_)
return "System.AnsiString";
} else {
return com_types_ ? "IThriftBytes" : "SysUtils.TBytes";
}
if( com_types_)
return "IThriftBytes";
if( rtti_)
return "Thrift.Protocol.TThriftBytes"; // has TypeInfo
return "SysUtils.TBytes";
} else {
return com_types_ ? "System.WideString" : "System.string";
return com_types_ ? "System.WideString" : "System.UnicodeString";
}
case t_base_type::TYPE_UUID:
return "System.TGuid";
Expand Down
42 changes: 41 additions & 1 deletion lib/delphi/src/Thrift.Protocol.pas
Original file line number Diff line number Diff line change
Expand Up @@ -197,6 +197,17 @@ TProtocolRecursionTrackerImpl = class abstract( TInterfacedObject, IProtocolRe

IThriftBytes = interface; // forward

{$TYPEINFO ON}
TThriftBytes = packed record // can't use SysUtils.TBytes because it has no typinfo -> E2134
data : System.TArray<System.Byte>;

class operator Implicit(aRec : SysUtils.TBytes) : TThriftBytes;
class operator Implicit(aRec : TThriftBytes) : SysUtils.TBytes;
function Length : Integer;
end;
{$IFNDEF TYPEINFO_WAS_ON} {$TYPEINFO OFF} {$ENDIF}


IProtocol = interface
['{6067A28E-15BF-4C9D-9A6F-D991BB3DCB85}']
function GetTransport: ITransport;
Expand Down Expand Up @@ -336,13 +347,18 @@ TProtocolImpl = class abstract( TInterfacedObject, IProtocol)
constructor Create( const aTransport : ITransport); virtual;
end;

{$TYPEINFO ON}
{.$TYPEINFO ON} // big NO -> may cause E2134 due to Delphis stupidity on enums vs TypeInfo
{$RTTI EXPLICIT METHODS([vcPublic, vcPublished]) PROPERTIES([vcPublic, vcPublished])}
IBase = interface( ISupportsToString)
['{AFF6CECA-5200-4540-950E-9B89E0C1C00C}']
procedure Read( const prot: IProtocol);
procedure Write( const prot: IProtocol);
end;

{$TYPEINFO ON}
{$RTTI EXPLICIT METHODS([vcPublic, vcPublished]) PROPERTIES([vcPublic, vcPublished])}
IBaseWithTypeInfo = interface( IBase) end;

{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
{$IFNDEF TYPEINFO_WAS_ON} {$TYPEINFO OFF} {$ENDIF}

Expand Down Expand Up @@ -578,6 +594,30 @@ function ConvertDoubleToInt64( const d: Double): Int64; inline;
end;


//--- TThriftBytes ----------------------------------------------------------------------


class operator TThriftBytes.Implicit(aRec : SysUtils.TBytes) : TThriftBytes;
begin
ASSERT( @result.data = @result); // must be first field
ASSERT( SizeOf(aRec) = SizeOf(result)); // must be the only field
result := TThriftBytes(aRec);
end;


class operator TThriftBytes.Implicit(aRec : TThriftBytes) : SysUtils.TBytes;
begin
ASSERT( @aRec.data = @aRec); // must be first field
ASSERT( SizeOf(aRec) = SizeOf(result)); // must be the only field
result := SysUtils.TBytes(aRec.data);
end;


function TThriftBytes.Length : Integer;
begin
result := System.Length(data);
end;


{ TProtocolRecursionTrackerImpl }

Expand Down
22 changes: 2 additions & 20 deletions lib/delphi/test/serializer/TestSerializer.dproj
Original file line number Diff line number Diff line change
@@ -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>{9282EDD8-7C12-41B0-8172-61C6BFA6E238}</ProjectGuid>
<MainSource>TestSerializer.dpr</MainSource>
Expand Down Expand Up @@ -101,7 +83,7 @@
<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
<PreBuildEvent><![CDATA[thrift.exe -r -gen delphi:com_types,rtti ..\keywords\ReservedKeywords.thrift
thrift.exe -r -gen delphi:com_types ..\..\..\..\test\DebugProtoTest.thrift]]></PreBuildEvent>
</PropertyGroup>
<ProjectExtensions>
Expand Down
2 changes: 1 addition & 1 deletion lib/delphi/test/server.dproj
Original file line number Diff line number Diff line change
Expand Up @@ -123,7 +123,7 @@
<VersionInfoKeys Name="Comments"/>
</VersionInfoKeys>
<Parameters>
<Parameters Name="RunParams">--protocol=compact </Parameters>
<Parameters Name="RunParams">--protocol=compact</Parameters>
</Parameters>
</Delphi.Personality>
<Platforms>
Expand Down
22 changes: 2 additions & 20 deletions lib/delphi/test/skip/skiptest_version2.dproj
Original file line number Diff line number Diff line change
@@ -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>{DBB2D6D8-0FC6-4329-8408-28B1452B33AD}</ProjectGuid>
<MainSource>skiptest_version2.dpr</MainSource>
Expand Down Expand Up @@ -97,7 +79,7 @@
<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 idl\skiptest_version_2.thrift]]></PreBuildEvent>
<PreBuildEvent><![CDATA[thrift.exe -r -gen delphi:rtti idl\skiptest_version_2.thrift]]></PreBuildEvent>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
Expand Down

0 comments on commit 9d76f28

Please sign in to comment.