Как сравнить TFunc / TProc, содержащий функцию / процедуру объекта? - PullRequest
Новая
       15

Как сравнить TFunc / TProc, содержащий функцию / процедуру объекта?

11 голосов
/ 01 марта 2011

Мы используем 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 Ответ

14 голосов
/ 01 марта 2011

Вам придется связать имя или индекс с ними другими способами. Анонимные методы не имеют имен и могут фиксировать состояние (поэтому они воссоздаются для каждого экземпляра); нет простого способа сделать их сопоставимыми, не нарушая инкапсуляцию.

Вы можете получить объект за ссылкой на метод, если за ним действительно стоит объект (нет никакой гарантии - интерфейсы, на которые ссылаются методы, реализованы в терминах семантики 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 для класса этого объекта и попытаться сравнить поля и самостоятельно выполнить структурное сравнение.

...