Unable to invoke method declare in class implement generic interface method

Question

Delphi support generic for IInterface. I have the follow construct using generic 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 class implement two interface: IVisitor<TButton> and IVisitor<TEdit>.

I attempt invoke the 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 invoke procedure TMyVisitor.Visit(o: TButton) when execute (V as IVisitor<TButton>).Visit(Button1).

Is this a bug in Delphi or I should avoid implement multiple generic IInterface? All above codes have test in Delphi XE6.

Answer 1

as operator requires interface GUID to be able to tell which interface you are referring to. Since generic interfaces share same GUID as operator will not work with them. Basically, compiler cannot tell the difference between IVisitor<TButton> and IVisitor<TEdit> interfaces.

However, you can solve your problem using enhanced 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 to have Visitor interface you can change 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;

You can then use that in following manner, just by calling Visit and appropriate Visit method will be 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 extended visitor interface and class that can operate on non-class types. I have implemented only calls for string, but implementation for other types consists only of copy-paste code with different typecast.

  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;

Enhanced Visitor can be used like this:

  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;