Testing TValue as Params

This commit is contained in:
Michael Schimmel
2025-07-28 00:55:39 +02:00
parent 1ddc295c9d
commit 75675b8dc1
4 changed files with 107 additions and 145 deletions
+66 -65
View File
@@ -5,12 +5,13 @@ interface
{$M+}
uses
System.TypInfo,
System.Rtti,
Myc.Data.Pipeline,
System.Classes;
type
TIndicatorFactoryProc<TParams, TValue, TResult> = reference to function(const Params: TParams): TConvertFunc<TValue, TResult>;
TIndicatorFactoryProc<TParams, TArgs, TResult> = reference to function(const Params: TParams): TConvertFunc<TArgs, TResult>;
(*
Sample definition of an indicator template:
@@ -65,23 +66,24 @@ type
TFieldDef = record
public
Identifier: String;
TypeName: String;
// The handle provides direct access to the type information of the field.
Handle: PTypeInfo;
end;
TFieldLayout = TArray<TFieldDef>;
// Interface for creating an indicator instance. Only contains functional aspects.
IIndicatorFactory = interface
function GetParams: TFieldLayout;
function GetArgs: TFieldLayout;
function GetResults: TFieldLayout;
function GetParamType: PTypeInfo;
function GetArgType: PTypeInfo;
function GetResultType: PTypeInfo;
function CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>;
// Provides the layout for the indicator's parameters, arguments, and results.
property Params: TFieldLayout read GetParams;
property Args: TFieldLayout read GetArgs;
property Results: TFieldLayout read GetResults;
// Provides direct access to the type information of parameters, arguments, and results.
property ParamType: PTypeInfo read GetParamType;
property ArgType: PTypeInfo read GetArgType;
property ResultType: PTypeInfo read GetResultType;
end;
TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory)
@@ -90,23 +92,21 @@ type
FName: String;
FShortName: String;
FHint: String;
FParams: TFieldLayout;
FArgs: TFieldLayout;
FResults: TFieldLayout;
class function LayoutFromRecordType(RecordType: TRttiType): TFieldLayout; static;
FParamType: PTypeInfo;
FArgType: PTypeInfo;
FResultType: PTypeInfo;
public
constructor Create(
const AFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
const AShortName, AName, AHint: String;
const AParams, AArgs, AResults: TFieldLayout
const AParamType, AArgType, AResultType: PTypeInfo
);
// IIndicatorFactory
function GetParams: TFieldLayout;
function GetArgs: TFieldLayout;
function GetResults: TFieldLayout;
function GetParamType: PTypeInfo;
function GetArgType: PTypeInfo;
function GetResultType: PTypeInfo;
function CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>; overload;
class function CreateFromTemplate<T>: TGenericIndicatorFactory;
@@ -165,8 +165,7 @@ var
implementation
uses
System.SysUtils,
System.TypInfo;
System.SysUtils;
constructor IndicatorNameAttribute.Create(const AShortName, AName: string);
begin
@@ -186,7 +185,7 @@ end;
constructor TGenericIndicatorFactory.Create(
const AFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
const AShortName, AName, AHint: String;
const AParams, AArgs, AResults: TFieldLayout
const AParamType, AArgType, AResultType: PTypeInfo
);
begin
inherited Create;
@@ -194,30 +193,9 @@ begin
FShortName := AShortName;
FName := AName;
FHint := AHint;
FParams := AParams;
FArgs := AArgs;
FResults := AResults;
end;
class function TGenericIndicatorFactory.LayoutFromRecordType(RecordType: TRttiType): TFieldLayout;
var
rttiRecordType: TRttiRecordType;
field: TRttiField;
i: Integer;
begin
if not RecordType.IsRecord then
raise EArgumentException.CreateFmt('Record type expected, but got %s', [RecordType.Name]);
rttiRecordType := RecordType as TRttiRecordType;
var fields := rttiRecordType.GetFields;
SetLength(Result, Length(fields));
i := 0;
for field in fields do
begin
Result[i].Identifier := field.Name;
Result[i].TypeName := field.FieldType.Name;
Inc(i);
end;
FParamType := AParamType;
FArgType := AArgType;
FResultType := AResultType;
end;
class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicatorFactory;
@@ -228,7 +206,6 @@ var
templateFactoryMethod: TRttiMethod;
factoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
shortName, name, hint: string;
paramsLayout, argsLayout, resultsLayout: TFieldLayout;
begin
// This function creates a generic factory from a template class.
// It uses RTTI to find the necessary types by inspecting the factory method signature,
@@ -300,11 +277,6 @@ begin
Assert(argsType.TypeKind = tkRecord);
Assert(resultType.TypeKind = tkRecord);
// Generate layouts from RTTI types.
paramsLayout := LayoutFromRecordType(paramsType);
argsLayout := LayoutFromRecordType(argsType);
resultsLayout := LayoutFromRecordType(resultType);
// Extract metadata from attributes on the template type T.
shortName := '';
name := '';
@@ -349,8 +321,6 @@ begin
// The parameter for this 'Invoke' call is the TParams record.
// Wrap the incoming TValue 'Params' into a TValue for the call.
var factoryParamTypeInfo := currentFactoryInvoke.GetParameters[0].ParamType.Handle;
Assert(factoryParamTypeInfo = paramsType.Handle);
// This call returns the worker proc (e.g., a TIndicatorProc<TValue, TResult>) as a TValue.
var workerProc := currentFactoryInvoke.Invoke(factoryProc, [Params]);
@@ -369,23 +339,23 @@ begin
end;
end;
// Create the final factory instance with all layouts and extracted metadata.
Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsLayout, argsLayout, resultsLayout);
// Create the final factory instance with all type handles and extracted metadata.
Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsType.Handle, argsType.Handle, resultType.Handle);
end;
function TGenericIndicatorFactory.GetParams: TFieldLayout;
function TGenericIndicatorFactory.GetParamType: PTypeInfo;
begin
Result := FParams;
Result := FParamType;
end;
function TGenericIndicatorFactory.GetArgs: TFieldLayout;
function TGenericIndicatorFactory.GetArgType: PTypeInfo;
begin
Result := FArgs;
Result := FArgType;
end;
function TGenericIndicatorFactory.GetResults: TFieldLayout;
function TGenericIndicatorFactory.GetResultType: PTypeInfo;
begin
Result := FResults;
Result := FResultType;
end;
function TGenericIndicatorFactory.CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>;
@@ -451,6 +421,36 @@ procedure TIndicatorRegistry.LogRegistry(const Log: TStrings);
var
item: TItem;
// Generates a field layout from a type information handle.
function LayoutFromTypeInfo(TypeInfo: PTypeInfo): TFieldLayout;
var
Ctx: TRttiContext;
rttiType: TRttiType;
rttiRecordType: TRttiRecordType;
field: TRttiField;
i: Integer;
begin
// This helper uses RTTI to inspect the record type and build the layout.
Ctx := TRttiContext.Create;
rttiType := Ctx.GetType(TypeInfo);
if not rttiType.IsRecord then
begin
SetLength(Result, 0);
exit;
end;
rttiRecordType := rttiType as TRttiRecordType;
var fields := rttiRecordType.GetFields;
SetLength(Result, Length(fields));
i := 0;
for field in fields do
begin
Result[i].Identifier := field.Name;
Result[i].Handle := field.FieldType.Handle;
Inc(i);
end;
end;
procedure DoLog(const Txt: String);
begin
Log.Add(Txt);
@@ -468,7 +468,7 @@ var
else
begin
for field in Layout do
DoLog(Format(' - %s: %s', [field.Identifier, field.TypeName]));
DoLog(Format(' - %s: %s', [field.Identifier, field.Handle.Name]));
end;
end;
@@ -493,9 +493,10 @@ begin
if not item.Hint.IsEmpty then
DoLog(Format(' Hint: %s', [item.Hint]));
LogLayout('Params', item.Factory.Params);
LogLayout('Args', item.Factory.Args);
LogLayout('Result', item.Factory.Results);
// Generate layouts on-the-fly from the factory's type info.
LogLayout('Params', LayoutFromTypeInfo(item.Factory.ParamType));
LogLayout('Args', LayoutFromTypeInfo(item.Factory.ArgType));
LogLayout('Result', LayoutFromTypeInfo(item.Factory.ResultType));
DoLog('');
end;
end;