如何比较TFunc / TProc包含对象的功能/过程?

时间:2011-03-01 10:53:52

标签: delphi comparison delphi-2009

我们在TList<TFunc<Boolean>>中使用了一些function ... of object,现在又想要Remove()一些条目。但它不起作用,因为显然你只是不能可靠地比较这些reference to ...物品。

这是一些测试代码:

program Project1;

{$APPTYPE CONSOLE}

uses
  Generics.Defaults,
  SysUtils;

type
  TFoo = class
  strict private
    FValue: Boolean;
  public
    constructor Create();
    function Bar(): Boolean;
  end;

{ TFoo }

function TFoo.Bar: Boolean;
begin
  Result := FValue;
end;

constructor TFoo.Create;
begin
  inherited;

  FValue := Boolean(Random(1));
end;

function IsEqual(i1, i2: TFunc<Boolean>): Boolean;
begin
  Result := TEqualityComparer<TFunc<Boolean>>.Default().Equals(i1, i2);
end;

var
  s: string;
  foo: TFoo;
  Fkt1, Fkt2: TFunc<Boolean>;

begin
  try
    Foo := TFoo.Create();

    WriteLn(IsEqual(Foo.Bar, Foo.Bar));             // FALSE (1)
    WriteLn(IsEqual(Foo.Bar, TFoo.Create().Bar));   // FALSE (2)

    Fkt1 := function(): Boolean begin Result := False; end;
    Fkt2 := Fkt1;
    WriteLn(IsEqual(Fkt1, Fkt2));                   // TRUE  (3)

    Fkt2 := function(): Boolean begin Result := False; end;
    WriteLn(IsEqual(Fkt1, Fkt2));                   // FALSE (4)

    Fkt2 := function(): Boolean begin Result := True; end;
    WriteLn(IsEqual(Fkt1, Fkt2));                   // FALSE (5)

    FreeAndNil(Foo);
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
  Readln(s);
end.

我们尝试了几乎所有,=运算符,比较指针等。

我们甚至尝试了一些非常讨厌的事情,例如重复投射到PPointer并取消引用直到我们获得相同的值,但这当然不会产生令人满意的结果=)。

  • 案例(2),(4)和(5)都可以,因为事实上有不同的功能。
  • 案例(3)也很简单,也可以。
  • 案例(1)是我们想要检测的,这是我们无法开展的工作。

我担心,Delphi会秘密创建两个不同的匿名函数,将调用转发给Foo.Bar。在这种情况下,我们将完全无能为力,除非我们想要通过未知记忆的泥潭......而且,我们不会。

1 个答案:

答案 0 :(得分:14)

您必须通过其他方式将名称或索引与它们相关联。匿名方法没有名称,可能捕获状态(因此每个实例重新创建它们);没有破坏封装就没有什么可比的方法来使它们具有可比性。

你可以得到方法引用背后的对象,如果它背后确实有一个对象(不能保证这一点 - 方法引用的接口是根据COM语义实现的,它们真正需要的只是一个COM vtable ):

function Intf2Obj(x: IInterface): TObject;
type
  TStub = array[0..3] of Byte;
const
  // ADD [ESP+$04], imm8; [ESP+$04] in stdcall is Self argument, after return address
  add_esp_04_imm8: TStub = ($83, $44, $24, $04);
  // ADD [ESP+$04], imm32
  add_esp_04_imm32: TStub = ($81, $44, $24, $04);

  function Match(L, R: PByte): Boolean;
  var
    i: Integer;
  begin
    for i := 0 to SizeOf(TStub) - 1 do
      if L[i] <> R[i] then
        Exit(False);
    Result := True;
  end;

var
  p: PByte;
begin
  p := PPointer(x)^; // get to vtable
  p := PPointer(p)^; // load QueryInterface stub address from vtable

  if Match(p, @add_esp_04_imm8) then 
  begin
    Inc(p, SizeOf(TStub));
    Result := TObject(PByte(Pointer(x)) + PShortint(p)^);
  end
  else if Match(p, @add_esp_04_imm32) then
  begin
    Inc(p, SizeOf(TStub));
    Result := TObject(PByte(Pointer(x)) + PLongint(p)^);
  end
  else
    raise Exception.Create('Not a Delphi interface implementation?');
end;

type
  TAction = reference to procedure;

procedure Go;
var
  a: TAction;
  i: IInterface;
  o: TObject;
begin
  a := procedure
    begin
      Writeln('Hey.');
    end;
  i := PUnknown(@a)^;
  o := i as TObject; // Requires Delphi 2010
  o := Intf2Obj(i); // Workaround for non-D2010
  Writeln(o.ClassName);
end;

begin
  Go;
end.

这将(当前)打印Go$0$ActRec;但是如果你有第二个匿名方法,结构相同,它将导致第二个方法,因为匿名方法体不进行结构相等性比较(这将是一个高成本,低价值的优化,因为程序员不太可能做这样的事情,大型结构比较并不便宜。)

如果你使用的是更高版本的Delphi,你可以在这个对象的类上使用RTTI并尝试比较字段,并自己实现结构比较。