RTTI information for method pointer - delphi

Question

Is it possible to obtain RTTI information about a TMethod?
I can get the instance by
Instance := TObject(Method.Data);
so I can get the RTTI type of the instance, but how can I get the correct TRttiMethod? I want to check for attributes on a method passed in using a method pointer.

Answer 1

This approach works in theory, and there's a good change it will work in practice, but there are a couple of things that could prevent you from getting hold of the TRttiMethod.
The TMethod record says Data: Pointer, not TObject. This implies there might be a possibility of having something other then an TObject as the Data! This is a serious issue, because if the Data is not TObject, then attempting to extract RTTI from it is going to result in runtime errors.
Not all methods have RTTI. By default methods in the private area do not have RTTI, and one can use the {$RTTI} to stop generating RTTI for public or published members as well.
Those two issues would not be a problem for the usual type of event implementations we have in Delphi (double-click on the name of the event in Object Inspector and fill in the code), but then again I don't think you're talking about "vanila" implementations. Not many people would decorate the default event handlers with Attributes!
Code that demonstrates all of the above:
program Project15;
{$APPTYPE CONSOLE}
uses
SysUtils, RTTI;
type
// Closure/Event type
TEventType = procedure of object;
// An object that has a method compatible with the declaration above
TImplementation = class
private
procedure PrivateImplementation;
public
procedure HasRtti;
procedure GetPrivateImpEvent(out Ev:TEventType);
end;
TRecord = record
procedure RecordProc;
end;
// an object that has a compatible method but provides no RTTI
{$RTTI EXPLICIT METHODS([])}
TNoRttiImplementation = class
public
procedure NoRttiAvailable;
end;
procedure TImplementation.GetPrivateImpEvent(out Ev:TEventType);
begin
Ev := PrivateImplementation;
end;
procedure TImplementation.HasRtti;
begin
WriteLn('HasRtti');
end;
procedure TNoRttiImplementation.NoRttiAvailable;
begin
WriteLn('No RTTI Available');
end;
procedure TRecord.RecordProc;
begin
WriteLn('This is written from TRecord.RecordProc');
end;
procedure TImplementation.PrivateImplementation;
begin
WriteLn('PrivateImplementation');
end;
procedure TotalyFakeImplementation(Instance:Pointer);
begin
WriteLn('Totaly fake implementation, TMethod.Data is nil');
end;
procedure SomethingAboutMethod(X: TEventType);
var Ctx: TRttiContext;
Typ: TRttiType;
Method: TRttiMethod;
Found: Boolean;
begin
WriteLn('Invoke the method to prove it works:');
X;
// Try extract information about the event
Ctx := TRttiContext.Create;
try
Typ := Ctx.GetType(TObject(TMethod(X).Data).ClassType);
Found := False;
for Method in Typ.GetMethods do
if Method.CodeAddress = TMethod(X).Code then
begin
// Got the Method!
WriteLn('Found method: ' + Typ.Name + '.' + Method.Name);
Found := True;
end;
if not Found then
WriteLn('Method not found.');
finally Ctx.Free;
end;
end;
var Ev: TEventType;
R: TRecord;
begin
try
try
WriteLn('First test, using a method that has RTTI available:');
SomethingAboutMethod(TImplementation.Create.HasRtti);
WriteLn;
WriteLn('Second test, using a method that has NO rtti available:');
SomethingAboutMethod(TNoRttiImplementation.Create.NoRttiAvailable);
WriteLn;
WriteLn('Third test, private method, default settings:');
TImplementation.Create.GetPrivateImpEvent(Ev);
SomethingAboutMethod(Ev);
WriteLn;
WriteLn('Assign event handler using handler from a record');
try
SomethingAboutMethod(R.RecordProc);
except on E:Exception do WriteLn(E.Message);
end;
WriteLn;
WriteLn('Assign event handler using static procedure');
try
TMethod(Ev).Data := nil;
TMethod(Ev).Code := #TotalyFakeImplementation;
SomethingAboutMethod(Ev);
except on E:Exception do WriteLn(E.Message);
end;
WriteLn;
except
on E: Exception do Writeln(E.ClassName, ': ', E.Message);
end;
finally ReadLn;
end;
end.