Methodenaufruf via RTTI

[Eclipticon]

Hi,

gehe ich recht in der Annahme, dass ich eine published Method ueber das RTTI nicht aufrufen kann und dass tkMethod dazu dient, z.B. im Fall von Eventhandlern zurueckgegeben zu werden?

Ich versteh aber dann noch nicht, warum ich eine Funktion oder Prozedur ueberhaupt publishen kann ... bei Properties mit komplexen Typen (z.B. Records) weigert sich der Compiler ja auch ...

Danke!

[m.fuchs]

Diesem Problem sah ich mich vor zwei Jahren auch gegenüber (http://www.lazarusforum.de/viewtopic.php?f=10&t=4322) ohne eine Lösung gefunden zu haben.
Dann habe ich noch einmal darüber nachgedacht und mir fiel ein, dass FPCUnit ja auch nach diesem Prinzip arbeitet. Ein Testcase ist eine Klasse mit beliebig vielen und beliebig genannten Methoden die publishedsind. Und die werden alle aufgerufen.

Beim Stöbern durch den FPCUnit-Quellcode, fand ich dann in der Unit Testutils folgenden Code:

Code: Alles auswählen

// been to the dentist and suffered a lot
// Hack Alert! see objpas.inc
//  Get a list of published methods for a given class or object
procedure GetMethodList( AObject: TObject; AList: TStrings );
begin
  GetMethodList( AObject.ClassType, AList );
end;  
 
procedure GetMethodList(AClass: TClass; AList: TStrings);
type
  TMethodNameRec = packed record
    name : pshortstring;
    addr : pointer;
  end;
 
  TMethodNameTable = packed record
    count : dword;
    entries : packed array[0..0] of TMethodNameRec;
  end;
 
  pMethodNameTable =  ^TMethodNameTable;
 
var
  methodTable : pMethodNameTable;
  i : dword;
  vmt: TClass;
  idx: integer;
begin
  AList.Clear;
  vmt := aClass;
  while assigned(vmt) do
  begin
    methodTable := pMethodNameTable((Pointer(vmt) + vmtMethodTable)^);
    if assigned(MethodTable) then
    begin
      for i := 0 to MethodTable^.count - 1 do
      begin
        idx := aList.IndexOf(MethodTable^.entries[i].name^);
        if (idx <> - 1) then
        //found overridden method so delete it
          aList.Delete(idx);
        aList.AddObject(MethodTable^.entries[i].name^, TObject(MethodTable^.entries[i].addr));
      end;
    end;
    vmt := pClass(pointer(vmt) + vmtParent)^;
  end;
end;

Ausprobiert habe ich das Faulheit nie, da ich mein ursprüngliches Problem anders (wenn auch nicht so elegant) gelöst hatte. Aber vielleicht hilft dir das weiter. Vielelicht sollte man auch mal vorschlagen, dass so ein Code in die entsprechende RTTI-Unit wandert.

[Eclipticon]

Hallo Michael,

vielen Dank fuer den Tip auf FPCUnit. Ich hab mir das ausgehend von deinem Codebeispiel angesehen und habe eine Methode dort etwas umgebaut:

Code: Alles auswählen

// Based on FPCUnit.TTestCase.RunTest
// See also http://www.lazarusforum.de/viewtopic.php?f=55&t=6568
procedure RunMethod(MyObject: TObject; const MethodName: string);
type
  TRunMethod = procedure of object;
var
  AMethod: TMethod;
  RunMethod: TRunMethod;
  PMethod: Pointer;
begin
  PMethod := MyObject.MethodAddress(MethodName);
  if (Assigned(PMethod)) then
  begin
    AMethod.Code := PMethod;
    AMethod.Data := MyObject;
    RunMethod := TRunMethod(AMethod);
    RunMethod;
  end
  else
  	raise Exception.Create('Method not found.');
end;

Scheint gut zu funktionieren ...