Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Type System

Browse Source
This commit is contained in:
Michael Schimmel
2025-08-26 11:06:35 +02:00
parent e4681e2bf7
commit 5adbe67d0b
15 changed files with 1426 additions and 612 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Data/Myc.Data.Types.Arrays.pas
+35 -35
View File
@@ -9,7 +9,7 @@ uses
type type
// Implements the array data type. // Implements the array data type.
TDataArrayType = class(TInterfacedObject, IDataType, IDataArrayType) TImplDataArrayType = class(TInterfacedObject, IDataType, IDataArrayType)
private private
FElementType: IDataType; FElementType: IDataType;
FEmptyValue: IDataArrayValue; // Cached empty array value for this type FEmptyValue: IDataArrayValue; // Cached empty array value for this type
@@ -29,7 +29,7 @@ uses
type type
// Implements the array data value. // Implements the array data value.
TDataArrayValue = class(TInterfacedObject, IDataValue, IDataArrayValue) TImplDataArrayValue = class(TInterfacedObject, IDataValue, IDataArrayValue)
private private
FArrayType: IDataArrayType; FArrayType: IDataArrayType;
FItems: TArray<IDataValue>; FItems: TArray<IDataValue>;
@@ -43,7 +43,7 @@ type
end; end;
// Optimized implementation for an array with 0 elements. // Optimized implementation for an array with 0 elements.
TDataArrayValue0 = class(TInterfacedObject, IDataValue, IDataArrayValue) TImplDataArrayValue0 = class(TInterfacedObject, IDataValue, IDataArrayValue)
strict private strict private
class var class var
FEmptyTValue: TValue; // Singleton TValue for an empty array FEmptyTValue: TValue; // Singleton TValue for an empty array
@@ -60,7 +60,7 @@ type
end; end;
// Optimized implementation for an array with 1 element. // Optimized implementation for an array with 1 element.
TDataArrayValue1 = class(TInterfacedObject, IDataValue, IDataArrayValue) TImplDataArrayValue1 = class(TInterfacedObject, IDataValue, IDataArrayValue)
private private
FArrayType: IDataArrayType; FArrayType: IDataArrayType;
FItem0: IDataValue; FItem0: IDataValue;
@@ -73,9 +73,9 @@ type
constructor Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue); constructor Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
end; end;
{ TDataArrayValue (generic implementation for N > 1 elements) } { TImplDataArrayValue (generic implementation for N > 1 elements) }
constructor TDataArrayValue.Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue); constructor TImplDataArrayValue.Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
var var
i: Integer; i: Integer;
begin begin
@@ -86,12 +86,12 @@ begin
FItems[i] := AItems[i]; FItems[i] := AItems[i];
end; end;
function TDataArrayValue.GetDataType: IDataType; function TImplDataArrayValue.GetDataType: IDataType;
begin begin
Result := FArrayType; Result := FArrayType;
end; end;
function TDataArrayValue.GetAsString: string; function TImplDataArrayValue.GetAsString: string;
var var
sb: TStringBuilder; sb: TStringBuilder;
i: Integer; i: Integer;
@@ -112,7 +112,7 @@ begin
end; end;
end; end;
function TDataArrayValue.AsTValue: TValue; function TImplDataArrayValue.AsTValue: TValue;
var var
tvalueArray: TArray<TValue>; tvalueArray: TArray<TValue>;
i: Integer; i: Integer;
@@ -123,70 +123,70 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray); Result := TValue.From<TArray<TValue>>(tvalueArray);
end; end;
function TDataArrayValue.GetElementCount: Integer; function TImplDataArrayValue.GetElementCount: Integer;
begin begin
Result := Length(FItems); Result := Length(FItems);
end; end;
function TDataArrayValue.GetItem(Idx: Integer): IDataValue; function TImplDataArrayValue.GetItem(Idx: Integer): IDataValue;
begin begin
Result := FItems[Idx]; Result := FItems[Idx];
end; end;
{ TDataArrayValue0 } { TImplDataArrayValue0 }
class constructor TDataArrayValue0.CreateClass; class constructor TImplDataArrayValue0.CreateClass;
begin begin
// Create a singleton TValue representing an empty dynamic array. // Create a singleton TValue representing an empty dynamic array.
FEmptyTValue := TValue.From<TArray<TValue>>([]); FEmptyTValue := TValue.From<TArray<TValue>>([]);
end; end;
constructor TDataArrayValue0.Create(const AArrayType: IDataArrayType); constructor TImplDataArrayValue0.Create(const AArrayType: IDataArrayType);
begin begin
inherited Create; inherited Create;
FArrayType := AArrayType; FArrayType := AArrayType;
end; end;
function TDataArrayValue0.GetAsString: string; function TImplDataArrayValue0.GetAsString: string;
begin begin
Result := '[]'; Result := '[]';
end; end;
function TDataArrayValue0.AsTValue: TValue; function TImplDataArrayValue0.AsTValue: TValue;
begin begin
Result := FEmptyTValue; Result := FEmptyTValue;
end; end;
function TDataArrayValue0.GetDataType: IDataType; function TImplDataArrayValue0.GetDataType: IDataType;
begin begin
Result := FArrayType; Result := FArrayType;
end; end;
function TDataArrayValue0.GetElementCount: Integer; function TImplDataArrayValue0.GetElementCount: Integer;
begin begin
Result := 0; Result := 0;
end; end;
function TDataArrayValue0.GetItem(Idx: Integer): IDataValue; function TImplDataArrayValue0.GetItem(Idx: Integer): IDataValue;
begin begin
raise EArgumentException.Create('Index out of bounds'); raise EArgumentException.Create('Index out of bounds');
end; end;
{ TDataArrayValue1 } { TImplDataArrayValue1 }
constructor TDataArrayValue1.Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue); constructor TImplDataArrayValue1.Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
begin begin
inherited Create; inherited Create;
FArrayType := AArrayType; FArrayType := AArrayType;
FItem0 := AItems[0]; FItem0 := AItems[0];
end; end;
function TDataArrayValue1.GetAsString: string; function TImplDataArrayValue1.GetAsString: string;
begin begin
Result := '[' + FItem0.AsString + ']'; Result := '[' + FItem0.AsString + ']';
end; end;
function TDataArrayValue1.AsTValue: TValue; function TImplDataArrayValue1.AsTValue: TValue;
var var
tvalueArray: TArray<TValue>; tvalueArray: TArray<TValue>;
begin begin
@@ -195,17 +195,17 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray); Result := TValue.From<TArray<TValue>>(tvalueArray);
end; end;
function TDataArrayValue1.GetDataType: IDataType; function TImplDataArrayValue1.GetDataType: IDataType;
begin begin
Result := FArrayType; Result := FArrayType;
end; end;
function TDataArrayValue1.GetElementCount: Integer; function TImplDataArrayValue1.GetElementCount: Integer;
begin begin
Result := 1; Result := 1;
end; end;
function TDataArrayValue1.GetItem(Idx: Integer): IDataValue; function TImplDataArrayValue1.GetItem(Idx: Integer): IDataValue;
begin begin
case Idx of case Idx of
0: Result := FItem0; 0: Result := FItem0;
@@ -214,16 +214,16 @@ begin
end; end;
end; end;
{ TDataArrayType } { TImplDataArrayType }
constructor TDataArrayType.Create(const AElementType: IDataType); constructor TImplDataArrayType.Create(const AElementType: IDataType);
begin begin
inherited Create; inherited Create;
FElementType := AElementType; FElementType := AElementType;
FEmptyValue := TDataArrayValue0.Create(Self); FEmptyValue := TImplDataArrayValue0.Create(Self);
end; end;
function TDataArrayType.CreateValue(const AItems: array of IDataValue): IDataArrayValue; function TImplDataArrayType.CreateValue(const AItems: array of IDataValue): IDataArrayValue;
var var
item: IDataValue; item: IDataValue;
i: Integer; i: Integer;
@@ -242,24 +242,24 @@ begin
// Use optimized implementations for arrays with 0 or 1 elements. // Use optimized implementations for arrays with 0 or 1 elements.
case Length(AItems) of case Length(AItems) of
0: Result := FEmptyValue; 0: Result := FEmptyValue;
1: Result := TDataArrayValue1.Create(Self, AItems); 1: Result := TImplDataArrayValue1.Create(Self, AItems);
else else
// Use the generic implementation for arrays with more than 1 element. // Use the generic implementation for arrays with more than 1 element.
Result := TDataArrayValue.Create(Self, AItems); Result := TImplDataArrayValue.Create(Self, AItems);
end; end;
end; end;
function TDataArrayType.GetElementType: IDataType; function TImplDataArrayType.GetElementType: IDataType;
begin begin
Result := FElementType; Result := FElementType;
end; end;
function TDataArrayType.GetName: String; function TImplDataArrayType.GetName: String;
begin begin
Result := Format('Array<%s>', [FElementType.Name]); Result := Format('Array<%s>', [FElementType.Name]);
end; end;
function TDataArrayType.GetKind: TDataKind; function TImplDataArrayType.GetKind: TDataKind;
begin begin
Result := dkArray; Result := dkArray;
end; end;
Src/Data/Myc.Data.Types.Enum.pas
+19 -19
View File
@@ -8,7 +8,7 @@ uses
Myc.Data.Types; Myc.Data.Types;
type type
TDataEnumType = class(TInterfacedObject, IDataEnumType) TImplDataEnumType = class(TInterfacedObject, IDataEnumType)
private private
FName: string; FName: string;
FIdentifiers: TArray<string>; FIdentifiers: TArray<string>;
@@ -31,7 +31,7 @@ uses
System.Rtti; System.Rtti;
type type
TDataEnumValue = class(TInterfacedObject, IDataEnumValue) TImplDataEnumValue = class(TInterfacedObject, IDataEnumValue)
private private
FDataType: IDataEnumType; FDataType: IDataEnumType;
FValue: Integer; FValue: Integer;
@@ -43,9 +43,9 @@ type
constructor Create(const ADataType: IDataEnumType; const AValue: Integer); constructor Create(const ADataType: IDataEnumType; const AValue: Integer);
end; end;
{ TDataEnumType } { TImplDataEnumType }
constructor TDataEnumType.Create(const AName: string; const AIdentifiers: array of string); constructor TImplDataEnumType.Create(const AName: string; const AIdentifiers: array of string);
var var
i: Integer; i: Integer;
begin begin
@@ -62,46 +62,46 @@ begin
end; end;
end; end;
destructor TDataEnumType.Destroy; destructor TImplDataEnumType.Destroy;
begin begin
FIdentifierMap.Free; FIdentifierMap.Free;
inherited; inherited;
end; end;
function TDataEnumType.GetName: String; function TImplDataEnumType.GetName: String;
begin begin
Result := FName; Result := FName;
end; end;
function TDataEnumType.GetKind: TDataKind; function TImplDataEnumType.GetKind: TDataKind;
begin begin
Result := dkEnum; Result := dkEnum;
end; end;
function TDataEnumType.GetIdentifier(Idx: Integer): string; function TImplDataEnumType.GetIdentifier(Idx: Integer): string;
begin begin
Result := FIdentifiers[Idx]; Result := FIdentifiers[Idx];
end; end;
function TDataEnumType.GetIdentifierCount: Integer; function TImplDataEnumType.GetIdentifierCount: Integer;
begin begin
Result := Length(FIdentifiers); Result := Length(FIdentifiers);
end; end;
function TDataEnumType.IndexOf(const AIdentifier: string): Integer; function TImplDataEnumType.IndexOf(const AIdentifier: string): Integer;
begin begin
if not FIdentifierMap.TryGetValue(AIdentifier, Result) then if not FIdentifierMap.TryGetValue(AIdentifier, Result) then
Result := -1; Result := -1;
end; end;
function TDataEnumType.CreateValue(const AValue: Integer): IDataEnumValue; function TImplDataEnumType.CreateValue(const AValue: Integer): IDataEnumValue;
begin begin
if (AValue < 0) or (AValue >= Length(FIdentifiers)) then if (AValue < 0) or (AValue >= Length(FIdentifiers)) then
raise EArgumentException.Create('Invalid enum value'); raise EArgumentException.Create('Invalid enum value');
Result := TDataEnumValue.Create(Self, AValue); Result := TImplDataEnumValue.Create(Self, AValue);
end; end;
function TDataEnumType.CreateValue(const AIdentifier: string): IDataEnumValue; function TImplDataEnumType.CreateValue(const AIdentifier: string): IDataEnumValue;
var var
idx: Integer; idx: Integer;
begin begin
@@ -111,30 +111,30 @@ begin
Result := CreateValue(idx); Result := CreateValue(idx);
end; end;
{ TDataEnumValue } { TImplDataEnumValue }
constructor TDataEnumValue.Create(const ADataType: IDataEnumType; const AValue: Integer); constructor TImplDataEnumValue.Create(const ADataType: IDataEnumType; const AValue: Integer);
begin begin
FDataType := ADataType; FDataType := ADataType;
FValue := AValue; FValue := AValue;
end; end;
function TDataEnumValue.GetDataType: IDataType; function TImplDataEnumValue.GetDataType: IDataType;
begin begin
Result := FDataType; Result := FDataType;
end; end;
function TDataEnumValue.GetAsString: string; function TImplDataEnumValue.GetAsString: string;
begin begin
Result := FDataType.Identifiers[FValue]; Result := FDataType.Identifiers[FValue];
end; end;
function TDataEnumValue.GetValue: Integer; function TImplDataEnumValue.GetValue: Integer;
begin begin
Result := FValue; Result := FValue;
end; end;
function TDataEnumValue.AsTValue: TValue; function TImplDataEnumValue.AsTValue: TValue;
begin begin
Result := TValue.From<Integer>(FValue); Result := TValue.From<Integer>(FValue);
end; end;
Src/Data/Myc.Data.Types.Float.pas
+34 -34
View File
@@ -8,7 +8,7 @@ uses
type type
// Implements the float data type. // Implements the float data type.
TDataFloatType = class(TInterfacedObject, IDataType, IDataFloatType) TImplDataFloatType = class(TInterfacedObject, IDataType, IDataFloatType)
strict private strict private
class var class var
FSingleton: IDataFloatType; FSingleton: IDataFloatType;
@@ -30,7 +30,7 @@ uses
type type
// Implements the float data value. // Implements the float data value.
TDataFloatValue = class(TInterfacedObject, IDataValue, IDataFloatValue) TImplDataFloatValue = class(TInterfacedObject, IDataValue, IDataFloatValue)
private private
FValue: Double; FValue: Double;
public public
@@ -46,7 +46,7 @@ type
end; end;
// Special implementation for the value 0.0 (Singleton) // Special implementation for the value 0.0 (Singleton)
TDataFloatValueZero = class(TInterfacedObject, IDataValue, IDataFloatValue) TImplDataFloatValueZero = class(TInterfacedObject, IDataValue, IDataFloatValue)
strict private strict private
class var class var
FValue: TValue; FValue: TValue;
@@ -59,7 +59,7 @@ type
end; end;
// Special implementation for NaN (Not a Number) (Singleton) // Special implementation for NaN (Not a Number) (Singleton)
TDataFloatValueNaN = class(TInterfacedObject, IDataValue, IDataFloatValue) TImplDataFloatValueNaN = class(TInterfacedObject, IDataValue, IDataFloatValue)
strict private strict private
class var class var
FValue: TValue; FValue: TValue;
@@ -71,108 +71,108 @@ type
function AsTValue: TValue; function AsTValue: TValue;
end; end;
{ TDataFloatValue } { TImplDataFloatValue }
constructor TDataFloatValue.Create(const AValue: Double); constructor TImplDataFloatValue.Create(const AValue: Double);
begin begin
inherited Create; inherited Create;
FValue := AValue; FValue := AValue;
end; end;
function TDataFloatValue.GetDataType: IDataType; function TImplDataFloatValue.GetDataType: IDataType;
begin begin
Result := TDataFloatType.Singleton; Result := TImplDataFloatType.Singleton;
end; end;
function TDataFloatValue.GetAsString: string; function TImplDataFloatValue.GetAsString: string;
begin begin
Result := FloatToStr(FValue); Result := FloatToStr(FValue);
end; end;
function TDataFloatValue.AsTValue: TValue; function TImplDataFloatValue.AsTValue: TValue;
begin begin
Result := TValue.From<Double>(FValue); Result := TValue.From<Double>(FValue);
end; end;
function TDataFloatValue.GetValue: Double; function TImplDataFloatValue.GetValue: Double;
begin begin
Result := FValue; Result := FValue;
end; end;
{ TDataFloatValueZero } { TImplDataFloatValueZero }
class constructor TDataFloatValueZero.CreateClass; class constructor TImplDataFloatValueZero.CreateClass;
begin begin
FValue := TValue.From<Double>(0.0); FValue := TValue.From<Double>(0.0);
end; end;
function TDataFloatValueZero.GetAsString: string; function TImplDataFloatValueZero.GetAsString: string;
begin begin
Result := '0'; Result := '0';
end; end;
function TDataFloatValueZero.GetDataType: IDataType; function TImplDataFloatValueZero.GetDataType: IDataType;
begin begin
Result := TDataFloatType.Singleton; Result := TImplDataFloatType.Singleton;
end; end;
function TDataFloatValueZero.GetValue: Double; function TImplDataFloatValueZero.GetValue: Double;
begin begin
Result := 0.0; Result := 0.0;
end; end;
function TDataFloatValueZero.AsTValue: TValue; function TImplDataFloatValueZero.AsTValue: TValue;
begin begin
Result := FValue; Result := FValue;
end; end;
{ TDataFloatValueNaN } { TImplDataFloatValueNaN }
class constructor TDataFloatValueNaN.CreateClass; class constructor TImplDataFloatValueNaN.CreateClass;
begin begin
FValue := TValue.From<Double>(NaN); FValue := TValue.From<Double>(NaN);
end; end;
function TDataFloatValueNaN.GetAsString: string; function TImplDataFloatValueNaN.GetAsString: string;
begin begin
Result := 'NaN'; Result := 'NaN';
end; end;
function TDataFloatValueNaN.GetDataType: IDataType; function TImplDataFloatValueNaN.GetDataType: IDataType;
begin begin
Result := TDataFloatType.Singleton; Result := TImplDataFloatType.Singleton;
end; end;
function TDataFloatValueNaN.GetValue: Double; function TImplDataFloatValueNaN.GetValue: Double;
begin begin
Result := NaN; Result := NaN;
end; end;
function TDataFloatValueNaN.AsTValue: TValue; function TImplDataFloatValueNaN.AsTValue: TValue;
begin begin
Result := FValue; Result := FValue;
end; end;
{ TDataFloatType } { TImplDataFloatType }
class constructor TDataFloatType.CreateClass; class constructor TImplDataFloatType.CreateClass;
begin begin
FSingleton := TDataFloatType.Create; FSingleton := TImplDataFloatType.Create;
FZero := TDataFloatValueZero.Create; FZero := TImplDataFloatValueZero.Create;
FNaN := TDataFloatValueNaN.Create; FNaN := TImplDataFloatValueNaN.Create;
end; end;
function TDataFloatType.GetName: String; function TImplDataFloatType.GetName: String;
begin begin
Result := 'Float'; Result := 'Float';
end; end;
function TDataFloatType.GetKind: TDataKind; function TImplDataFloatType.GetKind: TDataKind;
begin begin
Result := dkFloat; Result := dkFloat;
end; end;
function TDataFloatType.CreateValue(Init: Double): IDataFloatValue; function TImplDataFloatType.CreateValue(Init: Double): IDataFloatValue;
begin begin
// Return singleton instances for 0.0 and NaN to avoid unnecessary allocations. // Return singleton instances for 0.0 and NaN to avoid unnecessary allocations.
if (Init = 0.0) then if (Init = 0.0) then
@@ -180,7 +180,7 @@ begin
else if IsNaN(Init) then else if IsNaN(Init) then
Result := FNaN Result := FNaN
else else
Result := TDataFloatValue.Create(Init); Result := TImplDataFloatValue.Create(Init);
end; end;
end. end.
Src/Data/Myc.Data.Types.Method.pas
+21 -21
View File
@@ -9,7 +9,7 @@ uses
type type
// Implements the IDataMethodType interface. // Implements the IDataMethodType interface.
TDataMethodType = class(TInterfacedObject, IDataMethodType) TImplDataMethodType = class(TInterfacedObject, IDataMethodType)
private private
FArgType: IDataType; FArgType: IDataType;
FResultType: IDataType; FResultType: IDataType;
@@ -17,7 +17,7 @@ type
function GetKind: TDataKind; function GetKind: TDataKind;
function GetArgType: IDataType; function GetArgType: IDataType;
function GetResultType: IDataType; function GetResultType: IDataType;
function CreateValue(const AValue: TMethodProc): IDataMethodValue; function CreateValue(const AValue: TDataMethodProc): IDataMethodValue;
public public
constructor Create(const AArgType, AResultType: IDataType); constructor Create(const AArgType, AResultType: IDataType);
end; end;
@@ -29,51 +29,51 @@ uses
type type
// Implements the IDataMethodValue interface. // Implements the IDataMethodValue interface.
TDataMethodValue = class(TInterfacedObject, IDataMethodValue) TImplDataMethodValue = class(TInterfacedObject, IDataMethodValue)
private private
FDataType: IDataMethodType; FDataType: IDataMethodType;
FValue: TMethodProc; FValue: TDataMethodProc;
function GetDataType: IDataType; function GetDataType: IDataType;
function GetAsString: string; function GetAsString: string;
function AsTValue: TValue; function AsTValue: TValue;
function GetValue: TMethodProc; function GetValue: TDataMethodProc;
public public
constructor Create(const ADataType: IDataMethodType; const AValue: TMethodProc); constructor Create(const ADataType: IDataMethodType; const AValue: TDataMethodProc);
end; end;
{ TDataMethodType } { TImplDataMethodType }
constructor TDataMethodType.Create(const AArgType, AResultType: IDataType); constructor TImplDataMethodType.Create(const AArgType, AResultType: IDataType);
begin begin
inherited Create; inherited Create;
FArgType := AArgType; FArgType := AArgType;
FResultType := AResultType; FResultType := AResultType;
end; end;
function TDataMethodType.CreateValue(const AValue: TMethodProc): IDataMethodValue; function TImplDataMethodType.CreateValue(const AValue: TDataMethodProc): IDataMethodValue;
begin begin
if not Assigned(AValue) then if not Assigned(AValue) then
raise EArgumentException.Create('AValue'); raise EArgumentException.Create('AValue');
Result := TDataMethodValue.Create(Self, AValue); Result := TImplDataMethodValue.Create(Self, AValue);
end; end;
function TDataMethodType.GetArgType: IDataType; function TImplDataMethodType.GetArgType: IDataType;
begin begin
Result := FArgType; Result := FArgType;
end; end;
function TDataMethodType.GetResultType: IDataType; function TImplDataMethodType.GetResultType: IDataType;
begin begin
Result := FResultType; Result := FResultType;
end; end;
function TDataMethodType.GetKind: TDataKind; function TImplDataMethodType.GetKind: TDataKind;
begin begin
Result := dkMethod; Result := dkMethod;
end; end;
function TDataMethodType.GetName: String; function TImplDataMethodType.GetName: String;
var var
sb: TStringBuilder; sb: TStringBuilder;
argName, resultName: string; argName, resultName: string;
@@ -101,31 +101,31 @@ begin
end; end;
end; end;
{ TDataMethodValue } { TImplDataMethodValue }
constructor TDataMethodValue.Create(const ADataType: IDataMethodType; const AValue: TMethodProc); constructor TImplDataMethodValue.Create(const ADataType: IDataMethodType; const AValue: TDataMethodProc);
begin begin
inherited Create; inherited Create;
FDataType := ADataType; FDataType := ADataType;
FValue := AValue; FValue := AValue;
end; end;
function TDataMethodValue.GetDataType: IDataType; function TImplDataMethodValue.GetDataType: IDataType;
begin begin
Result := FDataType; Result := FDataType;
end; end;
function TDataMethodValue.GetAsString: string; function TImplDataMethodValue.GetAsString: string;
begin begin
Result := '<METHOD>'; Result := '<METHOD>';
end; end;
function TDataMethodValue.AsTValue: TValue; function TImplDataMethodValue.AsTValue: TValue;
begin begin
Result := TValue.From<TMethodProc>(FValue); Result := TValue.From<TDataMethodProc>(FValue);
end; end;
function TDataMethodValue.GetValue: TMethodProc; function TImplDataMethodValue.GetValue: TDataMethodProc;
begin begin
Result := FValue; Result := FValue;
end; end;
Src/Data/Myc.Data.Types.Ordinal.pas
+19 -19
View File
@@ -8,7 +8,7 @@ uses
type type
// Implements the ordinal data type. // Implements the ordinal data type.
TDataOrdinalType = class(TInterfacedObject, IDataType, IDataOrdinalType) TImplDataOrdinalType = class(TInterfacedObject, IDataType, IDataOrdinalType)
strict private strict private
class var class var
FSingleton: IDataOrdinalType; FSingleton: IDataOrdinalType;
@@ -28,7 +28,7 @@ uses
type type
// Implements the ordinal data value. // Implements the ordinal data value.
TDataOrdinalValue = class(TInterfacedObject, IDataValue, IDataOrdinalValue) TImplDataOrdinalValue = class(TInterfacedObject, IDataValue, IDataOrdinalValue)
private private
FValue: Int64; FValue: Int64;
public public
@@ -82,31 +82,31 @@ type
function AsTValue: TValue; function AsTValue: TValue;
end; end;
{ TDataOrdinalValue } { TImplDataOrdinalValue }
constructor TDataOrdinalValue.Create(const AValue: Int64); constructor TImplDataOrdinalValue.Create(const AValue: Int64);
begin begin
inherited Create; inherited Create;
FValue := AValue; FValue := AValue;
end; end;
function TDataOrdinalValue.GetDataType: IDataType; function TImplDataOrdinalValue.GetDataType: IDataType;
begin begin
Result := TDataOrdinalType.Singleton; Result := TImplDataOrdinalType.Singleton;
end; end;
function TDataOrdinalValue.GetAsString: string; function TImplDataOrdinalValue.GetAsString: string;
begin begin
Result := FValue.ToString; Result := FValue.ToString;
end; end;
function TDataOrdinalValue.AsTValue: TValue; function TImplDataOrdinalValue.AsTValue: TValue;
begin begin
// Convert Int64 to TValue // Convert Int64 to TValue
Result := TValue.From<Int64>(FValue); Result := TValue.From<Int64>(FValue);
end; end;
function TDataOrdinalValue.GetValue: Int64; function TImplDataOrdinalValue.GetValue: Int64;
begin begin
Result := FValue; Result := FValue;
end; end;
@@ -120,7 +120,7 @@ end;
function TDataOrdinalValueMinusOne.GetDataType: IDataType; function TDataOrdinalValueMinusOne.GetDataType: IDataType;
begin begin
Result := TDataOrdinalType.Singleton; Result := TImplDataOrdinalType.Singleton;
end; end;
function TDataOrdinalValueMinusOne.GetAsString: string; function TDataOrdinalValueMinusOne.GetAsString: string;
@@ -148,7 +148,7 @@ end;
function TDataOrdinalValueZero.GetDataType: IDataType; function TDataOrdinalValueZero.GetDataType: IDataType;
begin begin
Result := TDataOrdinalType.Singleton; Result := TImplDataOrdinalType.Singleton;
end; end;
function TDataOrdinalValueZero.GetAsString: string; function TDataOrdinalValueZero.GetAsString: string;
@@ -176,7 +176,7 @@ end;
function TDataOrdinalValueOne.GetDataType: IDataType; function TDataOrdinalValueOne.GetDataType: IDataType;
begin begin
Result := TDataOrdinalType.Singleton; Result := TImplDataOrdinalType.Singleton;
end; end;
function TDataOrdinalValueOne.GetAsString: string; function TDataOrdinalValueOne.GetAsString: string;
@@ -195,27 +195,27 @@ begin
Result := 1; Result := 1;
end; end;
{ TDataOrdinalType } { TImplDataOrdinalType }
class constructor TDataOrdinalType.CreateClass; class constructor TImplDataOrdinalType.CreateClass;
begin begin
FSingleton := TDataOrdinalType.Create; FSingleton := TImplDataOrdinalType.Create;
FMinusOne := TDataOrdinalValueMinusOne.Create; FMinusOne := TDataOrdinalValueMinusOne.Create;
FZero := TDataOrdinalValueZero.Create; FZero := TDataOrdinalValueZero.Create;
FOne := TDataOrdinalValueOne.Create; FOne := TDataOrdinalValueOne.Create;
end; end;
function TDataOrdinalType.GetName: String; function TImplDataOrdinalType.GetName: String;
begin begin
Result := 'Integer'; Result := 'Integer';
end; end;
function TDataOrdinalType.GetKind: TDataKind; function TImplDataOrdinalType.GetKind: TDataKind;
begin begin
Result := dkOrdinal; Result := dkOrdinal;
end; end;
function TDataOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue; function TImplDataOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue;
begin begin
// Use specialized singletons for common values. // Use specialized singletons for common values.
case Init of case Init of
@@ -223,7 +223,7 @@ begin
0: Result := FZero; 0: Result := FZero;
1: Result := FOne; 1: Result := FOne;
else else
Result := TDataOrdinalValue.Create(Init); Result := TImplDataOrdinalValue.Create(Init);
end; end;
end; end;
Src/Data/Myc.Data.Types.Records.pas
+43 -43
View File
@@ -18,7 +18,7 @@ type
end; end;
// Implements the record data type. // Implements the record data type.
TDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType) TImplDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType)
private private
FFields: TArray<TRecordField>; FFields: TArray<TRecordField>;
FFieldMap: TDictionary<string, Integer>; // For fast lookups by name FFieldMap: TDictionary<string, Integer>; // For fast lookups by name
@@ -42,7 +42,7 @@ uses
type type
// Implements the record data value. // Implements the record data value.
TDataRecordValue = class(TInterfacedObject, IDataValue, IDataRecordValue) TImplDataRecordValue = class(TInterfacedObject, IDataValue, IDataRecordValue)
private private
FDataType: IDataRecordType; FDataType: IDataRecordType;
FItems: TArray<IDataValue>; FItems: TArray<IDataValue>;
@@ -55,7 +55,7 @@ type
end; end;
// Optimized implementation for a record with 0 fields. // Optimized implementation for a record with 0 fields.
TDataRecordValue0 = class(TInterfacedObject, IDataValue, IDataRecordValue) TImplDataRecordValue0 = class(TInterfacedObject, IDataValue, IDataRecordValue)
strict private strict private
class var class var
FEmptyTValue: TValue; // Singleton TValue for an empty record FEmptyTValue: TValue; // Singleton TValue for an empty record
@@ -71,7 +71,7 @@ type
end; end;
// Optimized implementation for a record with 1 field. // Optimized implementation for a record with 1 field.
TDataRecordValue1 = class(TInterfacedObject, IDataValue, IDataRecordValue) TImplDataRecordValue1 = class(TInterfacedObject, IDataValue, IDataRecordValue)
private private
FDataType: IDataRecordType; FDataType: IDataRecordType;
FItem0: IDataValue; FItem0: IDataValue;
@@ -84,7 +84,7 @@ type
end; end;
// Optimized implementation for a record with 2 fields. // Optimized implementation for a record with 2 fields.
TDataRecordValue2 = class(TInterfacedObject, IDataValue, IDataRecordValue) TImplDataRecordValue2 = class(TInterfacedObject, IDataValue, IDataRecordValue)
private private
FDataType: IDataRecordType; FDataType: IDataRecordType;
FItem0, FItem1: IDataValue; FItem0, FItem1: IDataValue;
@@ -124,9 +124,9 @@ begin
end; end;
end; end;
{ TDataRecordValue (generic implementation for N > 2 fields) } { TImplDataRecordValue (generic implementation for N > 2 fields) }
constructor TDataRecordValue.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue); constructor TImplDataRecordValue.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
var var
i: Integer; i: Integer;
begin begin
@@ -137,12 +137,12 @@ begin
FItems[i] := AItems[i]; FItems[i] := AItems[i];
end; end;
function TDataRecordValue.GetDataType: IDataType; function TImplDataRecordValue.GetDataType: IDataType;
begin begin
Result := FDataType; Result := FDataType;
end; end;
function TDataRecordValue.GetAsString: string; function TImplDataRecordValue.GetAsString: string;
var var
sb: TStringBuilder; sb: TStringBuilder;
i: Integer; i: Integer;
@@ -167,7 +167,7 @@ begin
end; end;
end; end;
function TDataRecordValue.AsTValue: TValue; function TImplDataRecordValue.AsTValue: TValue;
var var
tvalueArray: TArray<TValue>; tvalueArray: TArray<TValue>;
i: Integer; i: Integer;
@@ -178,14 +178,14 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray); Result := TValue.From<TArray<TValue>>(tvalueArray);
end; end;
function TDataRecordValue.GetItem(Idx: Integer): IDataValue; function TImplDataRecordValue.GetItem(Idx: Integer): IDataValue;
begin begin
Result := FItems[Idx]; Result := FItems[Idx];
end; end;
{ TDataRecordValue0 } { TImplDataRecordValue0 }
class constructor TDataRecordValue0.CreateClass; class constructor TImplDataRecordValue0.CreateClass;
var var
emptyArray: TArray<TValue>; emptyArray: TArray<TValue>;
begin begin
@@ -193,42 +193,42 @@ begin
FEmptyTValue := TValue.From<TArray<TValue>>(emptyArray); FEmptyTValue := TValue.From<TArray<TValue>>(emptyArray);
end; end;
constructor TDataRecordValue0.Create(const ADataType: IDataRecordType); constructor TImplDataRecordValue0.Create(const ADataType: IDataRecordType);
begin begin
inherited Create; inherited Create;
FDataType := ADataType; FDataType := ADataType;
end; end;
function TDataRecordValue0.GetAsString: string; function TImplDataRecordValue0.GetAsString: string;
begin begin
Result := '<>'; Result := '<>';
end; end;
function TDataRecordValue0.AsTValue: TValue; function TImplDataRecordValue0.AsTValue: TValue;
begin begin
Result := FEmptyTValue; Result := FEmptyTValue;
end; end;
function TDataRecordValue0.GetDataType: IDataType; function TImplDataRecordValue0.GetDataType: IDataType;
begin begin
Result := FDataType; Result := FDataType;
end; end;
function TDataRecordValue0.GetItem(Idx: Integer): IDataValue; function TImplDataRecordValue0.GetItem(Idx: Integer): IDataValue;
begin begin
raise EArgumentException.Create('Index out of bounds'); raise EArgumentException.Create('Index out of bounds');
end; end;
{ TDataRecordValue1 } { TImplDataRecordValue1 }
constructor TDataRecordValue1.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue); constructor TImplDataRecordValue1.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
begin begin
inherited Create; inherited Create;
FDataType := ADataType; FDataType := ADataType;
FItem0 := AItems[0]; FItem0 := AItems[0];
end; end;
function TDataRecordValue1.GetAsString: string; function TImplDataRecordValue1.GetAsString: string;
var var
recordType: IDataRecordType; recordType: IDataRecordType;
begin begin
@@ -236,7 +236,7 @@ begin
Result := Format('<%s: %s>', [recordType.Fields[0].Name, FItem0.AsString]); Result := Format('<%s: %s>', [recordType.Fields[0].Name, FItem0.AsString]);
end; end;
function TDataRecordValue1.AsTValue: TValue; function TImplDataRecordValue1.AsTValue: TValue;
var var
tvalueArray: TArray<TValue>; tvalueArray: TArray<TValue>;
begin begin
@@ -245,12 +245,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray); Result := TValue.From<TArray<TValue>>(tvalueArray);
end; end;
function TDataRecordValue1.GetDataType: IDataType; function TImplDataRecordValue1.GetDataType: IDataType;
begin begin
Result := FDataType; Result := FDataType;
end; end;
function TDataRecordValue1.GetItem(Idx: Integer): IDataValue; function TImplDataRecordValue1.GetItem(Idx: Integer): IDataValue;
begin begin
case Idx of case Idx of
0: Result := FItem0; 0: Result := FItem0;
@@ -259,9 +259,9 @@ begin
end; end;
end; end;
{ TDataRecordValue2 } { TImplDataRecordValue2 }
constructor TDataRecordValue2.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue); constructor TImplDataRecordValue2.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
begin begin
inherited Create; inherited Create;
FDataType := ADataType; FDataType := ADataType;
@@ -269,7 +269,7 @@ begin
FItem1 := AItems[1]; FItem1 := AItems[1];
end; end;
function TDataRecordValue2.GetAsString: string; function TImplDataRecordValue2.GetAsString: string;
var var
recordType: IDataRecordType; recordType: IDataRecordType;
sb: TStringBuilder; sb: TStringBuilder;
@@ -292,7 +292,7 @@ begin
end; end;
end; end;
function TDataRecordValue2.AsTValue: TValue; function TImplDataRecordValue2.AsTValue: TValue;
var var
tvalueArray: TArray<TValue>; tvalueArray: TArray<TValue>;
begin begin
@@ -302,12 +302,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray); Result := TValue.From<TArray<TValue>>(tvalueArray);
end; end;
function TDataRecordValue2.GetDataType: IDataType; function TImplDataRecordValue2.GetDataType: IDataType;
begin begin
Result := FDataType; Result := FDataType;
end; end;
function TDataRecordValue2.GetItem(Idx: Integer): IDataValue; function TImplDataRecordValue2.GetItem(Idx: Integer): IDataValue;
begin begin
case Idx of case Idx of
0: Result := FItem0; 0: Result := FItem0;
@@ -317,9 +317,9 @@ begin
end; end;
end; end;
{ TDataRecordType } { TImplDataRecordType }
constructor TDataRecordType.Create(const AFields: array of TRecordField); constructor TImplDataRecordType.Create(const AFields: array of TRecordField);
var var
i: Integer; i: Integer;
field: TRecordField; field: TRecordField;
@@ -338,16 +338,16 @@ begin
// Pre-create the singleton value instance if this is a zero-field record. // Pre-create the singleton value instance if this is a zero-field record.
if (Length(FFields) = 0) then if (Length(FFields) = 0) then
FEmptyValue := TDataRecordValue0.Create(Self); FEmptyValue := TImplDataRecordValue0.Create(Self);
end; end;
destructor TDataRecordType.Destroy; destructor TImplDataRecordType.Destroy;
begin begin
FFieldMap.Free; FFieldMap.Free;
inherited; inherited;
end; end;
function TDataRecordType.CreateValue(const AItems: array of IDataValue): IDataRecordValue; function TImplDataRecordType.CreateValue(const AItems: array of IDataValue): IDataRecordValue;
var var
i: Integer; i: Integer;
begin begin
@@ -364,25 +364,25 @@ begin
// Use optimized implementations for records with 0, 1, or 2 fields. // Use optimized implementations for records with 0, 1, or 2 fields.
case Length(FFields) of case Length(FFields) of
0: Result := FEmptyValue; // Return the pre-cached instance. 0: Result := FEmptyValue; // Return the pre-cached instance.
1: Result := TDataRecordValue1.Create(Self, AItems); 1: Result := TImplDataRecordValue1.Create(Self, AItems);
2: Result := TDataRecordValue2.Create(Self, AItems); 2: Result := TImplDataRecordValue2.Create(Self, AItems);
else else
// Use the generic implementation for records with more than 2 fields. // Use the generic implementation for records with more than 2 fields.
Result := TDataRecordValue.Create(Self, AItems); Result := TImplDataRecordValue.Create(Self, AItems);
end; end;
end; end;
function TDataRecordType.GetField(Idx: Integer): TRecordField; function TImplDataRecordType.GetField(Idx: Integer): TRecordField;
begin begin
Result := FFields[Idx]; Result := FFields[Idx];
end; end;
function TDataRecordType.GetFieldCount: Integer; function TImplDataRecordType.GetFieldCount: Integer;
begin begin
Result := Length(FFields); Result := Length(FFields);
end; end;
function TDataRecordType.GetName: String; function TImplDataRecordType.GetName: String;
var var
i: Integer; i: Integer;
sb: TStringBuilder; sb: TStringBuilder;
@@ -405,12 +405,12 @@ begin
end; end;
end; end;
function TDataRecordType.GetKind: TDataKind; function TImplDataRecordType.GetKind: TDataKind;
begin begin
Result := dkRecord; Result := dkRecord;
end; end;
function TDataRecordType.IndexOf(const AName: string): Integer; function TImplDataRecordType.IndexOf(const AName: string): Integer;
begin begin
if not FFieldMap.TryGetValue(AName, Result) then if not FFieldMap.TryGetValue(AName, Result) then
Result := -1; Result := -1;
Src/Data/Myc.Data.Types.Text.pas
+26 -26
View File
@@ -7,7 +7,7 @@ uses
Myc.Data.Types; Myc.Data.Types;
type type
TDataTextType = class(TInterfacedObject, IDataType, IDataTextType) TImplDataTextType = class(TInterfacedObject, IDataType, IDataTextType)
strict private strict private
class var class var
FSingleton: IDataTextType; FSingleton: IDataTextType;
@@ -25,7 +25,7 @@ uses
System.Rtti; System.Rtti;
type type
TDataTextValue = class(TInterfacedObject, IDataValue, IDataTextValue) TImplDataTextValue = class(TInterfacedObject, IDataValue, IDataTextValue)
private private
FValue: string; FValue: string;
function GetDataType: IDataType; function GetDataType: IDataType;
@@ -37,7 +37,7 @@ type
end; end;
// Singleton implementation for the empty string value. // Singleton implementation for the empty string value.
TDataTextValueEmpty = class(TInterfacedObject, IDataValue, IDataTextValue) TImplDataTextValueEmpty = class(TInterfacedObject, IDataValue, IDataTextValue)
strict private strict private
class var class var
FSingleton: IDataTextValue; FSingleton: IDataTextValue;
@@ -52,84 +52,84 @@ type
class property Singleton: IDataTextValue read FSingleton; class property Singleton: IDataTextValue read FSingleton;
end; end;
{ TDataTextType } { TImplDataTextType }
class constructor TDataTextType.CreateClass; class constructor TImplDataTextType.CreateClass;
begin begin
FSingleton := TDataTextType.Create; FSingleton := TImplDataTextType.Create;
end; end;
function TDataTextType.CreateValue(const AValue: string): IDataTextValue; function TImplDataTextType.CreateValue(const AValue: string): IDataTextValue;
begin begin
// Use the singleton for empty strings. // Use the singleton for empty strings.
if (AValue = '') then if (AValue = '') then
Result := TDataTextValueEmpty.Singleton Result := TImplDataTextValueEmpty.Singleton
else else
Result := TDataTextValue.Create(AValue); Result := TImplDataTextValue.Create(AValue);
end; end;
function TDataTextType.GetName: String; function TImplDataTextType.GetName: String;
begin begin
Result := 'Text'; Result := 'Text';
end; end;
function TDataTextType.GetKind: TDataKind; function TImplDataTextType.GetKind: TDataKind;
begin begin
Result := dkText; Result := dkText;
end; end;
{ TDataTextValue } { TImplDataTextValue }
constructor TDataTextValue.Create(const AValue: string); constructor TImplDataTextValue.Create(const AValue: string);
begin begin
inherited Create; inherited Create;
FValue := AValue; FValue := AValue;
end; end;
function TDataTextValue.GetDataType: IDataType; function TImplDataTextValue.GetDataType: IDataType;
begin begin
Result := TDataTextType.Singleton; Result := TImplDataTextType.Singleton;
end; end;
function TDataTextValue.GetAsString: string; function TImplDataTextValue.GetAsString: string;
begin begin
Result := FValue; Result := FValue;
end; end;
function TDataTextValue.GetValue: string; function TImplDataTextValue.GetValue: string;
begin begin
Result := FValue; Result := FValue;
end; end;
function TDataTextValue.AsTValue: TValue; function TImplDataTextValue.AsTValue: TValue;
begin begin
Result := TValue.From<string>(FValue); Result := TValue.From<string>(FValue);
end; end;
{ TDataTextValueEmpty } { TImplDataTextValueEmpty }
class constructor TDataTextValueEmpty.CreateClass; class constructor TImplDataTextValueEmpty.CreateClass;
begin begin
FSingleton := TDataTextValueEmpty.Create; FSingleton := TImplDataTextValueEmpty.Create;
FEmptyTValue := TValue.From<string>(''); FEmptyTValue := TValue.From<string>('');
end; end;
function TDataTextValueEmpty.GetAsString: string; function TImplDataTextValueEmpty.GetAsString: string;
begin begin
Result := ''; Result := '';
end; end;
function TDataTextValueEmpty.GetDataType: IDataType; function TImplDataTextValueEmpty.GetDataType: IDataType;
begin begin
Result := TDataTextType.Singleton; Result := TImplDataTextType.Singleton;
end; end;
function TDataTextValueEmpty.GetValue: string; function TImplDataTextValueEmpty.GetValue: string;
begin begin
Result := ''; Result := '';
end; end;
function TDataTextValueEmpty.AsTValue: TValue; function TImplDataTextValueEmpty.AsTValue: TValue;
begin begin
Result := FEmptyTValue; Result := FEmptyTValue;
end; end;
Src/Data/Myc.Data.Types.Timestamp.pas
+16 -16
View File
@@ -7,7 +7,7 @@ uses
Myc.Data.Types; Myc.Data.Types;
type type
TDataTimestampType = class(TInterfacedObject, IDataType, IDataTimestampType) TImplDataTimestampType = class(TInterfacedObject, IDataType, IDataTimestampType)
strict private strict private
class var class var
FSingleton: IDataTimestampType; FSingleton: IDataTimestampType;
@@ -25,7 +25,7 @@ uses
System.Rtti; System.Rtti;
type type
TDataTimestampValue = class(TInterfacedObject, IDataValue, IDataTimestampValue) TImplDataTimestampValue = class(TInterfacedObject, IDataValue, IDataTimestampValue)
private private
FValue: TDateTime; FValue: TDateTime;
function GetDataType: IDataType; function GetDataType: IDataType;
@@ -36,52 +36,52 @@ type
constructor Create(const AValue: TDateTime); constructor Create(const AValue: TDateTime);
end; end;
{ TDataTimestampType } { TImplDataTimestampType }
class constructor TDataTimestampType.CreateClass; class constructor TImplDataTimestampType.CreateClass;
begin begin
FSingleton := TDataTimestampType.Create; FSingleton := TImplDataTimestampType.Create;
end; end;
function TDataTimestampType.CreateValue(const AValue: TDateTime): IDataTimestampValue; function TImplDataTimestampType.CreateValue(const AValue: TDateTime): IDataTimestampValue;
begin begin
Result := TDataTimestampValue.Create(AValue); Result := TImplDataTimestampValue.Create(AValue);
end; end;
function TDataTimestampType.GetName: String; function TImplDataTimestampType.GetName: String;
begin begin
Result := 'Timestamp'; Result := 'Timestamp';
end; end;
function TDataTimestampType.GetKind: TDataKind; function TImplDataTimestampType.GetKind: TDataKind;
begin begin
Result := dkTimestamp; Result := dkTimestamp;
end; end;
{ TDataTimestampValue } { TImplDataTimestampValue }
constructor TDataTimestampValue.Create(const AValue: TDateTime); constructor TImplDataTimestampValue.Create(const AValue: TDateTime);
begin begin
inherited Create; inherited Create;
FValue := AValue; FValue := AValue;
end; end;
function TDataTimestampValue.GetDataType: IDataType; function TImplDataTimestampValue.GetDataType: IDataType;
begin begin
Result := TDataTimestampType.Singleton; Result := TImplDataTimestampType.Singleton;
end; end;
function TDataTimestampValue.GetAsString: string; function TImplDataTimestampValue.GetAsString: string;
begin begin
Result := DateTimeToStr(FValue); Result := DateTimeToStr(FValue);
end; end;
function TDataTimestampValue.GetValue: TDateTime; function TImplDataTimestampValue.GetValue: TDateTime;
begin begin
Result := FValue; Result := FValue;
end; end;
function TDataTimestampValue.AsTValue: TValue; function TImplDataTimestampValue.AsTValue: TValue;
begin begin
Result := TValue.From<TDateTime>(FValue); Result := TValue.From<TDateTime>(FValue);
end; end;
Src/Data/Myc.Data.Types.Tuple.pas
+78 -78
View File
@@ -8,7 +8,7 @@ uses
type type
// Implements the singleton tuple data type. // Implements the singleton tuple data type.
TDataTupleType = class(TInterfacedObject, IDataType, IDataTupleType) TImplDataTupleType = class(TInterfacedObject, IDataType, IDataTupleType)
strict private strict private
class var class var
FSingleton: IDataTupleType; FSingleton: IDataTupleType;
@@ -28,7 +28,7 @@ uses
type type
// Implements the simple tuple data value. // Implements the simple tuple data value.
TDataTupleValue = class(TInterfacedObject, IDataValue, IDataTupleValue) TImplDataTupleValue = class(TInterfacedObject, IDataValue, IDataTupleValue)
private private
FItems: TArray<IDataValue>; FItems: TArray<IDataValue>;
function GetDataType: IDataType; function GetDataType: IDataType;
@@ -41,7 +41,7 @@ type
end; end;
// Optimized singleton implementation for a tuple with 0 elements. // Optimized singleton implementation for a tuple with 0 elements.
TDataTupleValue0 = class(TInterfacedObject, IDataValue, IDataTupleValue) TImplDataTupleValue0 = class(TInterfacedObject, IDataValue, IDataTupleValue)
strict private strict private
class var class var
FSingleton: IDataTupleValue; FSingleton: IDataTupleValue;
@@ -58,7 +58,7 @@ type
end; end;
// Optimized implementation for a tuple with 1 element. // Optimized implementation for a tuple with 1 element.
TDataTupleValue1 = class(TInterfacedObject, IDataValue, IDataTupleValue) TImplDataTupleValue1 = class(TInterfacedObject, IDataValue, IDataTupleValue)
private private
FItem0: IDataValue; FItem0: IDataValue;
function GetDataType: IDataType; function GetDataType: IDataType;
@@ -71,7 +71,7 @@ type
end; end;
// Optimized implementation for a tuple with 2 elements. // Optimized implementation for a tuple with 2 elements.
TDataTupleValue2 = class(TInterfacedObject, IDataValue, IDataTupleValue) TImplDataTupleValue2 = class(TInterfacedObject, IDataValue, IDataTupleValue)
private private
FItem0, FItem1: IDataValue; FItem0, FItem1: IDataValue;
function GetDataType: IDataType; function GetDataType: IDataType;
@@ -84,7 +84,7 @@ type
end; end;
// Optimized implementation for a tuple with 3 elements. // Optimized implementation for a tuple with 3 elements.
TDataTupleValue3 = class(TInterfacedObject, IDataValue, IDataTupleValue) TImplDataTupleValue3 = class(TInterfacedObject, IDataValue, IDataTupleValue)
private private
FItem0, FItem1, FItem2: IDataValue; FItem0, FItem1, FItem2: IDataValue;
function GetDataType: IDataType; function GetDataType: IDataType;
@@ -97,7 +97,7 @@ type
end; end;
// Optimized implementation for a tuple with 4 elements. // Optimized implementation for a tuple with 4 elements.
TDataTupleValue4 = class(TInterfacedObject, IDataValue, IDataTupleValue) TImplDataTupleValue4 = class(TInterfacedObject, IDataValue, IDataTupleValue)
private private
FItem0, FItem1, FItem2, FItem3: IDataValue; FItem0, FItem1, FItem2, FItem3: IDataValue;
function GetDataType: IDataType; function GetDataType: IDataType;
@@ -110,7 +110,7 @@ type
end; end;
// Optimized implementation for a tuple with 5 elements. // Optimized implementation for a tuple with 5 elements.
TDataTupleValue5 = class(TInterfacedObject, IDataValue, IDataTupleValue) TImplDataTupleValue5 = class(TInterfacedObject, IDataValue, IDataTupleValue)
private private
FItem0, FItem1, FItem2, FItem3, FItem4: IDataValue; FItem0, FItem1, FItem2, FItem3, FItem4: IDataValue;
function GetDataType: IDataType; function GetDataType: IDataType;
@@ -122,9 +122,9 @@ type
constructor Create(const AItems: array of IDataValue); constructor Create(const AItems: array of IDataValue);
end; end;
{ TDataTupleValue (generic implementation for N > 5 elements) } { TImplDataTupleValue (generic implementation for N > 5 elements) }
constructor TDataTupleValue.Create(const AItems: array of IDataValue); constructor TImplDataTupleValue.Create(const AItems: array of IDataValue);
var var
i: Integer; i: Integer;
begin begin
@@ -134,12 +134,12 @@ begin
FItems[i] := AItems[i]; FItems[i] := AItems[i];
end; end;
function TDataTupleValue.GetDataType: IDataType; function TImplDataTupleValue.GetDataType: IDataType;
begin begin
Result := TDataTupleType.Singleton; Result := TImplDataTupleType.Singleton;
end; end;
function TDataTupleValue.GetAsString: string; function TImplDataTupleValue.GetAsString: string;
var var
sb: TStringBuilder; sb: TStringBuilder;
i: Integer; i: Integer;
@@ -160,7 +160,7 @@ begin
end; end;
end; end;
function TDataTupleValue.AsTValue: TValue; function TImplDataTupleValue.AsTValue: TValue;
var var
tvalueArray: TArray<TValue>; tvalueArray: TArray<TValue>;
i: Integer; i: Integer;
@@ -171,66 +171,66 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray); Result := TValue.From<TArray<TValue>>(tvalueArray);
end; end;
function TDataTupleValue.GetItem(Idx: Integer): IDataValue; function TImplDataTupleValue.GetItem(Idx: Integer): IDataValue;
begin begin
Result := FItems[Idx]; Result := FItems[Idx];
end; end;
function TDataTupleValue.GetItemCount: Integer; function TImplDataTupleValue.GetItemCount: Integer;
begin begin
Result := Length(FItems); Result := Length(FItems);
end; end;
{ TDataTupleValue0 } { TImplDataTupleValue0 }
class constructor TDataTupleValue0.CreateClass; class constructor TImplDataTupleValue0.CreateClass;
var var
emptyArray: TArray<TValue>; emptyArray: TArray<TValue>;
begin begin
FSingleton := TDataTupleValue0.Create; FSingleton := TImplDataTupleValue0.Create;
SetLength(emptyArray, 0); SetLength(emptyArray, 0);
FEmptyTValue := TValue.From<TArray<TValue>>(emptyArray); FEmptyTValue := TValue.From<TArray<TValue>>(emptyArray);
end; end;
function TDataTupleValue0.GetAsString: string; function TImplDataTupleValue0.GetAsString: string;
begin begin
Result := '()'; Result := '()';
end; end;
function TDataTupleValue0.AsTValue: TValue; function TImplDataTupleValue0.AsTValue: TValue;
begin begin
Result := FEmptyTValue; Result := FEmptyTValue;
end; end;
function TDataTupleValue0.GetDataType: IDataType; function TImplDataTupleValue0.GetDataType: IDataType;
begin begin
Result := TDataTupleType.Singleton; Result := TImplDataTupleType.Singleton;
end; end;
function TDataTupleValue0.GetItem(Idx: Integer): IDataValue; function TImplDataTupleValue0.GetItem(Idx: Integer): IDataValue;
begin begin
raise EArgumentException.Create('Index out of bounds'); raise EArgumentException.Create('Index out of bounds');
end; end;
function TDataTupleValue0.GetItemCount: Integer; function TImplDataTupleValue0.GetItemCount: Integer;
begin begin
Result := 0; Result := 0;
end; end;
{ TDataTupleValue1 } { TImplDataTupleValue1 }
constructor TDataTupleValue1.Create(const AItems: array of IDataValue); constructor TImplDataTupleValue1.Create(const AItems: array of IDataValue);
begin begin
inherited Create; inherited Create;
FItem0 := AItems[0]; FItem0 := AItems[0];
end; end;
function TDataTupleValue1.GetAsString: string; function TImplDataTupleValue1.GetAsString: string;
begin begin
Result := '(' + FItem0.AsString + ')'; Result := '(' + FItem0.AsString + ')';
end; end;
function TDataTupleValue1.AsTValue: TValue; function TImplDataTupleValue1.AsTValue: TValue;
var var
tvalueArray: TArray<TValue>; tvalueArray: TArray<TValue>;
begin begin
@@ -239,12 +239,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray); Result := TValue.From<TArray<TValue>>(tvalueArray);
end; end;
function TDataTupleValue1.GetDataType: IDataType; function TImplDataTupleValue1.GetDataType: IDataType;
begin begin
Result := TDataTupleType.Singleton; Result := TImplDataTupleType.Singleton;
end; end;
function TDataTupleValue1.GetItem(Idx: Integer): IDataValue; function TImplDataTupleValue1.GetItem(Idx: Integer): IDataValue;
begin begin
case Idx of case Idx of
0: Result := FItem0; 0: Result := FItem0;
@@ -253,26 +253,26 @@ begin
end; end;
end; end;
function TDataTupleValue1.GetItemCount: Integer; function TImplDataTupleValue1.GetItemCount: Integer;
begin begin
Result := 1; Result := 1;
end; end;
{ TDataTupleValue2 } { TImplDataTupleValue2 }
constructor TDataTupleValue2.Create(const AItems: array of IDataValue); constructor TImplDataTupleValue2.Create(const AItems: array of IDataValue);
begin begin
inherited Create; inherited Create;
FItem0 := AItems[0]; FItem0 := AItems[0];
FItem1 := AItems[1]; FItem1 := AItems[1];
end; end;
function TDataTupleValue2.GetAsString: string; function TImplDataTupleValue2.GetAsString: string;
begin begin
Result := '(' + FItem0.AsString + ', ' + FItem1.AsString + ')'; Result := '(' + FItem0.AsString + ', ' + FItem1.AsString + ')';
end; end;
function TDataTupleValue2.AsTValue: TValue; function TImplDataTupleValue2.AsTValue: TValue;
var var
tvalueArray: TArray<TValue>; tvalueArray: TArray<TValue>;
begin begin
@@ -282,12 +282,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray); Result := TValue.From<TArray<TValue>>(tvalueArray);
end; end;
function TDataTupleValue2.GetDataType: IDataType; function TImplDataTupleValue2.GetDataType: IDataType;
begin begin
Result := TDataTupleType.Singleton; Result := TImplDataTupleType.Singleton;
end; end;
function TDataTupleValue2.GetItem(Idx: Integer): IDataValue; function TImplDataTupleValue2.GetItem(Idx: Integer): IDataValue;
begin begin
case Idx of case Idx of
0: Result := FItem0; 0: Result := FItem0;
@@ -297,14 +297,14 @@ begin
end; end;
end; end;
function TDataTupleValue2.GetItemCount: Integer; function TImplDataTupleValue2.GetItemCount: Integer;
begin begin
Result := 2; Result := 2;
end; end;
{ TDataTupleValue3 } { TImplDataTupleValue3 }
constructor TDataTupleValue3.Create(const AItems: array of IDataValue); constructor TImplDataTupleValue3.Create(const AItems: array of IDataValue);
begin begin
inherited Create; inherited Create;
FItem0 := AItems[0]; FItem0 := AItems[0];
@@ -312,7 +312,7 @@ begin
FItem2 := AItems[2]; FItem2 := AItems[2];
end; end;
function TDataTupleValue3.GetAsString: string; function TImplDataTupleValue3.GetAsString: string;
var var
sb: TStringBuilder; sb: TStringBuilder;
begin begin
@@ -331,7 +331,7 @@ begin
end; end;
end; end;
function TDataTupleValue3.AsTValue: TValue; function TImplDataTupleValue3.AsTValue: TValue;
var var
tvalueArray: TArray<TValue>; tvalueArray: TArray<TValue>;
begin begin
@@ -342,12 +342,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray); Result := TValue.From<TArray<TValue>>(tvalueArray);
end; end;
function TDataTupleValue3.GetDataType: IDataType; function TImplDataTupleValue3.GetDataType: IDataType;
begin begin
Result := TDataTupleType.Singleton; Result := TImplDataTupleType.Singleton;
end; end;
function TDataTupleValue3.GetItem(Idx: Integer): IDataValue; function TImplDataTupleValue3.GetItem(Idx: Integer): IDataValue;
begin begin
case Idx of case Idx of
0: Result := FItem0; 0: Result := FItem0;
@@ -358,14 +358,14 @@ begin
end; end;
end; end;
function TDataTupleValue3.GetItemCount: Integer; function TImplDataTupleValue3.GetItemCount: Integer;
begin begin
Result := 3; Result := 3;
end; end;
{ TDataTupleValue4 } { TImplDataTupleValue4 }
constructor TDataTupleValue4.Create(const AItems: array of IDataValue); constructor TImplDataTupleValue4.Create(const AItems: array of IDataValue);
begin begin
inherited Create; inherited Create;
FItem0 := AItems[0]; FItem0 := AItems[0];
@@ -374,7 +374,7 @@ begin
FItem3 := AItems[3]; FItem3 := AItems[3];
end; end;
function TDataTupleValue4.GetAsString: string; function TImplDataTupleValue4.GetAsString: string;
var var
sb: TStringBuilder; sb: TStringBuilder;
begin begin
@@ -395,7 +395,7 @@ begin
end; end;
end; end;
function TDataTupleValue4.AsTValue: TValue; function TImplDataTupleValue4.AsTValue: TValue;
var var
tvalueArray: TArray<TValue>; tvalueArray: TArray<TValue>;
begin begin
@@ -407,12 +407,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray); Result := TValue.From<TArray<TValue>>(tvalueArray);
end; end;
function TDataTupleValue4.GetDataType: IDataType; function TImplDataTupleValue4.GetDataType: IDataType;
begin begin
Result := TDataTupleType.Singleton; Result := TImplDataTupleType.Singleton;
end; end;
function TDataTupleValue4.GetItem(Idx: Integer): IDataValue; function TImplDataTupleValue4.GetItem(Idx: Integer): IDataValue;
begin begin
case Idx of case Idx of
0: Result := FItem0; 0: Result := FItem0;
@@ -424,14 +424,14 @@ begin
end; end;
end; end;
function TDataTupleValue4.GetItemCount: Integer; function TImplDataTupleValue4.GetItemCount: Integer;
begin begin
Result := 4; Result := 4;
end; end;
{ TDataTupleValue5 } { TImplDataTupleValue5 }
constructor TDataTupleValue5.Create(const AItems: array of IDataValue); constructor TImplDataTupleValue5.Create(const AItems: array of IDataValue);
begin begin
inherited Create; inherited Create;
FItem0 := AItems[0]; FItem0 := AItems[0];
@@ -441,7 +441,7 @@ begin
FItem4 := AItems[4]; FItem4 := AItems[4];
end; end;
function TDataTupleValue5.GetAsString: string; function TImplDataTupleValue5.GetAsString: string;
var var
sb: TStringBuilder; sb: TStringBuilder;
begin begin
@@ -464,7 +464,7 @@ begin
end; end;
end; end;
function TDataTupleValue5.AsTValue: TValue; function TImplDataTupleValue5.AsTValue: TValue;
var var
tvalueArray: TArray<TValue>; tvalueArray: TArray<TValue>;
begin begin
@@ -477,12 +477,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray); Result := TValue.From<TArray<TValue>>(tvalueArray);
end; end;
function TDataTupleValue5.GetDataType: IDataType; function TImplDataTupleValue5.GetDataType: IDataType;
begin begin
Result := TDataTupleType.Singleton; Result := TImplDataTupleType.Singleton;
end; end;
function TDataTupleValue5.GetItem(Idx: Integer): IDataValue; function TImplDataTupleValue5.GetItem(Idx: Integer): IDataValue;
begin begin
case Idx of case Idx of
0: Result := FItem0; 0: Result := FItem0;
@@ -495,40 +495,40 @@ begin
end; end;
end; end;
function TDataTupleValue5.GetItemCount: Integer; function TImplDataTupleValue5.GetItemCount: Integer;
begin begin
Result := 5; Result := 5;
end; end;
{ TDataTupleType } { TImplDataTupleType }
class constructor TDataTupleType.CreateClass; class constructor TImplDataTupleType.CreateClass;
begin begin
FSingleton := TDataTupleType.Create; FSingleton := TImplDataTupleType.Create;
end; end;
function TDataTupleType.CreateValue(const AItems: array of IDataValue): IDataTupleValue; function TImplDataTupleType.CreateValue(const AItems: array of IDataValue): IDataTupleValue;
begin begin
// Use optimized implementations for tuples with 0 to 5 elements. // Use optimized implementations for tuples with 0 to 5 elements.
case Length(AItems) of case Length(AItems) of
0: Result := TDataTupleValue0.Singleton; 0: Result := TImplDataTupleValue0.Singleton;
1: Result := TDataTupleValue1.Create(AItems); 1: Result := TImplDataTupleValue1.Create(AItems);
2: Result := TDataTupleValue2.Create(AItems); 2: Result := TImplDataTupleValue2.Create(AItems);
3: Result := TDataTupleValue3.Create(AItems); 3: Result := TImplDataTupleValue3.Create(AItems);
4: Result := TDataTupleValue4.Create(AItems); 4: Result := TImplDataTupleValue4.Create(AItems);
5: Result := TDataTupleValue5.Create(AItems); 5: Result := TImplDataTupleValue5.Create(AItems);
else else
// Use the generic implementation for tuples with more than 5 elements. // Use the generic implementation for tuples with more than 5 elements.
Result := TDataTupleValue.Create(AItems); Result := TImplDataTupleValue.Create(AItems);
end; end;
end; end;
function TDataTupleType.GetName: String; function TImplDataTupleType.GetName: String;
begin begin
Result := 'Tuple'; Result := 'Tuple';
end; end;
function TDataTupleType.GetKind: TDataKind; function TImplDataTupleType.GetKind: TDataKind;
begin begin
Result := dkTuple; Result := dkTuple;
end; end;
Src/Data/Myc.Data.Types.pas
+922 -121
View File
File diff suppressed because it is too large Load Diff
Src/Data/TestDataTypes.pas
+151 -139
View File
@@ -51,12 +51,12 @@ uses
procedure TMyTestObject.TestRecords; procedure TMyTestObject.TestRecords;
var var
intType: IDataType; intType: TDataOrdinalType;
floatType: IDataType; floatType: TDataFloatType;
personType1, personType2, otherType: IDataRecordType; personType1, personType2, otherType: TDataRecordType;
personValue: IDataValue; personValue: TDataRecordValue;
idValue: IDataOrdinalValue; idValue: TDataOrdinalValue;
floatValue: IDataFloatValue; floatValue: TDataFloatValue;
begin begin
// This test covers the optimized implementation for 2 fields. // This test covers the optimized implementation for 2 fields.
// --- 1. Setup: Define base types and a record structure --- // --- 1. Setup: Define base types and a record structure ---
@@ -67,38 +67,38 @@ begin
personType1 := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Value', floatType)]); personType1 := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Value', floatType)]);
// Assertions for the created type // Assertions for the created type
Assert.IsNotNull(personType1, 'RecordType should be created'); Assert.IsNotNull(IDataRecordType(personType1), 'RecordType should be created');
Assert.AreEqual(2, personType1.FieldCount, 'FieldCount should be 2'); Assert.AreEqual(2, personType1.FieldCount, 'FieldCount should be 2');
Assert.AreEqual('ID', personType1.Fields[0].Name, 'First field name should be ID'); Assert.AreEqual('ID', personType1.Fields[0].Name, 'First field name should be ID');
Assert.AreSame(intType, personType1.Fields[0].DataType, 'First field type should be Integer'); Assert.AreSame(IDataType(intType), personType1.Fields[0].DataType, 'First field type should be Integer');
Assert.AreEqual('Value', personType1.Fields[1].Name, 'Second field name should be Value'); Assert.AreEqual('Value', personType1.Fields[1].Name, 'Second field name should be Value');
Assert.AreSame(floatType, personType1.Fields[1].DataType, 'Second field type should be Float'); Assert.AreSame(IDataType(floatType), personType1.Fields[1].DataType, 'Second field type should be Float');
Assert.AreEqual(0, personType1.IndexOf('ID'), 'IndexOf ID should be 0'); Assert.AreEqual(0, personType1.IndexOf('ID'), 'IndexOf ID should be 0');
Assert.AreEqual(1, personType1.IndexOf('Value'), 'IndexOf Value should be 1'); Assert.AreEqual(1, personType1.IndexOf('Value'), 'IndexOf Value should be 1');
Assert.AreEqual('Record<ID: Integer, Value: Float>', personType1.Name, 'Type name should match expected format'); Assert.AreEqual('Record<ID: Integer, Value: Float>', TDataType(personType1).Name, 'Type name should match expected format');
// Test if the same definition returns the same cached instance // Test if the same definition returns the same cached instance
personType2 := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Value', floatType)]); personType2 := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Value', floatType)]);
Assert.AreSame(personType1, personType2, 'Types should be cached and return the same instance'); Assert.AreSame(IDataRecordType(personType1), IDataRecordType(personType2), 'Types should be cached and return the same instance');
// Test if a different definition returns a new instance // Test if a different definition returns a new instance
otherType := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Data', floatType)]); otherType := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Data', floatType)]);
Assert.AreNotSame(personType1, otherType, 'Different definitions should result in different types'); Assert.AreNotSame(IDataRecordType(personType1), IDataRecordType(otherType), 'Different definitions should result in different types');
// --- 3. Test Value Creation and Access --- // --- 3. Test Value Creation and Access ---
personValue := personType1.CreateValue([TDataValue.FromOrdinal(123), TDataValue.FromFloat(45.67)]); personValue := personType1.CreateValue([TDataValue.FromOrdinal(123), TDataValue.FromFloat(45.67)]);
Assert.IsNotNull(TDataValue(personValue).AsRecord, 'RecordValue should be created'); Assert.IsNotNull(IDataRecordValue(personValue), 'RecordValue should be created');
Assert.AreSame(personType1, TDataValue(personValue).DataType, 'Value should have the correct data type'); Assert.AreSame(IDataRecordType(personType1), IDataRecordValue(personValue).DataType, 'Value should have the correct data type');
// Access by index // Access by index
idValue := TDataValue(TDataValue(personValue).AsRecord.Items[0]).AsOrdinal; idValue := TDataValue(personValue.Items[0]).AsOrdinal;
Assert.AreEqual(Int64(123), idValue.Value, 'Value at index 0 is incorrect'); Assert.AreEqual(Int64(123), idValue.Value, 'Value at index 0 is incorrect');
floatValue := TDataValue(TDataValue(personValue).AsRecord.Items[1]).AsFloat; floatValue := TDataValue(personValue.Items[1]).AsFloat;
Assert.AreEqual(45.67, floatValue.Value, 'Value at index 1 is incorrect'); Assert.AreEqual(45.67, floatValue.Value, 'Value at index 1 is incorrect');
// Access by name // Access by name
floatValue := TDataValue(TDataValue(personValue).AsRecord.Items[personType1.IndexOf('Value')]).AsFloat; floatValue := TDataValue(personValue.Items[personType1.IndexOf('Value')]).AsFloat;
Assert.AreEqual(45.67, floatValue.Value, 'Value accessed by name is incorrect'); Assert.AreEqual(45.67, floatValue.Value, 'Value accessed by name is incorrect');
// --- 4. Test Validation and Error Handling --- // --- 4. Test Validation and Error Handling ---
@@ -130,8 +130,8 @@ end;
procedure TMyTestObject.TestRecords_Generic; procedure TMyTestObject.TestRecords_Generic;
var var
dataType: IDataRecordType; dataType: TDataRecordType;
dataValue: IDataRecordValue; dataValue: TDataRecordValue;
begin begin
// Test the generic implementation for records with > 2 fields. // Test the generic implementation for records with > 2 fields.
dataType := dataType :=
@@ -144,20 +144,20 @@ begin
); );
dataValue := dataType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('two'), TDataValue.FromFloat(3.0)]); dataValue := dataType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('two'), TDataValue.FromFloat(3.0)]);
Assert.IsNotNull(dataValue, 'Generic record value should be created'); Assert.IsNotNull(IDataRecordValue(dataValue), 'Generic record value should be created');
Assert.AreEqual(3, dataType.FieldCount, 'Generic record should have 3 fields'); Assert.AreEqual(3, dataType.FieldCount, 'Generic record should have 3 fields');
Assert.AreEqual(Int64(1), TDataValue(dataValue.Items[0]).AsOrdinal.Value, 'Field A is incorrect'); Assert.AreEqual(Int64(1), TDataValue(dataValue.Items[0]).AsOrdinal.Value, 'Field A is incorrect');
Assert.AreEqual('two', TDataValue(dataValue.Items[1]).AsText.Value, 'Field B is incorrect'); Assert.AreEqual('two', TDataValue(dataValue.Items[1]).AsText.Value, 'Field B is incorrect');
Assert.AreEqual(3.0, TDataValue(dataValue.Items[2]).AsFloat.Value, 'Field C is incorrect'); Assert.AreEqual(3.0, TDataValue(dataValue.Items[2]).AsFloat.Value, 'Field C is incorrect');
Assert.AreEqual('<A: 1, B: two, C: 3>', dataValue.AsString, 'Generic record AsString is incorrect'); Assert.AreEqual('<A: 1, B: two, C: 3>', IDataRecordValue(dataValue).AsString, 'Generic record AsString is incorrect');
end; end;
procedure TMyTestObject.TestTuples; procedure TMyTestObject.TestTuples;
var var
intValue: IDataValue; intValue: TDataOrdinalValue;
floatValue: IDataValue; floatValue: TDataFloatValue;
tuple1, tuple2, tuple3: IDataTupleValue; tuple1, tuple2, tuple3: TDataTupleValue;
type1, type2, type3: IDataType; type1, type2, type3: IDataType; // Keep as interface to test AreSame on the raw interface pointer
begin begin
// This test covers optimized implementations for 1 and 2 elements. // This test covers optimized implementations for 1 and 2 elements.
// --- 1. Setup: Create some values --- // --- 1. Setup: Create some values ---
@@ -167,10 +167,10 @@ begin
// --- 2. Test Value Creation and basic properties --- // --- 2. Test Value Creation and basic properties ---
tuple1 := TDataValue.FromTuple([intValue, floatValue]); tuple1 := TDataValue.FromTuple([intValue, floatValue]);
Assert.IsNotNull(tuple1, 'Tuple value should be created'); Assert.IsNotNull(IDataTupleValue(tuple1), 'Tuple value should be created');
Assert.AreEqual(2, TDataValue(tuple1).AsTuple.ItemCount, 'ItemCount should be on the value'); Assert.AreEqual(2, tuple1.ItemCount, 'ItemCount should be on the value');
Assert.AreSame(intValue, TDataValue(tuple1).AsTuple.Items[0], 'Item at index 0 is incorrect'); Assert.AreSame(IDataValue(intValue), tuple1.Items[0], 'Item at index 0 is incorrect');
Assert.AreSame(floatValue, TDataValue(tuple1).AsTuple.Items[1], 'Item at index 1 is incorrect'); Assert.AreSame(IDataValue(floatValue), tuple1.Items[1], 'Item at index 1 is incorrect');
// --- 3. Test Singleton Type Behavior --- // --- 3. Test Singleton Type Behavior ---
// Create more tuples with different structures // Create more tuples with different structures
@@ -178,9 +178,9 @@ begin
tuple3 := TDataValue.FromTuple([intValue]); tuple3 := TDataValue.FromTuple([intValue]);
// Access the DataType via the underlying interface // Access the DataType via the underlying interface
type1 := tuple1.DataType; type1 := IDataValue(tuple1).DataType;
type2 := tuple2.DataType; type2 := IDataValue(tuple2).DataType;
type3 := tuple3.DataType; type3 := IDataValue(tuple3).DataType;
Assert.IsNotNull(type1, 'DataType interface should be accessible'); Assert.IsNotNull(type1, 'DataType interface should be accessible');
Assert.AreEqual('Tuple', type1.Name, 'The type name for all tuples should be Tuple'); Assert.AreEqual('Tuple', type1.Name, 'The type name for all tuples should be Tuple');
@@ -192,7 +192,7 @@ end;
procedure TMyTestObject.TestTuples_Generic; procedure TMyTestObject.TestTuples_Generic;
var var
tupleValue: IDataTupleValue; tupleValue: TDataTupleValue;
begin begin
// Test the generic implementation for tuples with > 5 elements. // Test the generic implementation for tuples with > 5 elements.
tupleValue := tupleValue :=
@@ -207,19 +207,20 @@ begin
] ]
); );
Assert.IsNotNull(tupleValue, 'Generic tuple value should be created'); Assert.IsNotNull(IDataTupleValue(tupleValue), 'Generic tuple value should be created');
Assert.AreEqual(6, tupleValue.ItemCount, 'Generic tuple should have 6 items'); Assert.AreEqual(6, tupleValue.ItemCount, 'Generic tuple should have 6 items');
Assert.AreEqual(Int64(6), TDataValue(tupleValue.Items[5]).AsOrdinal.Value, 'Last item is incorrect'); Assert.AreEqual(Int64(6), TDataValue(tupleValue.Items[5]).AsOrdinal.Value, 'Last item is incorrect');
Assert.AreEqual('(1, 2, 3, 4, 5, 6)', tupleValue.AsString, 'Generic tuple AsString is incorrect'); Assert.AreEqual('(1, 2, 3, 4, 5, 6)', IDataTupleValue(tupleValue).AsString, 'Generic tuple AsString is incorrect');
end; end;
procedure TMyTestObject.TestArrays; procedure TMyTestObject.TestArrays;
var var
intType: IDataType; intType: TDataOrdinalType;
floatType: IDataType; floatType: TDataFloatType;
intArrayType1, intArrayType2, floatArrayType: IDataArrayType; intArrayType1, intArrayType2: TDataArrayType;
arrayValue: IDataArrayValue; floatArrayType: TDataArrayType;
v1, v2: IDataValue; arrayValue: TDataArrayValue;
v1, v2: TDataOrdinalValue;
begin begin
// --- 1. Setup --- // --- 1. Setup ---
intType := TDataType.Ordinal; intType := TDataType.Ordinal;
@@ -228,30 +229,34 @@ begin
// --- 2. Test Type Creation and Caching --- // --- 2. Test Type Creation and Caching ---
intArrayType1 := TDataType.ArrayOf(intType); intArrayType1 := TDataType.ArrayOf(intType);
Assert.IsNotNull(intArrayType1, 'ArrayType should be created'); Assert.IsNotNull(IDataArrayType(intArrayType1), 'ArrayType should be created');
Assert.AreSame(intType, intArrayType1.ElementType, 'ElementType should be Integer'); Assert.AreSame(IDataType(intType), intArrayType1.ElementType, 'ElementType should be Integer');
Assert.AreEqual('Array<Integer>', intArrayType1.Name, 'Type name should be Array<Integer>'); Assert.AreEqual('Array<Integer>', TDataType(intArrayType1).Name, 'Type name should be Array<Integer>');
// Test caching // Test caching
intArrayType2 := TDataType.ArrayOf(intType); intArrayType2 := TDataType.ArrayOf(intType);
Assert.AreSame(intArrayType1, intArrayType2, 'Array types should be cached'); Assert.AreSame(IDataArrayType(intArrayType1), IDataArrayType(intArrayType2), 'Array types should be cached');
// Test uniqueness // Test uniqueness
floatArrayType := TDataType.ArrayOf(floatType); floatArrayType := TDataType.ArrayOf(floatType);
Assert.AreNotSame(intArrayType1, floatArrayType, 'Different element types should result in different array types'); Assert.AreNotSame(
Assert.AreEqual('Array<Float>', floatArrayType.Name, 'Type name should be Array<Float>'); IDataArrayType(intArrayType1),
IDataArrayType(floatArrayType),
'Different element types should result in different array types'
);
Assert.AreEqual('Array<Float>', TDataType(floatArrayType).Name, 'Type name should be Array<Float>');
// --- 3. Test Value Creation and Access --- // --- 3. Test Value Creation and Access ---
v1 := TDataValue.FromOrdinal(10); v1 := TDataValue.FromOrdinal(10);
v2 := TDataValue.FromOrdinal(20); v2 := TDataValue.FromOrdinal(20);
arrayValue := intArrayType1.CreateValue([v1, v2]); arrayValue := intArrayType1.CreateValue([v1, v2]);
Assert.IsNotNull(arrayValue, 'ArrayValue should be created'); Assert.IsNotNull(IDataArrayValue(arrayValue), 'ArrayValue should be created');
Assert.AreEqual(2, TDataValue(arrayValue).AsArray.ElementCount, 'ElementCount should be 2'); Assert.AreEqual(2, arrayValue.ElementCount, 'ElementCount should be 2');
// Access items and check values // Access items and check values
Assert.AreEqual(Int64(10), TDataValue(TDataValue(arrayValue).AsArray.Items[0]).AsOrdinal.Value, 'Item at index 0 is incorrect'); Assert.AreEqual(Int64(10), TDataValue(arrayValue.Items[0]).AsOrdinal.Value, 'Item at index 0 is incorrect');
Assert.AreEqual(Int64(20), TDataValue(TDataValue(arrayValue).AsArray.Items[1]).AsOrdinal.Value, 'Item at index 1 is incorrect'); Assert.AreEqual(Int64(20), TDataValue(arrayValue.Items[1]).AsOrdinal.Value, 'Item at index 1 is incorrect');
// --- 4. Test Validation and Error Handling --- // --- 4. Test Validation and Error Handling ---
// Test creating an array with a nil element type // Test creating an array with a nil element type
@@ -271,51 +276,51 @@ end;
procedure TMyTestObject.TestArrays_OptimizedAndGeneric; procedure TMyTestObject.TestArrays_OptimizedAndGeneric;
var var
arrayType: IDataArrayType; arrayType: TDataArrayType;
empty1, empty2, single, generic: IDataArrayValue; empty1, empty2, single, generic: TDataArrayValue;
begin begin
arrayType := TDataType.ArrayOf(TDataType.Ordinal); arrayType := TDataType.ArrayOf(TDataType.Ordinal);
// Test optimized path for 0 elements (cached singleton per type) // Test optimized path for 0 elements (cached singleton per type)
empty1 := arrayType.CreateValue([]); empty1 := arrayType.CreateValue([]);
empty2 := arrayType.CreateValue([]); empty2 := arrayType.CreateValue([]);
Assert.IsNotNull(empty1, 'Empty array value should be created'); Assert.IsNotNull(IDataArrayValue(empty1), 'Empty array value should be created');
Assert.AreSame(empty1, empty2, 'Empty array value should be cached and reused'); Assert.AreSame(IDataArrayValue(empty1), IDataArrayValue(empty2), 'Empty array value should be cached and reused');
Assert.AreEqual(0, empty1.ElementCount, 'Empty array should have 0 elements'); Assert.AreEqual(0, empty1.ElementCount, 'Empty array should have 0 elements');
Assert.AreEqual('[]', empty1.AsString, 'Empty array AsString is incorrect'); Assert.AreEqual('[]', IDataArrayValue(empty1).AsString, 'Empty array AsString is incorrect');
// Test optimized path for 1 element // Test optimized path for 1 element
single := arrayType.CreateValue([TDataValue.FromOrdinal(42)]); single := arrayType.CreateValue([TDataValue.FromOrdinal(42)]);
Assert.IsNotNull(single, 'Single element array should be created'); Assert.IsNotNull(IDataArrayValue(single), 'Single element array should be created');
Assert.AreEqual(1, single.ElementCount, 'Single element array should have 1 element'); Assert.AreEqual(1, single.ElementCount, 'Single element array should have 1 element');
Assert.AreEqual(Int64(42), TDataValue(single.Items[0]).AsOrdinal.Value, 'Single element value is incorrect'); Assert.AreEqual(Int64(42), TDataValue(single.Items[0]).AsOrdinal.Value, 'Single element value is incorrect');
Assert.AreEqual('[42]', single.AsString, 'Single element array AsString is incorrect'); Assert.AreEqual('[42]', IDataArrayValue(single).AsString, 'Single element array AsString is incorrect');
// Test generic path for > 1 elements // Test generic path for > 1 elements
generic := arrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2), TDataValue.FromOrdinal(3)]); generic := arrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2), TDataValue.FromOrdinal(3)]);
Assert.IsNotNull(generic, 'Generic array should be created'); Assert.IsNotNull(IDataArrayValue(generic), 'Generic array should be created');
Assert.AreEqual(3, generic.ElementCount, 'Generic array should have 3 elements'); Assert.AreEqual(3, generic.ElementCount, 'Generic array should have 3 elements');
Assert.AreEqual('[1, 2, 3]', generic.AsString, 'Generic array AsString is incorrect'); Assert.AreEqual('[1, 2, 3]', IDataArrayValue(generic).AsString, 'Generic array AsString is incorrect');
end; end;
procedure TMyTestObject.TestTexts; procedure TMyTestObject.TestTexts;
var var
textType: IDataTextType; textType: TDataTextType;
textValue1, textValue2: IDataTextValue; textValue1, textValue2: TDataTextValue;
dataValue: IDataValue; dataValue: IDataValue;
begin begin
// --- 1. Test Type Creation --- // --- 1. Test Type Creation ---
textType := TDataType.Text; textType := TDataType.Text;
Assert.IsNotNull(textType, 'TextType should be created'); Assert.IsNotNull(IDataTextType(textType), 'TextType should be created');
Assert.AreEqual('Text', textType.Name, 'Type name should be Text'); Assert.AreEqual('Text', TDataType(textType).Name, 'Type name should be Text');
Assert.AreEqual(dkText, textType.Kind, 'Type kind should be dkText'); Assert.AreEqual(dkText, TDataType(textType).Kind, 'Type kind should be dkText');
// --- 2. Test Value Creation and Access --- // --- 2. Test Value Creation and Access ---
textValue1 := TDataValue.FromText('Hello World'); textValue1 := TDataValue.FromText('Hello World');
Assert.IsNotNull(textValue1, 'TextValue should be created'); Assert.IsNotNull(IDataTextValue(textValue1), 'TextValue should be created');
Assert.AreSame(textType, textValue1.DataType, 'Value should have the correct data type'); Assert.AreSame(IDataType(textType), IDataTextValue(textValue1).DataType, 'Value should have the correct data type');
Assert.AreEqual('Hello World', textValue1.Value, 'Value should be ''Hello World'''); Assert.AreEqual('Hello World', textValue1.Value, 'Value should be ''Hello World''');
// Test another text value // Test another text value
@@ -334,65 +339,65 @@ end;
procedure TMyTestObject.TestTexts_OptimizedEmpty; procedure TMyTestObject.TestTexts_OptimizedEmpty;
var var
empty1, empty2: IDataTextValue; empty1, empty2: TDataTextValue;
begin begin
// Test the singleton implementation for the empty string. // Test the singleton implementation for the empty string.
empty1 := TDataValue.FromText(''); empty1 := TDataValue.FromText('');
empty2 := TDataValue.FromText(''); empty2 := TDataValue.FromText('');
Assert.IsNotNull(empty1, 'Empty text value should be created'); Assert.IsNotNull(IDataTextValue(empty1), 'Empty text value should be created');
Assert.AreSame(empty1, empty2, 'Empty text value should be a singleton'); Assert.AreSame(IDataTextValue(empty1), IDataTextValue(empty2), 'Empty text value should be a singleton');
Assert.AreEqual('', empty1.Value, 'Value of empty text should be empty'); Assert.AreEqual('', empty1.Value, 'Value of empty text should be empty');
Assert.AreEqual('', empty1.AsString, 'AsString of empty text should be empty'); Assert.AreEqual('', IDataTextValue(empty1).AsString, 'AsString of empty text should be empty');
end; end;
procedure TMyTestObject.TestFloats_OptimizedAndGeneric; procedure TMyTestObject.TestFloats_OptimizedAndGeneric;
var var
zero1, zero2, nan1, nan2, generic: IDataFloatValue; zero1, zero2, nan1, nan2, generic: TDataFloatValue;
begin begin
// Test singleton for 0.0 // Test singleton for 0.0
zero1 := TDataValue.FromFloat(0.0); zero1 := TDataValue.FromFloat(0.0);
zero2 := TDataValue.FromFloat(0.0); zero2 := TDataValue.FromFloat(0.0);
Assert.IsNotNull(zero1, 'Zero float should be created'); Assert.IsNotNull(IDataFloatValue(zero1), 'Zero float should be created');
Assert.AreSame(zero1, zero2, 'Zero float should be a singleton'); Assert.AreSame(IDataFloatValue(zero1), IDataFloatValue(zero2), 'Zero float should be a singleton');
Assert.AreEqual(0.0, zero1.Value, 'Value of zero float is incorrect'); Assert.AreEqual(0.0, zero1.Value, 'Value of zero float is incorrect');
// Test singleton for NaN // Test singleton for NaN
nan1 := TDataValue.FromFloat(NaN); nan1 := TDataValue.FromFloat(NaN);
nan2 := TDataValue.FromFloat(NaN); nan2 := TDataValue.FromFloat(NaN);
Assert.IsNotNull(nan1, 'NaN float should be created'); Assert.IsNotNull(IDataFloatValue(nan1), 'NaN float should be created');
Assert.AreSame(nan1, nan2, 'NaN float should be a singleton'); Assert.AreSame(IDataFloatValue(nan1), IDataFloatValue(nan2), 'NaN float should be a singleton');
Assert.IsTrue(IsNaN(nan1.Value), 'Value of NaN float should be NaN'); Assert.IsTrue(IsNaN(nan1.Value), 'Value of NaN float should be NaN');
Assert.AreEqual('NaN', nan1.AsString, 'NaN AsString is incorrect'); Assert.AreEqual('NaN', IDataFloatValue(nan1).AsString, 'NaN AsString is incorrect');
// Test generic path // Test generic path
generic := TDataValue.FromFloat(123.45); generic := TDataValue.FromFloat(123.45);
Assert.IsNotNull(generic, 'Generic float should be created'); Assert.IsNotNull(IDataFloatValue(generic), 'Generic float should be created');
Assert.AreNotSame(zero1, generic, 'Generic float should not be the zero singleton'); Assert.AreNotSame(IDataFloatValue(zero1), IDataFloatValue(generic), 'Generic float should not be the zero singleton');
Assert.AreNotSame(nan1, generic, 'Generic float should not be the NaN singleton'); Assert.AreNotSame(IDataFloatValue(nan1), IDataFloatValue(generic), 'Generic float should not be the NaN singleton');
Assert.AreEqual(123.45, generic.Value, 'Value of generic float is incorrect'); Assert.AreEqual(123.45, generic.Value, 'Value of generic float is incorrect');
end; end;
procedure TMyTestObject.TestTimestamps; procedure TMyTestObject.TestTimestamps;
var var
tsType: IDataTimestampType; tsType: TDataTimestampType;
tsValue1, tsValue2: IDataTimestampValue; tsValue1, tsValue2: TDataTimestampValue;
dataValue: IDataValue; dataValue: IDataValue;
now: TDateTime; now: TDateTime;
begin begin
// --- 1. Test Type Creation --- // --- 1. Test Type Creation ---
tsType := TDataType.Timestamp; tsType := TDataType.Timestamp;
Assert.IsNotNull(tsType, 'TimestampType should be created'); Assert.IsNotNull(IDataTimestampType(tsType), 'TimestampType should be created');
Assert.AreEqual('Timestamp', tsType.Name, 'Type name should be Timestamp'); Assert.AreEqual('Timestamp', TDataType(tsType).Name, 'Type name should be Timestamp');
Assert.AreEqual(dkTimestamp, tsType.Kind, 'Type kind should be dkTimestamp'); Assert.AreEqual(dkTimestamp, TDataType(tsType).Kind, 'Type kind should be dkTimestamp');
// --- 2. Test Value Creation and Access --- // --- 2. Test Value Creation and Access ---
now := System.Sysutils.Now; now := System.Sysutils.Now;
tsValue1 := TDataValue.FromTimestamp(now); tsValue1 := TDataValue.FromTimestamp(now);
Assert.IsNotNull(tsValue1, 'TimestampValue should be created'); Assert.IsNotNull(IDataTimestampValue(tsValue1), 'TimestampValue should be created');
Assert.AreSame(tsType, tsValue1.DataType, 'Value should have the correct data type'); Assert.AreSame(IDataType(tsType), IDataTimestampValue(tsValue1).DataType, 'Value should have the correct data type');
Assert.AreEqual(now, tsValue1.Value, 'Value should be the same'); Assert.AreEqual(now, tsValue1.Value, 'Value should be the same');
// Test another text value // Test another text value
@@ -414,15 +419,15 @@ end;
procedure TMyTestObject.TestEnums; procedure TMyTestObject.TestEnums;
var var
colorType: IDataEnumType; colorType: TDataEnumType;
red, green, blue: IDataEnumValue; red, green, blue: TDataEnumValue;
begin begin
// --- 1. Test Type Creation --- // --- 1. Test Type Creation ---
colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']); colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']);
Assert.IsNotNull(colorType, 'EnumType should be created'); Assert.IsNotNull(IDataEnumType(colorType), 'EnumType should be created');
Assert.AreEqual('Color', colorType.Name, 'Name should be Color'); Assert.AreEqual('Color', TDataType(colorType).Name, 'Name should be Color');
Assert.AreEqual(dkEnum, colorType.Kind, 'Kind should be dkEnum'); Assert.AreEqual(dkEnum, TDataType(colorType).Kind, 'Kind should be dkEnum');
Assert.AreEqual(3, colorType.IdentifierCount, 'IdentifierCount should be 3'); Assert.AreEqual(3, colorType.IdentifierCount, 'IdentifierCount should be 3');
Assert.AreEqual('Red', colorType.Identifiers[0], 'Identifier at index 0 should be Red'); Assert.AreEqual('Red', colorType.Identifiers[0], 'Identifier at index 0 should be Red');
Assert.AreEqual('Green', colorType.Identifiers[1], 'Identifier at index 1 should be Green'); Assert.AreEqual('Green', colorType.Identifiers[1], 'Identifier at index 1 should be Green');
@@ -433,17 +438,17 @@ begin
// --- 2. Test Value Creation and Access --- // --- 2. Test Value Creation and Access ---
red := colorType.CreateValue(0); red := colorType.CreateValue(0);
green := colorType.CreateValue('Green'); green := colorType.CreateValue('Green');
blue := TDataValue(colorType.CreateValue(2)).AsEnum; blue := colorType.CreateValue(2);
Assert.IsNotNull(red, 'EnumValue from index should be created'); Assert.IsNotNull(IDataEnumValue(red), 'EnumValue from index should be created');
Assert.AreSame(colorType, red.DataType, 'Red should have the correct data type'); Assert.AreSame(IDataType(colorType), IDataEnumValue(red).DataType, 'Red should have the correct data type');
Assert.AreEqual(0, red.Value, 'Value of Red should be 0'); Assert.AreEqual(0, red.Value, 'Value of Red should be 0');
Assert.AreEqual('Red', red.AsString, 'AsText of Red should be Red'); Assert.AreEqual('Red', IDataEnumValue(red).AsString, 'AsText of Red should be Red');
Assert.IsNotNull(green, 'EnumValue from identifier should be created'); Assert.IsNotNull(IDataEnumValue(green), 'EnumValue from identifier should be created');
Assert.AreSame(colorType, green.DataType, 'Green should have the correct data type'); Assert.AreSame(IDataType(colorType), IDataEnumValue(green).DataType, 'Green should have the correct data type');
Assert.AreEqual(1, green.Value, 'Value of Green should be 1'); Assert.AreEqual(1, green.Value, 'Value of Green should be 1');
Assert.AreEqual('Green', green.AsString, 'AsText of Green should be Green'); Assert.AreEqual('Green', IDataEnumValue(green).AsString, 'AsText of Green should be Green');
Assert.AreEqual(2, blue.Value, 'Value of Blue should be 2'); Assert.AreEqual(2, blue.Value, 'Value of Blue should be 2');
@@ -469,64 +474,64 @@ end;
procedure TMyTestObject.TestAsString; procedure TMyTestObject.TestAsString;
var var
ordinalValue: IDataOrdinalValue; ordinalValue: TDataOrdinalValue;
floatValue: IDataFloatValue; floatValue: TDataFloatValue;
textValue: IDataTextValue; textValue: TDataTextValue;
tsValue: IDataTimestampValue; tsValue: TDataTimestampValue;
enumValue: IDataEnumValue; enumValue: TDataEnumValue;
arrayValue: IDataArrayValue; arrayValue: TDataArrayValue;
recordValue: IDataRecordValue; recordValue: TDataRecordValue;
tupleValue: IDataTupleValue; tupleValue: TDataTupleValue;
colorType: IDataEnumType; colorType: TDataEnumType;
personType: IDataRecordType; personType: TDataRecordType;
intArrayType: IDataArrayType; intArrayType: TDataArrayType;
now: TDateTime; now: TDateTime;
begin begin
// Ordinal // Ordinal
ordinalValue := TDataValue.FromOrdinal(123); ordinalValue := TDataValue.FromOrdinal(123);
Assert.AreEqual('123', ordinalValue.AsString, 'Ordinal AsString incorrect'); Assert.AreEqual('123', IDataOrdinalValue(ordinalValue).AsString, 'Ordinal AsString incorrect');
// Float // Float
floatValue := TDataValue.FromFloat(45.67); floatValue := TDataValue.FromFloat(45.67);
Assert.AreEqual(FloatToStr(45.67), floatValue.AsString, 'Float AsString incorrect'); Assert.AreEqual(FloatToStr(45.67), IDataFloatValue(floatValue).AsString, 'Float AsString incorrect');
// Text // Text
textValue := TDataValue.FromText('Hello'); textValue := TDataValue.FromText('Hello');
Assert.AreEqual('Hello', textValue.AsString, 'Text AsString incorrect'); Assert.AreEqual('Hello', IDataTextValue(textValue).AsString, 'Text AsString incorrect');
// Timestamp // Timestamp
now := System.Sysutils.Now; now := System.Sysutils.Now;
tsValue := TDataValue.FromTimestamp(now); tsValue := TDataValue.FromTimestamp(now);
Assert.AreEqual(DateTimeToStr(now), tsValue.AsString, 'Timestamp AsString incorrect'); Assert.AreEqual(DateTimeToStr(now), IDataTimestampValue(tsValue).AsString, 'Timestamp AsString incorrect');
// Enum // Enum
colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']); colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']);
enumValue := colorType.CreateValue('Green'); enumValue := colorType.CreateValue('Green');
Assert.AreEqual('Green', enumValue.AsString, 'Enum AsString incorrect'); Assert.AreEqual('Green', IDataEnumValue(enumValue).AsString, 'Enum AsString incorrect');
// Array // Array
intArrayType := TDataType.ArrayOf(TDataType.Ordinal); intArrayType := TDataType.ArrayOf(TDataType.Ordinal);
arrayValue := intArrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2)]); arrayValue := intArrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2)]);
Assert.AreEqual('[1, 2]', arrayValue.AsString, 'Array AsString incorrect'); Assert.AreEqual('[1, 2]', IDataArrayValue(arrayValue).AsString, 'Array AsString incorrect');
// Record // Record
personType := TDataType.RecordOf([TRecordField.Create('ID', TDataType.Ordinal), TRecordField.Create('Name', TDataType.Text)]); personType := TDataType.RecordOf([TRecordField.Create('ID', TDataType.Ordinal), TRecordField.Create('Name', TDataType.Text)]);
recordValue := personType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('Bob')]); recordValue := personType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('Bob')]);
Assert.AreEqual('<ID: 1, Name: Bob>', recordValue.AsString, 'Record AsString incorrect'); Assert.AreEqual('<ID: 1, Name: Bob>', IDataRecordValue(recordValue).AsString, 'Record AsString incorrect');
// Tuple // Tuple
tupleValue := TDataValue.FromTuple([TDataValue.FromOrdinal(10), TDataValue.FromText('Tuple')]); tupleValue := TDataValue.FromTuple([TDataValue.FromOrdinal(10), TDataValue.FromText('Tuple')]);
Assert.AreEqual('(10, Tuple)', tupleValue.AsString, 'Tuple AsString incorrect'); Assert.AreEqual('(10, Tuple)', IDataTupleValue(tupleValue).AsString, 'Tuple AsString incorrect');
end; end;
procedure TMyTestObject.TestAsTValue; procedure TMyTestObject.TestAsTValue;
var var
dataValue: IDataValue; dataValue: IDataValue; // Keep as generic interface to test AsTValue
tv, element: TValue; tv, element: TValue;
now: TDateTime; now: TDateTime;
colorType: IDataEnumType; colorType: TDataEnumType;
intArrayType: IDataArrayType; intArrayType: TDataArrayType;
personType: IDataRecordType; personType: TDataRecordType;
begin begin
// --- Ordinal --- // --- Ordinal ---
dataValue := TDataValue.FromOrdinal(123); dataValue := TDataValue.FromOrdinal(123);
@@ -612,11 +617,13 @@ end;
procedure TMyTestObject.TestMethods; procedure TMyTestObject.TestMethods;
var var
ordinalType, textType: IDataType; ordinalType: TDataOrdinalType;
methodType1, methodType2, otherMethodType: IDataMethodType; textType: TDataTextType;
methodType1, methodType2, otherMethodType: TDataMethodType;
myFunc: TMethodProc; myFunc: TMethodProc;
methodValue: IDataMethodValue; methodValue: TDataMethodValue;
inputValue, resultValue: IDataValue; inputValue: TDataOrdinalValue;
resultValue: IDataValue;
tv: TValue; tv: TValue;
begin begin
// --- 1. Setup: Define base types --- // --- 1. Setup: Define base types ---
@@ -627,27 +634,32 @@ begin
methodType1 := TDataType.MethodOf(ordinalType, textType); methodType1 := TDataType.MethodOf(ordinalType, textType);
// Assertions for the created type // Assertions for the created type
Assert.IsNotNull(methodType1, 'MethodType should be created'); Assert.IsNotNull(IDataMethodType(methodType1), 'MethodType should be created');
Assert.AreEqual(dkMethod, methodType1.Kind, 'Kind should be dkMethod'); Assert.AreEqual(dkMethod, TDataType(methodType1).Kind, 'Kind should be dkMethod');
Assert.AreSame(ordinalType, methodType1.ArgType, 'ArgType should be Ordinal'); Assert.AreSame(IDataType(ordinalType), methodType1.ArgType, 'ArgType should be Ordinal');
Assert.AreSame(textType, methodType1.ResultType, 'ResultType should be Text'); Assert.AreSame(IDataType(textType), methodType1.ResultType, 'ResultType should be Text');
Assert.AreEqual('Method<Integer -> Text>', methodType1.Name, 'Type name should match expected format'); Assert.AreEqual('Method<Integer -> Text>', TDataType(methodType1).Name, 'Type name should match expected format');
// Test if the same definition returns the same cached instance // Test if the same definition returns the same cached instance
methodType2 := TDataType.MethodOf(ordinalType, textType); methodType2 := TDataType.MethodOf(ordinalType, textType);
Assert.AreSame(methodType1, methodType2, 'Method types should be cached and return the same instance'); Assert
.AreSame(IDataMethodType(methodType1), IDataMethodType(methodType2), 'Method types should be cached and return the same instance');
// Test if a different definition returns a new instance // Test if a different definition returns a new instance
otherMethodType := TDataType.MethodOf(textType, ordinalType); otherMethodType := TDataType.MethodOf(textType, ordinalType);
Assert.AreNotSame(methodType1, otherMethodType, 'Different signatures should result in different types'); Assert.AreNotSame(
Assert.AreEqual('Method<Text -> Integer>', otherMethodType.Name, 'Name of other method type is incorrect'); IDataMethodType(methodType1),
IDataMethodType(otherMethodType),
'Different signatures should result in different types'
);
Assert.AreEqual('Method<Text -> Integer>', TDataType(otherMethodType).Name, 'Name of other method type is incorrect');
// --- 3. Test Value Creation --- // --- 3. Test Value Creation ---
// Define a function that matches the signature Ordinal -> Text // Define a function that matches the signature Ordinal -> Text
myFunc := myFunc :=
function(const AValue: IDataValue): IDataValue function(const AValue: IDataValue): IDataValue
var var
ordinalValue: IDataOrdinalValue; ordinalValue: TDataOrdinalValue;
val: Int64; val: Int64;
begin begin
ordinalValue := TDataValue(AValue).AsOrdinal; ordinalValue := TDataValue(AValue).AsOrdinal;
@@ -656,8 +668,8 @@ begin
end; end;
methodValue := TDataValue.FromMethod(methodType1, myFunc); methodValue := TDataValue.FromMethod(methodType1, myFunc);
Assert.IsNotNull(methodValue, 'MethodValue should be created'); Assert.IsNotNull(IDataMethodValue(methodValue), 'MethodValue should be created');
Assert.AreSame(methodType1, methodValue.DataType, 'Value should have the correct data type'); Assert.AreSame(IDataType(methodType1), IDataMethodValue(methodValue).DataType, 'Value should have the correct data type');
// --- 4. Test Execution (Simulated) --- // --- 4. Test Execution (Simulated) ---
inputValue := TDataValue.FromOrdinal(42); inputValue := TDataValue.FromOrdinal(42);
@@ -665,13 +677,13 @@ begin
resultValue := methodValue.Value(inputValue); resultValue := methodValue.Value(inputValue);
Assert.IsNotNull(resultValue, 'Execution result should not be nil'); Assert.IsNotNull(resultValue, 'Execution result should not be nil');
Assert.AreSame(textType, resultValue.DataType, 'Result value should have Text type'); Assert.AreSame(IDataType(textType), resultValue.DataType, 'Result value should have Text type');
Assert.AreEqual('42', TDataValue(resultValue).AsText.Value, 'Result value content is incorrect'); Assert.AreEqual('42', TDataValue(resultValue).AsText.Value, 'Result value content is incorrect');
// --- 5. Test AsString and AsTValue --- // --- 5. Test AsString and AsTValue ---
Assert.AreEqual('<METHOD>', methodValue.AsString, 'Method AsString is incorrect'); Assert.AreEqual('<METHOD>', IDataMethodValue(methodValue).AsString, 'Method AsString is incorrect');
tv := methodValue.AsTValue; tv := IDataMethodValue(methodValue).AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Method TValue should not be empty'); Assert.IsFalse(tv.IsEmpty, 'Method TValue should not be empty');
Assert.AreEqual(tkInterface, tv.Kind, 'TValue kind for a TMethodProc should be tkInterface, as it is a reference-to-function'); Assert.AreEqual(tkInterface, tv.Kind, 'TValue kind for a TMethodProc should be tkInterface, as it is a reference-to-function');
Assert.IsTrue(TypeInfo(TMethodProc) = tv.TypeInfo, 'TValue should hold TMethodProc type info'); Assert.IsTrue(TypeInfo(TMethodProc) = tv.TypeInfo, 'TValue should hold TMethodProc type info');
Src/Myc.Trade.Indicators.Common.pas
+25 -25
View File
@@ -21,7 +21,7 @@ type
TSMA = class TSMA = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -39,7 +39,7 @@ type
class function CreateSMA(Period: Integer): TConvertFunc<Double, Double>; static; class function CreateSMA(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
[IndicatorName('EMA', 'Exponential Moving Average')] [IndicatorName('EMA', 'Exponential Moving Average')]
@@ -47,7 +47,7 @@ type
TEMA = class TEMA = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -64,7 +64,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static; class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateEMA(Period: Integer): TConvertFunc<Double, Double>; static; class function CreateEMA(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
[IndicatorName('WMA', 'Weighted Moving Average')] [IndicatorName('WMA', 'Weighted Moving Average')]
@@ -72,7 +72,7 @@ type
TWMA = class TWMA = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -89,7 +89,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static; class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateWMA(Period: Integer): TConvertFunc<Double, Double>; static; class function CreateWMA(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
[IndicatorName('HMA', 'Hull Moving Average')] [IndicatorName('HMA', 'Hull Moving Average')]
@@ -97,7 +97,7 @@ type
THMA = class THMA = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -114,7 +114,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static; class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateHMA(Period: Integer): TConvertFunc<Double, Double>; static; class function CreateHMA(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
[IndicatorName('RSI', 'Relative Strength Index')] [IndicatorName('RSI', 'Relative Strength Index')]
@@ -122,7 +122,7 @@ type
TRSI = class TRSI = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -139,7 +139,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static; class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateRSI(Period: Integer): TConvertFunc<Double, Double>; static; class function CreateRSI(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
[IndicatorName('MACD', 'Moving Average Convergence Divergence')] [IndicatorName('MACD', 'Moving Average Convergence Divergence')]
@@ -147,7 +147,7 @@ type
TMACD = class TMACD = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -173,7 +173,7 @@ type
EmaSignal: TConvertFunc<Double, Double> EmaSignal: TConvertFunc<Double, Double>
): TConvertFunc<Double, TMACD.TResult>; overload; static; ): TConvertFunc<Double, TMACD.TResult>; overload; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
[IndicatorName('Stoch', 'Stochastic Oscillator')] [IndicatorName('Stoch', 'Stochastic Oscillator')]
@@ -181,7 +181,7 @@ type
TStochastic = class TStochastic = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -205,7 +205,7 @@ type
const SmaD: TConvertFunc<Double, Double> const SmaD: TConvertFunc<Double, Double>
): TConvertFunc<TOhlcItem, TStochastic.TResult>; overload; static; ): TConvertFunc<TOhlcItem, TStochastic.TResult>; overload; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
[IndicatorName('StdDev', 'Standard Deviation')] [IndicatorName('StdDev', 'Standard Deviation')]
@@ -213,7 +213,7 @@ type
TStdDev = class TStdDev = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -230,7 +230,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static; class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateStdDev(Period: Integer): TConvertFunc<Double, Double>; static; class function CreateStdDev(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
[IndicatorName('BB', 'Bollinger Bands')] [IndicatorName('BB', 'Bollinger Bands')]
@@ -238,7 +238,7 @@ type
TBollingerBands = class TBollingerBands = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -258,7 +258,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static; class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateBollingerBands(Period: Integer; Multiplier: Double): TConvertFunc<Double, TResult>; static; class function CreateBollingerBands(Period: Integer; Multiplier: Double): TConvertFunc<Double, TResult>; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
[IndicatorName('ATR', 'Average True Range')] [IndicatorName('ATR', 'Average True Range')]
@@ -266,7 +266,7 @@ type
TATR = class TATR = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -284,7 +284,7 @@ type
class function CreateATR(Period: Integer): TConvertFunc<TOhlcItem, Double>; overload; static; class function CreateATR(Period: Integer): TConvertFunc<TOhlcItem, Double>; overload; static;
class function CreateATR(const MovAvgTR: TConvertFunc<Double, Double>): TConvertFunc<TOhlcItem, Double>; overload; static; class function CreateATR(const MovAvgTR: TConvertFunc<Double, Double>): TConvertFunc<TOhlcItem, Double>; overload; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
[IndicatorName('KC', 'Keltner Channels')] [IndicatorName('KC', 'Keltner Channels')]
@@ -292,7 +292,7 @@ type
TKeltnerChannels = class TKeltnerChannels = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -317,7 +317,7 @@ type
Multiplier: Double Multiplier: Double
): TConvertFunc<TOhlcItem, TKeltnerChannels.TResult>; overload; static; ): TConvertFunc<TOhlcItem, TKeltnerChannels.TResult>; overload; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
[IndicatorName('Mean', 'Mean Value')] [IndicatorName('Mean', 'Mean Value')]
@@ -325,7 +325,7 @@ type
TMean = class TMean = class
strict private strict private
class var class var
FFactory: IDataMethodValue; FFactory: TDataMethodValue;
class constructor CreateClass; class constructor CreateClass;
public public
type type
@@ -341,7 +341,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static; class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateMean: TConvertFunc<TArray<Double>, Double>; static; class function CreateMean: TConvertFunc<TArray<Double>, Double>; static;
// Provides the factory method for this indicator as a data value. // Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory; class property Factory: TDataMethodValue read FFactory;
end; end;
implementation implementation
@@ -350,7 +350,7 @@ implementation
class constructor TSMA.CreateClass; class constructor TSMA.CreateClass;
begin begin
{ var params := TDataType.RecordOf( [TRecordField.Create( 'Period', TDataType.Ordinal )] ); { var params := TDataType.RecordOf( [TRecordField.Create( 'Period', TDataType.Ordinal )] );
var args := TDataType.RecordOf( [TRecordField.Create( 'Value', TDataType.Float )] ); var args := TDataType.RecordOf( [TRecordField.Create( 'Value', TDataType.Float )] );
var results := TDataType.RecordOf( [TRecordField.Create( 'SMA', TDataType.Float )] ); var results := TDataType.RecordOf( [TRecordField.Create( 'SMA', TDataType.Float )] );
Src/Myc.Trade.Indicators_v2.pas
+37 -34
View File
@@ -68,23 +68,23 @@ type
public public
Identifier: String; Identifier: String;
// Use the custom type system instead of PTypeInfo. // Use the custom type system instead of PTypeInfo.
DataType: IDataType; DataType: TDataType;
end; end;
TFieldLayout = TArray<TFieldDef>; TFieldLayout = TArray<TFieldDef>;
// Interface for creating an indicator instance. Only contains functional aspects. // Interface for creating an indicator instance. Only contains functional aspects.
IIndicatorFactory = interface IIndicatorFactory = interface
function GetParamType: IDataType; function GetParamType: TDataType;
function GetArgType: IDataType; function GetArgType: TDataType;
function GetResultType: IDataType; function GetResultType: TDataType;
function CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>; function CreateIndicator(const Params: TDataValue): TConvertFunc<TDataValue, TDataValue>;
// Provides direct access to the type information of parameters, arguments, and results. // Provides direct access to the type information of parameters, arguments, and results.
property ParamType: IDataType read GetParamType; property ParamType: TDataType read GetParamType;
property ArgType: IDataType read GetArgType; property ArgType: TDataType read GetArgType;
property ResultType: IDataType read GetResultType; property ResultType: TDataType read GetResultType;
end; end;
TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory) TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory)
@@ -93,22 +93,22 @@ type
FName: String; FName: String;
FShortName: String; FShortName: String;
FHint: String; FHint: String;
FParamType: IDataType; FParamType: TDataType;
FArgType: IDataType; FArgType: TDataType;
FResultType: IDataType; FResultType: TDataType;
public public
constructor Create( constructor Create(
const AFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>; const AFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
const AShortName, AName, AHint: String; const AShortName, AName, AHint: String;
const AParamType, AArgType, AResultType: IDataType const AParamType, AArgType, AResultType: TDataType
); );
// IIndicatorFactory // IIndicatorFactory
function GetParamType: IDataType; function GetParamType: TDataType;
function GetArgType: IDataType; function GetArgType: TDataType;
function GetResultType: IDataType; function GetResultType: TDataType;
function CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>; overload; function CreateIndicator(const Params: TDataValue): TConvertFunc<TDataValue, TDataValue>; overload;
class function CreateFromTemplate<T>: TGenericIndicatorFactory; class function CreateFromTemplate<T>: TGenericIndicatorFactory;
@@ -163,7 +163,7 @@ type
var var
IndicatorRegistry: TIndicatorRegistry; IndicatorRegistry: TIndicatorRegistry;
function DataValueFromTValue(const aValue: TValue): IDataValue; function DataValueFromTValue(const aValue: TValue): TDataValue;
function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDataType; function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDataType;
implementation implementation
@@ -180,7 +180,7 @@ function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDa
begin begin
if not Assigned(rttiType) then if not Assigned(rttiType) then
begin begin
Result := nil; Result := TDataType.Create(nil);
exit; exit;
end; end;
@@ -207,13 +207,13 @@ begin
end; end;
// Converts a TValue into an IDataValue. This is the bridge from RTTI to the custom type system. // Converts a TValue into an IDataValue. This is the bridge from RTTI to the custom type system.
function DataValueFromTValue(const aValue: TValue): IDataValue; function DataValueFromTValue(const aValue: TValue): TDataValue;
var var
ctx: TRttiContext; ctx: TRttiContext;
begin begin
if aValue.IsEmpty then if aValue.IsEmpty then
begin begin
Result := nil; Result := TDataValue.Create(nil);
exit; exit;
end; end;
@@ -261,7 +261,7 @@ end;
constructor TGenericIndicatorFactory.Create( constructor TGenericIndicatorFactory.Create(
const AFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>; const AFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
const AShortName, AName, AHint: String; const AShortName, AName, AHint: String;
const AParamType, AArgType, AResultType: IDataType const AParamType, AArgType, AResultType: TDataType
); );
begin begin
inherited Create; inherited Create;
@@ -278,7 +278,7 @@ class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicator
var var
Ctx: TRttiContext; Ctx: TRttiContext;
rttiType: TRttiType; rttiType: TRttiType;
paramsDataType, argsDataType, resultDataType: IDataType; paramsDataType, argsDataType, resultDataType: TDataType;
templateFactoryMethod: TRttiMethod; templateFactoryMethod: TRttiMethod;
factoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>; factoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
shortName, name, hint: string; shortName, name, hint: string;
@@ -345,7 +345,7 @@ begin
[templateFactoryMethod.ToString, E.Message]); [templateFactoryMethod.ToString, E.Message]);
end; end;
// Convert RTTI types to IDataType from our custom type system. // Convert RTTI types to TDataType from our custom type system.
paramsDataType := DataTypeFromRttiType(Ctx, factoryInvoke.GetParameters[0].ParamType); paramsDataType := DataTypeFromRttiType(Ctx, factoryInvoke.GetParameters[0].ParamType);
argsDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.GetParameters[0].ParamType); argsDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.GetParameters[0].ParamType);
resultDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.ReturnType); resultDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.ReturnType);
@@ -423,24 +423,27 @@ begin
Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsDataType, argsDataType, resultDataType); Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsDataType, argsDataType, resultDataType);
end; end;
function TGenericIndicatorFactory.GetParamType: IDataType; function TGenericIndicatorFactory.GetParamType: TDataType;
begin begin
Result := FParamType; Result := FParamType;
end; end;
function TGenericIndicatorFactory.GetArgType: IDataType; function TGenericIndicatorFactory.GetArgType: TDataType;
begin begin
Result := FArgType; Result := FArgType;
end; end;
function TGenericIndicatorFactory.GetResultType: IDataType; function TGenericIndicatorFactory.GetResultType: TDataType;
begin begin
Result := FResultType; Result := FResultType;
end; end;
function TGenericIndicatorFactory.CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>; function TGenericIndicatorFactory.CreateIndicator(const Params: TDataValue): TConvertFunc<TDataValue, TDataValue>;
var
internalProc: TConvertFunc<IDataValue, IDataValue>;
begin begin
Result := FFactoryProc(Params); internalProc := FFactoryProc(Params);
Result := function(const Args: TDataValue): TDataValue begin Result := internalProc(Args); end;
end; end;
function TGenericIndicatorFactory.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>; function TGenericIndicatorFactory.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
@@ -455,7 +458,7 @@ begin
var argsAsTValue := TValue.From<TArgs>(Args); var argsAsTValue := TValue.From<TArgs>(Args);
var argsAsDataValue := DataValueFromTValue(argsAsTValue); var argsAsDataValue := DataValueFromTValue(argsAsTValue);
var resultAsDataValue := cIndicator(argsAsDataValue); var resultAsDataValue := cIndicator(argsAsDataValue);
var resultAsTValue := resultAsDataValue.AsTValue; var resultAsTValue := IDataValue(resultAsDataValue).AsTValue;
Result := resultAsTValue.AsType<TResult>; Result := resultAsTValue.AsType<TResult>;
end; end;
end; end;
@@ -485,7 +488,7 @@ begin
var argsAsTValue := TValue.From<TArgs>(Args); var argsAsTValue := TValue.From<TArgs>(Args);
var argsAsDataValue := DataValueFromTValue(argsAsTValue); var argsAsDataValue := DataValueFromTValue(argsAsTValue);
var resultAsDataValue := cIndicator(argsAsDataValue); var resultAsDataValue := cIndicator(argsAsDataValue);
var resultAsTValue := resultAsDataValue.AsTValue; var resultAsTValue := IDataValue(resultAsDataValue).AsTValue;
Result := resultAsTValue.AsType<TResult>; Result := resultAsTValue.AsType<TResult>;
end; end;
end; end;
@@ -526,17 +529,17 @@ var
item: TItem; item: TItem;
// Generates a field layout from a data type. // Generates a field layout from a data type.
function LayoutFromDataType(DataType: IDataType): TFieldLayout; function LayoutFromDataType(DataType: TDataType): TFieldLayout;
var var
recordType: IDataRecordType; recordType: TDataRecordType;
begin begin
if (not Assigned(DataType)) or (DataType.Kind <> TDataKind.dkRecord) then if DataType.Kind <> TDataKind.dkRecord then
begin begin
SetLength(Result, 0); SetLength(Result, 0);
exit; exit;
end; end;
recordType := TDataType.Create(DataType).AsRecord; recordType := DataType.AsRecord;
SetLength(Result, recordType.FieldCount); SetLength(Result, recordType.FieldCount);
for var i := 0 to recordType.FieldCount - 1 do for var i := 0 to recordType.FieldCount - 1 do
begin begin
Test/MycTests.dpr
-1
View File
@@ -24,7 +24,6 @@ uses
Myc.Test.Signals.Latch in '..\Src\Myc.Test.Signals.Latch.pas', Myc.Test.Signals.Latch in '..\Src\Myc.Test.Signals.Latch.pas',
Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas', Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas',
Test.Core.Mutable in 'Test.Core.Mutable.pas', Test.Core.Mutable in 'Test.Core.Mutable.pas',
TestDataRecord in 'TestDataRecord.pas',
TestDataArray in 'TestDataArray.pas', TestDataArray in 'TestDataArray.pas',
Myc.Data.Types in '..\Src\Myc.Data.Types.pas', Myc.Data.Types in '..\Src\Myc.Data.Types.pas',
Myc.Data.Types.Ordinal in 'Myc.Data.Types.Ordinal.pas', Myc.Data.Types.Ordinal in 'Myc.Data.Types.Ordinal.pas',
Test/MycTests.dproj
-1
View File
@@ -125,7 +125,6 @@ $(PreBuildEvent)]]></PreBuildEvent>
<DCCReference Include="..\Src\Myc.Test.Signals.Latch.pas"/> <DCCReference Include="..\Src\Myc.Test.Signals.Latch.pas"/>
<DCCReference Include="..\Src\Myc.Test.Signals.Dirty.pas"/> <DCCReference Include="..\Src\Myc.Test.Signals.Dirty.pas"/>
<DCCReference Include="Test.Core.Mutable.pas"/> <DCCReference Include="Test.Core.Mutable.pas"/>
<DCCReference Include="TestDataRecord.pas"/>
<DCCReference Include="TestDataArray.pas"/> <DCCReference Include="TestDataArray.pas"/>
<DCCReference Include="..\Src\Myc.Data.Types.pas"/> <DCCReference Include="..\Src\Myc.Data.Types.pas"/>
<DCCReference Include="Myc.Data.Types.Ordinal.pas"/> <DCCReference Include="Myc.Data.Types.Ordinal.pas"/>