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.