Passing a method's code as an argument in a typesafe way

Question

Passing a method as an argument is not a problem:

type
  TSomething = class
    Msg: string;
    procedure Show;
  end;

procedure TSomething.Show;
begin
  ShowMessage(Msg);
end;

type TProc = procedure of object;

procedure Test(Proc: TProc);
begin
  Proc;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Smth: TSomething;

begin
  Smth:= TSomething.Create;
  Smth.Msg:= 'Hello';
  Test(Smth.Show);
end;

I need something tricky - to pass only a code part of a method. I know I can do it:

procedure Test2(Code: Pointer);
var
  Smth: TSomething;
  Meth: TMethod;

begin
  Smth:= TSomething.Create;
  Smth.Msg:= 'Hello Hack';
  Meth.Data:= Smth;
  Meth.Code:= Code;
  TProc(Meth);
  Smth.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Test2(@TSomething.Show);
end;

but that is a hack and unsafe - the compiler can't check the method's arguments.

The question: Is it possible to do the same in a typesafe way?

Answer 1

I got it finally. With type checking and no need to declare variable for the calling event!

type

  TSomething = class
    Msg: string;
    procedure Show;
    procedure ShowWithHeader(Header : String);
  end;

  TProc = procedure of object;
  TStringMethod = procedure(S : String) of Object;

procedure TSomething.Show;
begin
  ShowMessage(Msg);
end;

procedure TSomething.ShowWithHeader(Header: String);
begin
  ShowMessage(Header + ' : ' + Msg);
end;

procedure Test2(Code: TProc);
var
  Smth: TSomething;
begin
  Smth:= TSomething.Create;
  Smth.Msg:= 'Hello Hack 2';
  TMethod(Code).Data := Smth;
  Code;
  Smth.Free;
end;

procedure Test3(Code: TStringMethod; S : String);
var
  Smth: TSomething;
begin
  Smth:= TSomething.Create;
  Smth.Msg:= 'Hello Hack 3';
  TMethod(Code).Data := Smth;
  Code(S);
  Smth.Free;
end;

procedure TForm4.btn1Click(Sender: TObject);
begin
  Test2(TSomething(nil).Show);
//  Test2(TSomething(nil).ShowWithHeader); // Cannot Compile
end;

procedure TForm4.btn2Click(Sender: TObject);
begin
//  Test3(TSomething(nil).Show,'Hack Header');  // Cannot Compile
  Test3(TSomething(nil).ShowWithHeader,'Hack Header');
end;

Answer 2

I finally adopted a workaround based on stub functions. It does not answer my original question, contains a stub overhead but solves my problem with duplicated code and free from hackish code:

type
  TSmth = class
    procedure Method1;
    procedure Method2;
  end;

type
  TDoMethod = procedure(Instance: TSmth);

procedure DoMethod1(Instance: TSmth);
begin
  Instance.Method1;
end;

procedure DoMethod2(Instance: TSmth);
begin
  Instance.Method2;
end;

procedure TestMethod(DoMethod: TDoMethod);
var
  Smth: TSmth;

begin
  Smth:= TSmth.Create;
{ a lot of common setup code here }
  DoMethod(Smth);
{ a lot of common check code here }
  Smth.Free;
end;

procedure TestMethod1;
begin
  TestMethod(DoMethod1);
end;

procedure TestMethod2;
begin
  TestMethod(DoMethod2);
end;

Answer 3

Disclaimer: I personally would never use this code and could never recommend or condone its use.

Do it like this:

procedure Test2(Method: TProc);
var
  Smth: TSomething;
begin
  Smth:= TSomething.Create;
  Smth.Msg:= 'Hello Hack';
  TMethod(Method).Data:= Smth;
  Method();
end;

Of course this is still unsafe since it will only work if what you put into Data is in fact compatible with the method.

---

Serg asks:

How will you call your Test2 without creating a dummy instance of TSomething?

I suppose you can do it like this, for static (i.e. non-virtual and non-dynamic) methods:

var
  Obj: TSomething;
....
Test2(Obj.Show);//no need to actually create Obj

Of course all this illustrates what a grotesque hack this is. I think this is no better than the version in your question. There's no real clean way to do what you ask.

I suspect that the correct way to solve your real problem would be to use RTTI to call the method.

Answer 4

This is an example using anonymous methods.

No code duplication and typesafe method calls.

type
  TSmth = class
    procedure Method1;
    procedure Method2;
  end;

procedure Test;
type
  TMyMethodRef = reference to procedure;
  PMyTestRef = reference to procedure(aMethod :TMyMethodRef);
var
  TestP : PMyTestRef;
  Smth : TSmth;
begin
  TestP :=
    procedure( aMethod : TMyMethodRef)
    begin
      Smth := TSmth.Create;
      try
        // setup Smth
        aMethod;
        // test Smth 
      finally
        Smth.Free;
      end;
    end;

  TestP(Smth.Method1); // Test Method1
  TestP(Smth.Method2); // Test Method2    
end;