CODEWITHSUNDEEP
delphicomparisondelphi-2009
kiw
kiw

Reputation: 808

How to compare TFunc/TProc containing function/procedure of object?

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

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.

Upvotes: 12

Views: 3839

Answers (1)

Barry Kelly
Barry Kelly

Reputation: 42152

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.

Upvotes: 15

Related Questions