Can't call declare method on class to implement generic interface method
Delphi support for IInterface
. I have the following construct using the generic one IInterface
:
type
IVisitor<T> = interface
['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}']
procedure Visit(o: T);
end;
TMyVisitor = class(TInterfacedObject, IVisitor<TButton>, IVisitor<TEdit>)
procedure Visit(o: TButton); overload;
procedure Visit(o: TEdit); overload;
end;
implementation
procedure TMyVisitor.Visit(o: TButton);
begin
ShowMessage('Expected: TButton, Actual: ' + o.ClassName);
end;
procedure TMyVisitor.Visit(o: TEdit);
begin
ShowMessage('Expected: TEdit, Actual: ' + o.ClassName);
end;
TMyVisitor
the class implements two interfaces: IVisitor<TButton>
and IVisitor<TEdit>
.
I am trying to call methods:
procedure TForm6.Button1Click(Sender: TObject);
var V: IInterface;
begin
V := TMyVisitor.Create;
(V as IVisitor<TButton>).Visit(Button1);
(V as IVisitor<TEdit>).Visit(Edit1);
end;
The output I have is:
Expected: TEdit, Actual: TButton
Expected: TEdit, Actual: TEdit
Apparently the code doesn't call procedure TMyVisitor.Visit(o: TButton)
on execution (V as IVisitor<TButton>).Visit(Button1)
.
Is this a bug in Delphi, or should I avoid implementing a few common ones IInterface
? All of the above codes have a test in Delphi XE6
.
source to share
as
requires the GUID of the interface to be able to determine which interface you are accessing. Since the common interfaces use the same GUID as
, the operator will not work with them. Basically, the compiler cannot distinguish between IVisitor <TButton> and IVisitor <TEdit> interfaces.
However, you can solve your problem with extended RTTI:
type
TCustomVisitor = class(TObject)
public
procedure Visit(Instance: TObject);
end;
TVisitor = class(TCustomVisitor)
public
procedure VisitButton(Instance: TButton); overload;
procedure VisitEdit(Instance: TEdit); overload;
end;
procedure TCustomVisitor.Visit(Instance: TObject);
var
Context: TRttiContext;
CurrentClass: TClass;
Params: TArray<TRttiParameter>;
ParamType: TRttiType;
SelfMethod: TRttiMethod;
s: string;
begin
Context := TRttiContext.Create;
CurrentClass := Instance.ClassType;
repeat
s := CurrentClass.ClassName;
Delete(s, 1, 1); // remove "T"
for SelfMethod in Context.GetType(Self.ClassType).GetMethods('Visit' + s) do
begin
Params := SelfMethod.GetParameters;
if (Length(Params) = 1) then
begin
ParamType := Params[0].ParamType;
if ParamType.IsInstance and (ParamType.AsInstance.MetaclassType = CurrentClass) then
begin
SelfMethod.Invoke(Self, [Instance]);
Exit;
end;
end;
end;
CurrentClass := CurrentClass.ClassParent;
until CurrentClass = nil;
end;
If you need a Visitor interface, you can change the declarations to
type
IVisitor = interface
['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}']
procedure Visit(Instance: TObject);
end;
TCustomVisitor = class(TInterfacedObject, IVisitor)
public
procedure Visit(Instance: TObject);
end;
Then you can use this in the following way by simply calling visit and the appropriate visit method is called.
procedure TForm6.Button1Click(Sender: TObject);
var V: IVisitor;
begin
V := TMyVisitor.Create;
V.Visit(Button1);
V.Visit(Edit1);
end;
Above code is based on Uwe Raabe's code and you can read more http://www.uweraabe.de/Blog/?s=visitor
And here is the extended visitor interface and a class that can work with nonclass types. I've only implemented calls to string, but implementation for other types only consists of copy-and-paste code with a different type.
IVisitor = interface
['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}']
procedure Visit(const Instance; InstanceType: PTypeInfo);
procedure VisitObject(Instance: TObject);
end;
TCustomVisitor = class(TInterfacedObject, IVisitor)
public
procedure Visit(const Instance; InstanceType: PTypeInfo);
procedure VisitObject(Instance: TObject);
end;
procedure TCustomVisitor.Visit(const Instance; InstanceType: PTypeInfo);
var
Context: TRttiContext;
Params: TArray<TRttiParameter>;
ParamType: TRttiType;
SelfMethod: TRttiMethod;
begin
Context := TRttiContext.Create;
case InstanceType.Kind of
tkClass : VisitObject(TObject(Instance));
// template how to implement calls for non-class types
tkUString :
begin
for SelfMethod in Context.GetType(Self.ClassType).GetMethods('VisitString') do
begin
Params := SelfMethod.GetParameters;
if (Length(Params) = 1) then
begin
ParamType := Params[0].ParamType;
if ParamType.TypeKind = tkUString then
begin
SelfMethod.Invoke(Self, [string(Instance)]);
Exit;
end;
end;
end;
end;
end;
end;
procedure TCustomVisitor.VisitObject(Instance: TObject);
var
Context: TRttiContext;
CurrentClass: TClass;
Params: TArray<TRttiParameter>;
ParamType: TRttiType;
SelfMethod: TRttiMethod;
s: string;
begin
Context := TRttiContext.Create;
CurrentClass := Instance.ClassType;
repeat
s := CurrentClass.ClassName;
Delete(s, 1, 1); // remove "T"
for SelfMethod in Context.GetType(Self.ClassType).GetMethods('Visit' + s) do
begin
Params := SelfMethod.GetParameters;
if (Length(Params) = 1) then
begin
ParamType := Params[0].ParamType;
if ParamType.IsInstance and (ParamType.AsInstance.MetaclassType = CurrentClass) then
begin
SelfMethod.Invoke(Self, [Instance]);
Exit;
end;
end;
end;
CurrentClass := CurrentClass.ClassParent;
until CurrentClass = nil;
end;
The enhanced visitor can be used as follows:
TVisitor = class(TCustomVisitor)
public
procedure VisitButton(Instance: TButton); overload;
procedure VisitEdit(Instance: TEdit); overload;
procedure VisitString(Instance: string); overload;
end;
var
v: IVisitor;
s: string;
begin
s := 'this is string';
v := TVisitor.Create;
// class instances can be visited directly via VisitObject
v.VisitObject(Button1);
v.Visit(Edit1, TypeInfo(TEdit));
v.Visit(s, TypeInfo(string));
end;
source to share
This is a well known issue with generic interfaces. Here is yours:
type
IVisitor<T> = interface
['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}']
procedure Visit(o: T);
end;
The operator is now as
implemented on top of the GUID you specified for the interface. When you write:
(V as IVisitor<TButton>).Visit(Button1);
(V as IVisitor<TEdit>).Visit(Edit1);
how does the operator as
distinguish between IVisitor<TButton>
and IVisitor<TEdit>
? You have only specified one GUID. In fact, when this happens, all instances created based on this common interface have the same GUID. And so, when a statement is as
compiled and the code is executed, the run-time behavior is undefined. In fact, you define multiple interfaces and provide them with the same GUID.
So the main problem here is that the operator is as
incompatible with generic interfaces. You will need to find another way to implement this. You may want to consider the Spring4D project for inspiration.
source to share