[fpc-devel] How to call virtual StoredProc from PropInfo

[Ondrej Pokorny]

Hello!

For the Lazarus IDE I need to call the stored function from a property.

I was able to get the pointer of a static procedure and call it:

function GetStoredFunction(APropInfo: PPropInfo; AInstance: 
TPersistent): CodePointer;
var
   StoredProcType: Byte;
begin
   StoredProcType := ((APropInfo^.PropProcs shr 4) and 3);
   case StoredProcType of
     ptStatic: Result:=APropInfo^.StoredProc; // this is fine
     ptVirtual: Result:=APropInfo^.StoredProc; // this is obviously 
wrong - it has to be instance-dependent
   else
     Result:=nil;
   end;
end;

type
   TBoolFunc = function: Boolean of object;
function CallStoredFunction(APropInfo: PPropInfo; AInstance: 
TPersistent): Boolean;
var
   Func: TMethod;
   FFunc: TBoolFunc;
begin
   Func.Code := GetStoredFunction(APropInfo, AInstance);
   Func.Data := AInstance;
   FFunc := TBoolFunc(Func);
   Result := FFunc();
end;

But this approach is obviously wrong for virtual stored properties 
because the StoredProc cannot point to the actual virtual/overridden 
method.

My question is, how can I call a virtual stored procedure from PropInfo?

+ Test project attached :)

Ondrej

-------------- next part --------------
program StoredProcVirtual;

uses
  Classes, TypInfo;

type
  TMyObj = class(TPersistent)
  private
    fPropStatic: Integer;
    fPropVirtual: Integer;
    function PropStaticStored: Boolean;
    function PropVirtualStored: Boolean; virtual;
  published
    property PropStatic: Integer read fPropStatic write fPropStatic stored PropStaticStored;
    property PropVirtual: Integer read fPropVirtual write fPropVirtual stored PropVirtualStored;
  end;

{ TMyObj }

function TMyObj.PropStaticStored: Boolean;
begin
  Result := False;
end;

function TMyObj.PropVirtualStored: Boolean;
begin
  Result := False;
end;

function GetStoredFunction(APropInfo: PPropInfo; AInstance: TPersistent): CodePointer;
var
  StoredProcType: Byte;
begin
  StoredProcType := ((APropInfo^.PropProcs shr 4) and 3);
  case StoredProcType of
    ptStatic: Result:=APropInfo^.StoredProc; // this is fine
    ptVirtual: Result:=APropInfo^.StoredProc; // this is obviously wrong - it has to be instance-dependent
  else
    Result:=nil;
  end;
end;

type
  TBoolFunc = function: Boolean of object;
function CallStoredFunction(APropInfo: PPropInfo; AInstance: TPersistent): Boolean;
var
  Func: TMethod;
  FFunc: TBoolFunc;
begin
  Func.Code := GetStoredFunction(APropInfo, AInstance);
  Func.Data := AInstance;
  FFunc := TBoolFunc(Func);
  Result := FFunc();
end;

var
  X: TMyObj;
  PropStatic, PropVirtual: PPropInfo;
begin
  X := TMyObj.Create;
  PropStatic := TypInfo.GetPropInfo(X, 'PropStatic');
  PropVirtual := TypInfo.GetPropInfo(X, 'PropVirtual');

  Assert(not CallStoredFunction(PropStatic, X)); // OK
  Assert(not CallStoredFunction(PropVirtual, X)); // Error
end.