embarcadero - delphi wikipedia

Cómo comparar TFunc/TProc que contiene la función/procedimiento del objeto?

Question

Usamos un TList<TFunc<Boolean>> con alguna function ... of object s en él y ahora queremos Remove() algunas de las entradas nuevamente. Pero no funciona porque, obviamente, simplemente no puede comparar estas reference to ... cositas de manera confiable.

Aquí hay un código de prueba:

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.

Probamos prácticamente todo , = operador, comparando punteros, etc.

Incluso probamos algunas cosas realmente desagradables, como la conversión repetida a PPointer y la desreferenciación hasta que obtuvimos los mismos valores, pero eso, por supuesto, tampoco arrojó resultados satisfactorios =).

• Los casos (2), (4) y (5) están bien, ya que de hecho hay distintas funciones.
• El caso (3) es trivial y está bien, también.
• El caso (1) es lo que queremos detectar, y esto es a lo que no podemos llegar a trabajar.

Me temo que Delphi cree sigilosamente dos funciones anónimas distintas que Foo.Bar el llamado a Foo.Bar . En este caso, seríamos completamente impotentes, a menos que quisiéramos vadear un pantano de memoria desconocida ... y bueno, no es así.

Answer 1

Tendrá que asociar un nombre o índice con ellos de alguna otra manera. Los métodos anónimos no tienen nombres y pueden capturar el estado (por lo que se recrean por instancia); no hay una manera trivial de hacerlos comparables sin romper la encapsulación.

Puede acceder al objeto detrás de la referencia del método, si realmente hay un objeto detrás de él (no hay garantía de esto: las interfaces que las referencias a los métodos se implementan en términos de semántica COM, todo lo que realmente necesitan es una tabla COM):

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.

Esto (actualmente) imprimirá Go$0$ActRec ; pero si tiene un segundo método anónimo, estructuralmente idéntico, dará como resultado un segundo método, porque los cuerpos de métodos anónimos no se comparan para la igualdad estructural (sería una optimización de alto costo y bajo valor, ya que es poco probable que el programador hacer tal cosa, y las grandes comparaciones estructurales no son baratas).

Si estuviera usando una versión posterior de Delphi, podría usar RTTI en la clase de este objeto e intentar comparar campos e implementar la comparación estructural usted mismo.