如何比较包含对象函数/过程的TFunc/TProc？

Question

如何比较包含对象函数/过程的TFunc/TProc？

delphicomparisondelphi-2009

12

我们使用一个包含一些对象的函数列表 TList<TFunc<Boolean>>，现在想要再次删除其中的一些条目。但是它不起作用，因为很明显您无法可靠地比较这些引用对象 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的调用。在这种情况下，我们将完全无能为力，除非我们想要穿越未知的内存深渊...而好吧，我们不想。

- kiw

+1 是因为那些匿名引用很奇怪。它们里面有什么？我刚刚执行了 var F: TFunc<Boolean>; ShowMessage(IntToStr(SizeOf(F))); - 它在我的 Delphi 2010 中显示为 1！这怎么可能？ - Cosmin Prund

你所指的是哪些情况？ - Martijn

2

@Cosmin - 它返回表达式 F 的类型大小，而在您的情况下，F 是返回布尔值的函数。 - Barry Kelly

@Martijn：我指的是注释中的数字。@Cosmin：看起来它们有4个字节长，至少在“IsEqual”内部参数的地址相隔4个字节（可能是对齐）。 - kiw

@kiw：啊，好的。我没看到那些，抱歉。 - Martijn

显示剩余2条评论

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Barry Kelly · Accepted Answer

你需要用其他方式将它们与名字或索引关联起来。匿名方法没有名称并且可能捕获状态（因此会每个实例重新创建），没有简单的方法使它们可比较而不破坏封装性。

如果确实有方法引用后面跟着一个对象，你可以访问该对象。但这并不是保证 - 方法引用所实现的接口基于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来尝试比较字段，并自己实现结构比较。