如何比较TFunc / TProc包含对象的函数/过程？ [英] How to compare TFunc/TProc containing function/procedure of object?

问题描述

我们使用 TList< TFunc< Boolean>> 与对象它现在想再次 Remove（）一些条目。但它不工作，因为显然你只是不能比较这些引用... 可靠。

We use a TList<TFunc<Boolean>> with some function ... of objects in it and now want to Remove() some of the entries again. But it doesn't work because obviously you simply can not compare these reference to ... thingies reliably.

这里有一些测试代码：

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.

我们尝试了一切 ，=运算符，比较指针等。

We tried virtually everything, = operator, comparing pointers, etc..

我们甚至尝试了一些非常讨厌的事情，比如重复地转换到 PPointer 和解引用，直到我们得到相等的值，当然没有产生令人满意的结果。）

We even tried some really nasty things like repeatedly casting to PPointer and dereferencing until we get equal values, but that of course didn't yield satisfying results either =).

• 情况（2），（4）和




• 情况（3）很简单，也很好。


• ，这是我们无法工作的。

• Case (2), (4) and (5) are OK, as there are in fact distinct functions.
• Case (3) is trivial and OK, too.
• Case (1) is what we want to detect, and this is what we can't get to work.

恐怕，Delphi隐秘地创建两个不同的匿名函数，到 Foo.Bar 。在这种情况下，我们将是完全无能为力的，除非我们想要通过一个未知内存的陨石...我们不会。

I fear, Delphi stealthily creates two distinct anonymous functions that forward the call to Foo.Bar. In this case we'd be completely powerless, unless we wanted to wade through a morass of unknown memory... and well, we don't.

推荐答案

您必须通过其他方式将名称或索引与其关联。匿名方法没有名称，并且可能捕获状态（因此它们被重新创建每个实例）;有没有微不足道的方式，使它们可比较而不破坏封装。

You'll have to associated a name or index with them by some other means. Anonymous methods don't have names and may capture state (so they are recreated per instance); there is no trivial way to make them comparable without breaking encapsulation.

你可以得到的方法引用后面的对象，如果它后面确实有一个对象保证这一点 - 方法引用的接口是用COM语义实现的，他们真正需要的是一个COM vtable）：

You can get at the object behind the method reference, if there is indeed an object behind it (there's no guarantee of this - the interfaces that method references are implemented in terms of COM semantics, all they really need is a 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 ;但是如果你有一个第二个匿名方法，在结构上是相同的，它将导致第二个方法，因为匿名方法体不会被比较结构相等（这将是一个高成本，低价值的优化，因为程序员不太可能做这样的事情，大型结构比较不便宜）。

This will (currently) print Go$0$ActRec; but if you have a second anonymous method, structurally identical, it will result in a second method, because anonymous method bodies are not compared for structural equality (it would be a high-cost, low-value optimization, as it's unlikely the programmer would do such a thing, and large structural comparisons aren't cheap).

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

If you were using a later version of Delp you could use RTTI on the class of this object and try and compare fields, and implement structural comparison yourself.

这篇关于如何比较TFunc / TProc包含对象的函数/过程？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！