Michael Schimmel
135 lines
4.3 KiB
ObjectPascal
135 lines
4.3 KiB
ObjectPascal
unit TestMethodCallFromRecordParams;
|
|
|
|
interface
|
|
|
|
// We need RTTI here!
|
|
{$M+}
|
|
|
|
uses
|
|
System.Rtti,
|
|
System.SysUtils,
|
|
System.TypInfo,
|
|
System.Classes,
|
|
Myc.Data.Records;
|
|
|
|
type
|
|
InvokeAttribute = class(TCustomAttribute);
|
|
FactoryAttribute = class(TCustomAttribute);
|
|
|
|
TMyProc<TValue, TResult> = reference to function(const [ref] Value: TValue): TResult;
|
|
TFactoryProc<TParams, TValue, TResult> = reference to function(const [ref] Params: TParams): TMyProc<TValue, TResult>;
|
|
|
|
TMyWorker = record
|
|
type
|
|
TParams = record
|
|
Log: Int64;
|
|
text: String;
|
|
end;
|
|
|
|
TValue = record
|
|
xyz: Double;
|
|
end;
|
|
|
|
TResult = record
|
|
val: Int64;
|
|
desc: String;
|
|
end;
|
|
|
|
[Factory]
|
|
class function CreateFactory: TFactoryProc<TParams, TValue, TResult>; static;
|
|
end;
|
|
|
|
procedure Test1(const Log: TStrings);
|
|
|
|
implementation
|
|
|
|
class function TMyWorker.CreateFactory: TFactoryProc<TParams, TValue, TResult>;
|
|
begin
|
|
Result :=
|
|
function(const [ref] Params: TParams): TMyProc<TValue, TResult>
|
|
begin
|
|
var Log := TStrings(Params.Log);
|
|
var text := Params.text;
|
|
|
|
Result :=
|
|
function(const [ref] Value: TValue): TResult
|
|
begin
|
|
// Use Format to avoid locale issues with float conversion
|
|
Log.Add(Format('Val=%f (...%s)', [Value.xyz, text]));
|
|
Result.desc := 'done';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
type
|
|
TInvokeProc = reference to procedure(const Value, Res: TDataRecord);
|
|
|
|
function CreateInvoker(Ctx: TRttiContext; CallFunc: TValue): TInvokeProc;
|
|
begin
|
|
var rttiMyProc := Ctx.GetType(CallFunc.TypeInfo);
|
|
var workerInvokeMethod := rttiMyProc.GetMethod('Invoke');
|
|
var workerParamTypeInfo := workerInvokeMethod.GetParameters[0].ParamType.Handle;
|
|
var args: array[0..0] of TValue;
|
|
Result :=
|
|
procedure(const Value, Res: TDataRecord)
|
|
begin
|
|
TValue.MakeWithoutCopy(Value.RawData, workerParamTypeInfo, args[0], true);
|
|
workerInvokeMethod.Invoke(CallFunc, args).ExtractRawData(Res.RawData);
|
|
end;
|
|
end;
|
|
|
|
procedure Test1(const Log: TStrings);
|
|
begin
|
|
var params := TDataRecord.FromRecord<TMyWorker.TParams>;
|
|
params.SetValue<Int64>('Log', Int64(Log));
|
|
params.SetValue<String>('text', 'The quick brown fox jumps...');
|
|
|
|
var workerValueParam := TDataRecord.FromRecord<TMyWorker.TValue>;
|
|
workerValueParam.SetValue<Double>('xyz', 3.14159);
|
|
|
|
var finalResultRec := TDataRecord.FromRecord<TMyWorker.TResult>;
|
|
|
|
var invoke: TInvokeProc;
|
|
|
|
////////////
|
|
|
|
var Ctx := TRttiContext.Create;
|
|
var rttiType := Ctx.GetType(TypeInfo(TMyWorker));
|
|
|
|
// Find and invoke the method marked with [Factory] attribute.
|
|
for var method in rttiType.GetMethods do
|
|
begin
|
|
if method.HasAttribute<FactoryAttribute> then
|
|
begin
|
|
// First invocation returns the factory procedure itself (an interface).
|
|
var createFuncValue := method.Invoke(TValue.Empty, []);
|
|
// Anonymous methods are interfaces, so we get the TRttiInterfaceType.
|
|
var rttiCreateFunc := Ctx.GetType(createFuncValue.TypeInfo) as TRttiInterfaceType;
|
|
// The actual code is in the 'Invoke' method of that interface.
|
|
var factoryInvokeMethod := rttiCreateFunc.GetMethod('Invoke');
|
|
|
|
// Prepare the argument for the factory proc: a pointer to 'params'
|
|
var factoryArg: array[0..0] of TValue;
|
|
var factoryParamTypeInfo := factoryInvokeMethod.GetParameters[0].ParamType.Handle;
|
|
TValue.Make(params.RawData, factoryParamTypeInfo, factoryArg[0]);
|
|
|
|
var myProcValue := factoryInvokeMethod.Invoke(createFuncValue, factoryArg);
|
|
|
|
invoke := CreateInvoker(Ctx, myProcValue);
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
//////////
|
|
|
|
Assert(Assigned(invoke));
|
|
|
|
invoke(workerValueParam, finalResultRec);
|
|
|
|
var desc := finalResultRec.GetValue<String>('desc');
|
|
Log.Add('Final result description: ' + desc);
|
|
Assert(desc = 'done');
|
|
end;
|
|
|
|
end.
|