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

发布于 2024-10-19 11:15:24 字数 1864 浏览 3 评论 0 原文

我们使用一个 TList> ,其中包含一些function ... of object,现在想要Remove()再次一些条目。但它不起作用,因为显然您无法可靠地比较这些对...的引用

下面是一些测试代码:

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。在这种情况下,我们将完全无能为力,除非我们想涉过未知记忆的泥沼……好吧,我们不想。

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.

Here's some test code:

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..

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 =).

  • 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.

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.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

孤城病女 2024-10-26 11:15:24

您必须通过其他方式将名称或索引与它们关联起来。匿名方法没有名称并且可以捕获状态(因此它们是按实例重新创建的);没有任何简单的方法可以在不破坏封装的情况下使它们具有可比性。

您可以获取方法引用后面的对象,如果它后面确实有一个对象(对此无法保证 - 方法引用的接口是根据 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 并尝试比较字段,并自行实现结构比较。

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.

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.

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).

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

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文