THRIFT-5044 Improve serialization support for TApplicationExceptions and custom exceptions
Client: Delphi
Patch: Jens Geyer
This closes #1960
diff --git a/lib/delphi/src/Thrift.Exception.pas b/lib/delphi/src/Thrift.Exception.pas
index 5d15c36..88b1cfe 100644
--- a/lib/delphi/src/Thrift.Exception.pas
+++ b/lib/delphi/src/Thrift.Exception.pas
@@ -29,6 +29,8 @@
type
// base class for all Thrift exceptions
TException = class( SysUtils.Exception)
+ strict private
+ function GetMessageText : string;
public
function Message : string; // hide inherited property: allow read, but prevent accidental writes
procedure UpdateMessageProperty; // update inherited message property with toString()
@@ -45,17 +47,25 @@
// allow read (exception summary), but prevent accidental writes
// read will return the exception summary
begin
- result := Self.ToString;
+ result := Self.GetMessageText;
end;
+
procedure TException.UpdateMessageProperty;
// Update the inherited Message property to better conform to standard behaviour.
// Nice benefit: The IDE is now able to show the exception message again.
begin
- inherited Message := Self.ToString; // produces a summary text
+ inherited Message := Self.GetMessageText;
end;
+function TException.GetMessageText : string;
+// produces a summary text
+begin
+ result := Self.ToString;
+ if (result <> '') and (result[1] = '(')
+ then result := Copy(result,2,Length(result)-2);
+end;
end.
diff --git a/lib/delphi/src/Thrift.pas b/lib/delphi/src/Thrift.pas
index 716e4d2..1926b11 100644
--- a/lib/delphi/src/Thrift.pas
+++ b/lib/delphi/src/Thrift.pas
@@ -23,6 +23,7 @@
uses
SysUtils,
+ Thrift.Utils,
Thrift.Exception,
Thrift.Protocol;
@@ -34,7 +35,7 @@
TApplicationExceptionSpecializedClass = class of TApplicationExceptionSpecialized;
- TApplicationException = class abstract( TException)
+ TApplicationException = class( TException, IBase, ISupportsToString)
public
type
{$SCOPEDENUMS ON}
@@ -52,10 +53,18 @@
UnsupportedClientType
);
{$SCOPEDENUMS OFF}
+ strict private
+ FExceptionType : TExceptionType;
+
+ strict protected
+ function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
+ function _AddRef: Integer; stdcall;
+ function _Release: Integer; stdcall;
+
strict protected
constructor HiddenCreate(const Msg: string);
- class function GetType: TExceptionType; virtual; abstract;
class function GetSpecializedExceptionType(AType: TExceptionType): TApplicationExceptionSpecializedClass;
+
public
// purposefully hide inherited constructor
class function Create(const Msg: string): TApplicationException; overload; deprecated 'Use specialized TApplicationException types (or regenerate from IDL)';
@@ -63,7 +72,10 @@
class function Create( AType: TExceptionType): TApplicationException; overload; deprecated 'Use specialized TApplicationException types (or regenerate from IDL)';
class function Create( AType: TExceptionType; const msg: string): TApplicationException; overload; deprecated 'Use specialized TApplicationException types (or regenerate from IDL)';
- property Type_: TExceptionType read GetType;
+ function Type_: TExceptionType; virtual;
+
+ procedure IBase_Read( const iprot: IProtocol);
+ procedure IBase.Read = IBase_Read;
class function Read( const iprot: IProtocol): TApplicationException;
procedure Write( const oprot: IProtocol );
@@ -71,8 +83,11 @@
// Needed to remove deprecation warning
TApplicationExceptionSpecialized = class abstract (TApplicationException)
+ strict protected
+ class function GetType: TApplicationException.TExceptionType; virtual; abstract;
public
constructor Create(const Msg: string);
+ function Type_: TApplicationException.TExceptionType; override;
end;
TApplicationExceptionUnknown = class (TApplicationExceptionSpecialized)
@@ -163,6 +178,31 @@
Result := GetSpecializedExceptionType(AType).Create(msg);
end;
+
+function TApplicationException.QueryInterface(const IID: TGUID; out Obj): HResult;
+begin
+ if GetInterface(IID, Obj)
+ then result := S_OK
+ else result := E_NOINTERFACE;
+end;
+
+function TApplicationException._AddRef: Integer;
+begin
+ result := -1; // not refcounted
+end;
+
+function TApplicationException._Release: Integer;
+begin
+ result := -1; // not refcounted
+end;
+
+
+function TApplicationException.Type_: TExceptionType;
+begin
+ result := FExceptionType;
+end;
+
+
class function TApplicationException.GetSpecializedExceptionType(AType: TExceptionType): TApplicationExceptionSpecializedClass;
begin
case AType of
@@ -183,52 +223,60 @@
end;
-class function TApplicationException.Read( const iprot: IProtocol): TApplicationException;
+procedure TApplicationException.IBase_Read( const iprot: IProtocol);
var
field : TThriftField;
- msg : string;
- typ : TExceptionType;
struc : TThriftStruct;
begin
- msg := '';
- typ := TExceptionType.Unknown;
struc := iprot.ReadStructBegin;
while ( True ) do
begin
field := iprot.ReadFieldBegin;
- if ( field.Type_ = TType.Stop) then
- begin
+ if ( field.Type_ = TType.Stop) then begin
Break;
end;
case field.Id of
1 : begin
- if ( field.Type_ = TType.String_) then
- begin
- msg := iprot.ReadString;
- end else
- begin
+ if ( field.Type_ = TType.String_) then begin
+ Exception(Self).Message := iprot.ReadString;
+ end else begin
TProtocolUtil.Skip( iprot, field.Type_ );
end;
end;
2 : begin
- if ( field.Type_ = TType.I32) then
- begin
- typ := TExceptionType( iprot.ReadI32 );
- end else
- begin
+ if ( field.Type_ = TType.I32) then begin
+ FExceptionType := TExceptionType( iprot.ReadI32 );
+ end else begin
TProtocolUtil.Skip( iprot, field.Type_ );
end;
- end else
- begin
+ end else begin
TProtocolUtil.Skip( iprot, field.Type_);
end;
end;
iprot.ReadFieldEnd;
end;
iprot.ReadStructEnd;
- Result := GetSpecializedExceptionType(typ).Create(msg);
+end;
+
+
+class function TApplicationException.Read( const iprot: IProtocol): TApplicationException;
+var instance : TApplicationException;
+ base : IBase;
+begin
+ instance := TApplicationException.CreateFmt('',[]);
+ try
+ if Supports( instance, IBase, base) then try
+ base.Read(iprot);
+ finally
+ base := nil; // clear ref before free
+ end;
+
+ result := GetSpecializedExceptionType(instance.Type_).Create( Exception(instance).Message);
+ finally
+ instance.Free;
+ end;
end;
procedure TApplicationException.Write( const oprot: IProtocol);
@@ -240,8 +288,7 @@
Init(field);
oprot.WriteStructBegin( struc );
- if Message <> '' then
- begin
+ if Message <> '' then begin
field.Name := 'message';
field.Type_ := TType.String_;
field.Id := 1;
@@ -254,7 +301,7 @@
field.Type_ := TType.I32;
field.Id := 2;
oprot.WriteFieldBegin(field);
- oprot.WriteI32(Integer(GetType));
+ oprot.WriteI32(Integer(Type_));
oprot.WriteFieldEnd();
oprot.WriteFieldStop();
oprot.WriteStructEnd();
@@ -267,6 +314,12 @@
inherited HiddenCreate(Msg);
end;
+function TApplicationExceptionSpecialized.Type_: TApplicationException.TExceptionType;
+begin
+ result := GetType;
+end;
+
+
{ specialized TApplicationExceptions }
class function TApplicationExceptionUnknownMethod.GetType : TApplicationException.TExceptionType;