[fpc-devel] comparing methods

[Den Jean]

On Thursday 10 September  2009 16:56:20 Peter Vreman wrote:
> You can use the TMethod record to access the fields:
>   writeln(hexstr(tmethod(@c.p).data));
>   writeln(hexstr(tmethod(@c.p).code));
> end.
kind of related to this,

In the Qt binding I had to revert to a non type safe method 
for signal hooking. Because the compiler does not always see
the difference between a method provide to a procedure 
as a parameter and calling the method and giving the
method result as a parameter to the procedure.

So I cannot directly give the hooked procedure as a parameter
to a procedure, I have to do stuff like this
var M : TMethod
TSomeMethodTyp(M):=MyMethod
Hook_Signal(M);
Instead of 
Hook_Signal(MyMethod)

The following code shows the problem of 
default parameters confusing the compiler:
(compile with or w/o define DEFINE DEFAULT_VALUE.)

program hooks;

{$mode delphi}

{$DEFINE DEFAULT_VALUE}

uses SysUtils,Classes,Types;



{$IFNDEF DEFAULT_VALUE}
type
  TMethod_1Param = procedure(Value:integer) of object;

  procedure Hook_M_1Param(aMethod: TMethod_1Param);
  begin
  writeln('Hooked: Method.Code:',HexStr(TMethod(aMethod).Data),' 
Method.Data:',HexStr(TMethod(aMethod).Code));
  TMethod_1Param(aMethod)(143);
  end;
{$ELSE}
type
  TMethod_1Param = procedure(Value:integer=0) of object;

  procedure Hook_M_1Param(aMethod: TMethod);
  begin
  writeln('Hooked: Method.Code:',HexStr(aMethod.Data),' 
Method.Data:',HexStr(aMethod.Code));
   
  TMethod_1Param(aMethod)(143);
  end;
{$ENDIF}


type
  TC = class(TObject)
  public
  F : integer; 
  constructor Create;
  {$IFNDEF DEFAULT_VALUE}
  procedure M_1Param(Value:integer);
  {$ELSE}
  procedure M_1Param(Value:integer=0);
  {$ENDIF}
  end;

  constructor TC.Create;
  {$IFDEF DEFAULT_VALUE}
  var M : TMethod;
  {$ENDIF}
  begin
  inherited Create;
  F:=142;

  {$IFNDEF DEFAULT_VALUE}
  Hook_M_1Param(M_1Param);
  {$ELSE}
  TMethod_1Param(M):=M_1Param;
  Hook_M_1Param(M);
   {$ENDIF}
  
  end;

  procedure TC.M_1Param(Value:integer);
  begin
  writeln('M_1Param called with Value:',Value,' and F is:',F);
  end;


var
  C : TC;
  {$IFDEF DEFAULT_VALUE}
  M : TMethod;
  {$ENDIF}

begin
C:=TC.Create;

{$IFNDEF DEFAULT_VALUE}
writeln('C.Instance:',HexStr(TMethod(TMethod_1Param(C.M_1Param)).Data));
writeln('C.M_1Param:',HexStr(TMethod(TMethod_1Param(C.M_1Param)).Code));
{$ELSE}
// Uncomment the following lines to have a compiler error.
// Illegal type conversion: "untyped" to "<procedure variable type of 
procedure(LongInt="0") of object;Register>
//writeln('C.Instance:',HexStr(TMethod(TMethod_1Param(C.M_1Param)).Data));
//writeln('C.M_1Param:',HexStr(TMethod(TMethod_1Param(C.M_1Param)).Code));
// Trick with MethodType casting a Method variable
TMethod_1Param(M):=C.M_1Param;
writeln('C.Instance:',HexStr(M.Data));
writeln('C.M_1Param:',HexStr(M.Code));
{$ENDIF}

end.