New type system

This commit is contained in:
Michael Schimmel
2025-08-26 12:44:10 +02:00
parent d2f7b01911
commit 262ee8ff69
6 changed files with 420 additions and 650 deletions
+2 -13
View File
@@ -17,12 +17,11 @@ type
function GetKind: TDataKind; function GetKind: TDataKind;
function GetIdentifier(Idx: Integer): string; function GetIdentifier(Idx: Integer): string;
function GetIdentifierCount: Integer; function GetIdentifierCount: Integer;
function IndexOf(const AIdentifier: string): Integer;
function CreateValue(const AValue: Integer): IDataEnumValue; overload;
function CreateValue(const AIdentifier: string): IDataEnumValue; overload;
public public
constructor Create(const AName: string; const AIdentifiers: array of string); constructor Create(const AName: string; const AIdentifiers: array of string);
destructor Destroy; override; destructor Destroy; override;
function IndexOf(const AIdentifier: string): Integer;
function CreateValue(const AValue: Integer): IDataEnumValue;
end; end;
implementation implementation
@@ -101,16 +100,6 @@ begin
Result := TImplDataEnumValue.Create(Self, AValue); Result := TImplDataEnumValue.Create(Self, AValue);
end; end;
function TImplDataEnumType.CreateValue(const AIdentifier: string): IDataEnumValue;
var
idx: Integer;
begin
idx := IndexOf(AIdentifier);
if idx < 0 then
raise EArgumentException.CreateFmt('Unknown identifier: %s', [AIdentifier]);
Result := CreateValue(idx);
end;
{ TImplDataEnumValue } { TImplDataEnumValue }
constructor TImplDataEnumValue.Create(const ADataType: IDataEnumType; const AValue: Integer); constructor TImplDataEnumValue.Create(const ADataType: IDataEnumType; const AValue: Integer);
File diff suppressed because it is too large Load Diff
+80 -80
View File
@@ -54,9 +54,9 @@ var
intType: TDataType.TOrdinal; intType: TDataType.TOrdinal;
floatType: TDataType.TFloat; floatType: TDataType.TFloat;
personType1, personType2, otherType: TDataType.TRecord; personType1, personType2, otherType: TDataType.TRecord;
personValue: TDataRecordValue; personValue: IDataRecordValue;
idValue: TDataOrdinalValue; idValue: IDataOrdinalValue;
floatValue: TDataFloatValue; floatValue: IDataFloatValue;
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 ---
@@ -88,8 +88,8 @@ begin
// --- 3. Test Value Creation and Access --- // --- 3. Test Value Creation and Access ---
personValue := personType1.CreateValue([TDataType.FromOrdinal(123), TDataType.FromFloat(45.67)]); personValue := personType1.CreateValue([TDataType.FromOrdinal(123), TDataType.FromFloat(45.67)]);
Assert.IsNotNull(IDataRecordValue(personValue), 'RecordValue should be created'); Assert.IsNotNull(personValue, 'RecordValue should be created');
Assert.AreSame(IDataRecordType(personType1), IDataRecordValue(personValue).DataType, 'Value should have the correct data type'); Assert.AreSame(IDataRecordType(personType1), personValue.DataType, 'Value should have the correct data type');
// Access by index // Access by index
idValue := TDataType.TValue(personValue.Items[0]).AsOrdinal; idValue := TDataType.TValue(personValue.Items[0]).AsOrdinal;
@@ -131,7 +131,7 @@ end;
procedure TMyTestObject.TestRecords_Generic; procedure TMyTestObject.TestRecords_Generic;
var var
dataType: TDataType.TRecord; dataType: TDataType.TRecord;
dataValue: TDataRecordValue; dataValue: IDataRecordValue;
begin begin
// Test the generic implementation for records with > 2 fields. // Test the generic implementation for records with > 2 fields.
dataType := dataType :=
@@ -144,19 +144,19 @@ begin
); );
dataValue := dataType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromText('two'), TDataType.FromFloat(3.0)]); dataValue := dataType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromText('two'), TDataType.FromFloat(3.0)]);
Assert.IsNotNull(IDataRecordValue(dataValue), 'Generic record value should be created'); Assert.IsNotNull(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), TDataType.TValue(dataValue.Items[0]).AsOrdinal.Value, 'Field A is incorrect'); Assert.AreEqual(Int64(1), TDataType.TValue(dataValue.Items[0]).AsOrdinal.Value, 'Field A is incorrect');
Assert.AreEqual('two', TDataType.TValue(dataValue.Items[1]).AsText.Value, 'Field B is incorrect'); Assert.AreEqual('two', TDataType.TValue(dataValue.Items[1]).AsText.Value, 'Field B is incorrect');
Assert.AreEqual(3.0, TDataType.TValue(dataValue.Items[2]).AsFloat.Value, 'Field C is incorrect'); Assert.AreEqual(3.0, TDataType.TValue(dataValue.Items[2]).AsFloat.Value, 'Field C is incorrect');
Assert.AreEqual('<A: 1, B: two, C: 3>', IDataRecordValue(dataValue).AsString, 'Generic record AsString is incorrect'); Assert.AreEqual('<A: 1, B: two, C: 3>', dataValue.AsString, 'Generic record AsString is incorrect');
end; end;
procedure TMyTestObject.TestTuples; procedure TMyTestObject.TestTuples;
var var
intValue: TDataOrdinalValue; intValue: IDataOrdinalValue;
floatValue: TDataFloatValue; floatValue: IDataFloatValue;
tuple1, tuple2, tuple3: TDataTupleValue; tuple1, tuple2, tuple3: IDataTupleValue;
type1, type2, type3: IDataType; // Keep as interface to test AreSame on the raw interface pointer 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.
@@ -167,10 +167,10 @@ begin
// --- 2. Test Value Creation and basic properties --- // --- 2. Test Value Creation and basic properties ---
tuple1 := TDataType.FromTuple([intValue, floatValue]); tuple1 := TDataType.FromTuple([intValue, floatValue]);
Assert.IsNotNull(IDataTupleValue(tuple1), 'Tuple value should be created'); Assert.IsNotNull(tuple1, 'Tuple value should be created');
Assert.AreEqual(2, tuple1.ItemCount, 'ItemCount should be on the value'); Assert.AreEqual(2, tuple1.ItemCount, 'ItemCount should be on the value');
Assert.AreSame(IDataValue(intValue), tuple1.Items[0], 'Item at index 0 is incorrect'); Assert.AreSame(intValue, tuple1.Items[0], 'Item at index 0 is incorrect');
Assert.AreSame(IDataValue(floatValue), tuple1.Items[1], 'Item at index 1 is incorrect'); Assert.AreSame(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 := TDataType.FromTuple([intValue]); tuple3 := TDataType.FromTuple([intValue]);
// Access the DataType via the underlying interface // Access the DataType via the underlying interface
type1 := IDataValue(tuple1).DataType; type1 := tuple1.DataType;
type2 := IDataValue(tuple2).DataType; type2 := tuple2.DataType;
type3 := IDataValue(tuple3).DataType; type3 := 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: TDataTupleValue; tupleValue: IDataTupleValue;
begin begin
// Test the generic implementation for tuples with > 5 elements. // Test the generic implementation for tuples with > 5 elements.
tupleValue := tupleValue :=
@@ -207,10 +207,10 @@ begin
] ]
); );
Assert.IsNotNull(IDataTupleValue(tupleValue), 'Generic tuple value should be created'); Assert.IsNotNull(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), TDataType.TValue(tupleValue.Items[5]).AsOrdinal.Value, 'Last item is incorrect'); Assert.AreEqual(Int64(6), TDataType.TValue(tupleValue.Items[5]).AsOrdinal.Value, 'Last item is incorrect');
Assert.AreEqual('(1, 2, 3, 4, 5, 6)', IDataTupleValue(tupleValue).AsString, 'Generic tuple AsString is incorrect'); Assert.AreEqual('(1, 2, 3, 4, 5, 6)', tupleValue.AsString, 'Generic tuple AsString is incorrect');
end; end;
procedure TMyTestObject.TestArrays; procedure TMyTestObject.TestArrays;
@@ -219,8 +219,8 @@ var
floatType: TDataType.TFloat; floatType: TDataType.TFloat;
intArrayType1, intArrayType2: TDataType.TArray; intArrayType1, intArrayType2: TDataType.TArray;
floatArrayType: TDataType.TArray; floatArrayType: TDataType.TArray;
arrayValue: TDataArrayValue; arrayValue: IDataArrayValue;
v1, v2: TDataOrdinalValue; v1, v2: IDataOrdinalValue;
begin begin
// --- 1. Setup --- // --- 1. Setup ---
intType := TDataType.Ordinal; intType := TDataType.Ordinal;
@@ -251,7 +251,7 @@ begin
v2 := TDataType.FromOrdinal(20); v2 := TDataType.FromOrdinal(20);
arrayValue := intArrayType1.CreateValue([v1, v2]); arrayValue := intArrayType1.CreateValue([v1, v2]);
Assert.IsNotNull(IDataArrayValue(arrayValue), 'ArrayValue should be created'); Assert.IsNotNull(arrayValue, 'ArrayValue should be created');
Assert.AreEqual(2, arrayValue.ElementCount, 'ElementCount should be 2'); Assert.AreEqual(2, arrayValue.ElementCount, 'ElementCount should be 2');
// Access items and check values // Access items and check values
@@ -277,36 +277,36 @@ end;
procedure TMyTestObject.TestArrays_OptimizedAndGeneric; procedure TMyTestObject.TestArrays_OptimizedAndGeneric;
var var
arrayType: TDataType.TArray; arrayType: TDataType.TArray;
empty1, empty2, single, generic: TDataArrayValue; empty1, empty2, single, generic: IDataArrayValue;
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(IDataArrayValue(empty1), 'Empty array value should be created'); Assert.IsNotNull(empty1, 'Empty array value should be created');
Assert.AreSame(IDataArrayValue(empty1), IDataArrayValue(empty2), 'Empty array value should be cached and reused'); Assert.AreSame(empty1, 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('[]', IDataArrayValue(empty1).AsString, 'Empty array AsString is incorrect'); Assert.AreEqual('[]', empty1.AsString, 'Empty array AsString is incorrect');
// Test optimized path for 1 element // Test optimized path for 1 element
single := arrayType.CreateValue([TDataType.FromOrdinal(42)]); single := arrayType.CreateValue([TDataType.FromOrdinal(42)]);
Assert.IsNotNull(IDataArrayValue(single), 'Single element array should be created'); Assert.IsNotNull(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), TDataType.TValue(single.Items[0]).AsOrdinal.Value, 'Single element value is incorrect'); Assert.AreEqual(Int64(42), TDataType.TValue(single.Items[0]).AsOrdinal.Value, 'Single element value is incorrect');
Assert.AreEqual('[42]', IDataArrayValue(single).AsString, 'Single element array AsString is incorrect'); Assert.AreEqual('[42]', single.AsString, 'Single element array AsString is incorrect');
// Test generic path for > 1 elements // Test generic path for > 1 elements
generic := arrayType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromOrdinal(2), TDataType.FromOrdinal(3)]); generic := arrayType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromOrdinal(2), TDataType.FromOrdinal(3)]);
Assert.IsNotNull(IDataArrayValue(generic), 'Generic array should be created'); Assert.IsNotNull(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]', IDataArrayValue(generic).AsString, 'Generic array AsString is incorrect'); Assert.AreEqual('[1, 2, 3]', generic.AsString, 'Generic array AsString is incorrect');
end; end;
procedure TMyTestObject.TestTexts; procedure TMyTestObject.TestTexts;
var var
textType: TDataType.TText; textType: TDataType.TText;
textValue1, textValue2: TDataTextValue; textValue1, textValue2: IDataTextValue;
dataValue: IDataValue; dataValue: IDataValue;
begin begin
// --- 1. Test Type Creation --- // --- 1. Test Type Creation ---
@@ -319,8 +319,8 @@ begin
// --- 2. Test Value Creation and Access --- // --- 2. Test Value Creation and Access ---
textValue1 := TDataType.FromText('Hello World'); textValue1 := TDataType.FromText('Hello World');
Assert.IsNotNull(IDataTextValue(textValue1), 'TextValue should be created'); Assert.IsNotNull(textValue1, 'TextValue should be created');
Assert.AreSame(IDataType(textType), IDataTextValue(textValue1).DataType, 'Value should have the correct data type'); Assert.AreSame(IDataType(textType), 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
@@ -342,49 +342,49 @@ end;
procedure TMyTestObject.TestTexts_OptimizedEmpty; procedure TMyTestObject.TestTexts_OptimizedEmpty;
var var
empty1, empty2: TDataTextValue; empty1, empty2: IDataTextValue;
begin begin
// Test the singleton implementation for the empty string. // Test the singleton implementation for the empty string.
empty1 := TDataType.FromText(''); empty1 := TDataType.FromText('');
empty2 := TDataType.FromText(''); empty2 := TDataType.FromText('');
Assert.IsNotNull(IDataTextValue(empty1), 'Empty text value should be created'); Assert.IsNotNull(empty1, 'Empty text value should be created');
Assert.AreSame(IDataTextValue(empty1), IDataTextValue(empty2), 'Empty text value should be a singleton'); Assert.AreSame(empty1, 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('', IDataTextValue(empty1).AsString, 'AsString of empty text should be empty'); Assert.AreEqual('', 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: TDataFloatValue; zero1, zero2, nan1, nan2, generic: IDataFloatValue;
begin begin
// Test singleton for 0.0 // Test singleton for 0.0
zero1 := TDataType.FromFloat(0.0); zero1 := TDataType.FromFloat(0.0);
zero2 := TDataType.FromFloat(0.0); zero2 := TDataType.FromFloat(0.0);
Assert.IsNotNull(IDataFloatValue(zero1), 'Zero float should be created'); Assert.IsNotNull(zero1, 'Zero float should be created');
Assert.AreSame(IDataFloatValue(zero1), IDataFloatValue(zero2), 'Zero float should be a singleton'); Assert.AreSame(zero1, 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 := TDataType.FromFloat(NaN); nan1 := TDataType.FromFloat(NaN);
nan2 := TDataType.FromFloat(NaN); nan2 := TDataType.FromFloat(NaN);
Assert.IsNotNull(IDataFloatValue(nan1), 'NaN float should be created'); Assert.IsNotNull(nan1, 'NaN float should be created');
Assert.AreSame(IDataFloatValue(nan1), IDataFloatValue(nan2), 'NaN float should be a singleton'); Assert.AreSame(nan1, 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', IDataFloatValue(nan1).AsString, 'NaN AsString is incorrect'); Assert.AreEqual('NaN', nan1.AsString, 'NaN AsString is incorrect');
// Test generic path // Test generic path
generic := TDataType.FromFloat(123.45); generic := TDataType.FromFloat(123.45);
Assert.IsNotNull(IDataFloatValue(generic), 'Generic float should be created'); Assert.IsNotNull(generic, 'Generic float should be created');
Assert.AreNotSame(IDataFloatValue(zero1), IDataFloatValue(generic), 'Generic float should not be the zero singleton'); Assert.AreNotSame(zero1, generic, 'Generic float should not be the zero singleton');
Assert.AreNotSame(IDataFloatValue(nan1), IDataFloatValue(generic), 'Generic float should not be the NaN singleton'); Assert.AreNotSame(nan1, 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: TDataType.TTimestamp; tsType: TDataType.TTimestamp;
tsValue1, tsValue2: TDataTimestampValue; tsValue1, tsValue2: IDataTimestampValue;
dataValue: IDataValue; dataValue: IDataValue;
now: TDateTime; now: TDateTime;
begin begin
@@ -399,8 +399,8 @@ begin
now := System.Sysutils.Now; now := System.Sysutils.Now;
tsValue1 := TDataType.FromTimestamp(now); tsValue1 := TDataType.FromTimestamp(now);
Assert.IsNotNull(IDataTimestampValue(tsValue1), 'TimestampValue should be created'); Assert.IsNotNull(tsValue1, 'TimestampValue should be created');
Assert.AreSame(IDataType(tsType), IDataTimestampValue(tsValue1).DataType, 'Value should have the correct data type'); Assert.AreSame(IDataType(tsType), 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
@@ -423,7 +423,7 @@ end;
procedure TMyTestObject.TestEnums; procedure TMyTestObject.TestEnums;
var var
colorType: TDataType.TEnum; colorType: TDataType.TEnum;
red, green, blue: TDataEnumValue; red, green, blue: IDataEnumValue;
begin begin
// --- 1. Test Type Creation --- // --- 1. Test Type Creation ---
colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']); colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']);
@@ -443,15 +443,15 @@ begin
green := colorType.CreateValue('Green'); green := colorType.CreateValue('Green');
blue := colorType.CreateValue(2); blue := colorType.CreateValue(2);
Assert.IsNotNull(IDataEnumValue(red), 'EnumValue from index should be created'); Assert.IsNotNull(red, 'EnumValue from index should be created');
Assert.AreSame(IDataType(colorType), IDataEnumValue(red).DataType, 'Red should have the correct data type'); Assert.AreSame(IDataType(colorType), 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', IDataEnumValue(red).AsString, 'AsText of Red should be Red'); Assert.AreEqual('Red', red.AsString, 'AsText of Red should be Red');
Assert.IsNotNull(IDataEnumValue(green), 'EnumValue from identifier should be created'); Assert.IsNotNull(green, 'EnumValue from identifier should be created');
Assert.AreSame(IDataType(colorType), IDataEnumValue(green).DataType, 'Green should have the correct data type'); Assert.AreSame(IDataType(colorType), 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', IDataEnumValue(green).AsString, 'AsText of Green should be Green'); Assert.AreEqual('Green', 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');
@@ -477,14 +477,14 @@ end;
procedure TMyTestObject.TestAsString; procedure TMyTestObject.TestAsString;
var var
ordinalValue: TDataOrdinalValue; ordinalValue: IDataOrdinalValue;
floatValue: TDataFloatValue; floatValue: IDataFloatValue;
textValue: TDataTextValue; textValue: IDataTextValue;
tsValue: TDataTimestampValue; tsValue: IDataTimestampValue;
enumValue: TDataEnumValue; enumValue: IDataEnumValue;
arrayValue: TDataArrayValue; arrayValue: IDataArrayValue;
recordValue: TDataRecordValue; recordValue: IDataRecordValue;
tupleValue: TDataTupleValue; tupleValue: IDataTupleValue;
colorType: TDataType.TEnum; colorType: TDataType.TEnum;
personType: TDataType.TRecord; personType: TDataType.TRecord;
intArrayType: TDataType.TArray; intArrayType: TDataType.TArray;
@@ -492,39 +492,39 @@ var
begin begin
// Ordinal // Ordinal
ordinalValue := TDataType.FromOrdinal(123); ordinalValue := TDataType.FromOrdinal(123);
Assert.AreEqual('123', IDataOrdinalValue(ordinalValue).AsString, 'Ordinal AsString incorrect'); Assert.AreEqual('123', ordinalValue.AsString, 'Ordinal AsString incorrect');
// Float // Float
floatValue := TDataType.FromFloat(45.67); floatValue := TDataType.FromFloat(45.67);
Assert.AreEqual(FloatToStr(45.67), IDataFloatValue(floatValue).AsString, 'Float AsString incorrect'); Assert.AreEqual(FloatToStr(45.67), floatValue.AsString, 'Float AsString incorrect');
// Text // Text
textValue := TDataType.FromText('Hello'); textValue := TDataType.FromText('Hello');
Assert.AreEqual('Hello', IDataTextValue(textValue).AsString, 'Text AsString incorrect'); Assert.AreEqual('Hello', textValue.AsString, 'Text AsString incorrect');
// Timestamp // Timestamp
now := System.Sysutils.Now; now := System.Sysutils.Now;
tsValue := TDataType.FromTimestamp(now); tsValue := TDataType.FromTimestamp(now);
Assert.AreEqual(DateTimeToStr(now), IDataTimestampValue(tsValue).AsString, 'Timestamp AsString incorrect'); Assert.AreEqual(DateTimeToStr(now), 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', IDataEnumValue(enumValue).AsString, 'Enum AsString incorrect'); Assert.AreEqual('Green', enumValue.AsString, 'Enum AsString incorrect');
// Array // Array
intArrayType := TDataType.ArrayOf(TDataType.Ordinal); intArrayType := TDataType.ArrayOf(TDataType.Ordinal);
arrayValue := intArrayType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromOrdinal(2)]); arrayValue := intArrayType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromOrdinal(2)]);
Assert.AreEqual('[1, 2]', IDataArrayValue(arrayValue).AsString, 'Array AsString incorrect'); Assert.AreEqual('[1, 2]', 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([TDataType.FromOrdinal(1), TDataType.FromText('Bob')]); recordValue := personType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromText('Bob')]);
Assert.AreEqual('<ID: 1, Name: Bob>', IDataRecordValue(recordValue).AsString, 'Record AsString incorrect'); Assert.AreEqual('<ID: 1, Name: Bob>', recordValue.AsString, 'Record AsString incorrect');
// Tuple // Tuple
tupleValue := TDataType.FromTuple([TDataType.FromOrdinal(10), TDataType.FromText('Tuple')]); tupleValue := TDataType.FromTuple([TDataType.FromOrdinal(10), TDataType.FromText('Tuple')]);
Assert.AreEqual('(10, Tuple)', IDataTupleValue(tupleValue).AsString, 'Tuple AsString incorrect'); Assert.AreEqual('(10, Tuple)', tupleValue.AsString, 'Tuple AsString incorrect');
end; end;
procedure TMyTestObject.TestAsTValue; procedure TMyTestObject.TestAsTValue;
@@ -624,8 +624,8 @@ var
textType: TDataType.TText; textType: TDataType.TText;
methodType1, methodType2, otherMethodType: TDataType.TMethod; methodType1, methodType2, otherMethodType: TDataType.TMethod;
myFunc: TDataType.TMethod.TProc; myFunc: TDataType.TMethod.TProc;
methodValue: TDataMethodValue; methodValue: IDataMethodValue;
inputValue: TDataOrdinalValue; inputValue: IDataOrdinalValue;
resultValue: IDataValue; resultValue: IDataValue;
tv: TValue; tv: TValue;
begin begin
@@ -662,7 +662,7 @@ begin
myFunc := myFunc :=
function(const AValue: TDataType.TValue): TDataType.TValue function(const AValue: TDataType.TValue): TDataType.TValue
var var
ordinalValue: TDataOrdinalValue; ordinalValue: IDataOrdinalValue;
val: Int64; val: Int64;
begin begin
ordinalValue := AValue.AsOrdinal; ordinalValue := AValue.AsOrdinal;
@@ -671,8 +671,8 @@ begin
end; end;
methodValue := TDataType.FromMethod(methodType1, myFunc); methodValue := TDataType.FromMethod(methodType1, myFunc);
Assert.IsNotNull(IDataMethodValue(methodValue), 'MethodValue should be created'); Assert.IsNotNull(methodValue, 'MethodValue should be created');
Assert.AreSame(IDataType(methodType1), IDataMethodValue(methodValue).DataType, 'Value should have the correct data type'); Assert.AreSame(IDataType(methodType1), methodValue.DataType, 'Value should have the correct data type');
// --- 4. Test Execution (Simulated) --- // --- 4. Test Execution (Simulated) ---
inputValue := TDataType.FromOrdinal(42); inputValue := TDataType.FromOrdinal(42);
@@ -684,9 +684,9 @@ begin
Assert.AreEqual('42', TDataType.TValue(resultValue).AsText.Value, 'Result value content is incorrect'); Assert.AreEqual('42', TDataType.TValue(resultValue).AsText.Value, 'Result value content is incorrect');
// --- 5. Test AsString and AsTValue --- // --- 5. Test AsString and AsTValue ---
Assert.AreEqual('<METHOD>', IDataMethodValue(methodValue).AsString, 'Method AsString is incorrect'); Assert.AreEqual('<METHOD>', methodValue.AsString, 'Method AsString is incorrect');
tv := IDataMethodValue(methodValue).AsTValue; tv := 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(TDataMethodProc) = tv.TypeInfo, 'TValue should hold TMethodProc type info'); Assert.IsTrue(TypeInfo(TDataMethodProc) = tv.TypeInfo, 'TValue should hold TMethodProc type info');
+33 -34
View File
@@ -21,7 +21,7 @@ type
TSMA = class TSMA = class
strict private strict private
class var class var
FFactory: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue 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: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue 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: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue 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: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue 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: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue 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: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue 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: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue 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: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue 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: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue 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: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue 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: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue 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: TDataMethodValue; FFactory: IDataMethodValue;
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: TDataMethodValue read FFactory; class property Factory: IDataMethodValue read FFactory;
end; end;
implementation implementation
@@ -819,7 +819,7 @@ begin
factoryMethodType.CreateValue( factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue function(const Params: TDataType.TValue): TDataType.TValue
var var
paramsRec: TDataRecordValue; paramsRec: IDataRecordValue;
begin begin
paramsRec := Params.AsRecord; paramsRec := Params.AsRecord;
var MACD := var MACD :=
@@ -985,7 +985,7 @@ begin
factoryMethodType.CreateValue( factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue function(const Params: TDataType.TValue): TDataType.TValue
var var
paramsRec: TDataRecordValue; paramsRec: IDataRecordValue;
begin begin
paramsRec := Params.AsRecord; paramsRec := Params.AsRecord;
var Stochastic := var Stochastic :=
@@ -998,7 +998,7 @@ begin
indicatorMethodType.CreateValue( indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue function(const Args: TDataType.TValue): TDataType.TValue
var var
ohlcRec: TDataRecordValue; ohlcRec: IDataRecordValue;
ohlcVal: TOhlcItem; ohlcVal: TOhlcItem;
begin begin
ohlcRec := Args.AsRecord; ohlcRec := Args.AsRecord;
@@ -1236,7 +1236,7 @@ begin
factoryMethodType.CreateValue( factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue function(const Params: TDataType.TValue): TDataType.TValue
var var
paramsRec: TDataRecordValue; paramsRec: IDataRecordValue;
begin begin
paramsRec := Params.AsRecord; paramsRec := Params.AsRecord;
var BollingerBands := var BollingerBands :=
@@ -1339,7 +1339,7 @@ begin
indicatorMethodType.CreateValue( indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue function(const Args: TDataType.TValue): TDataType.TValue
var var
ohlcRec: TDataRecordValue; ohlcRec: IDataRecordValue;
ohlcVal: TOhlcItem; ohlcVal: TOhlcItem;
begin begin
ohlcRec := Args.AsRecord; ohlcRec := Args.AsRecord;
@@ -1433,7 +1433,7 @@ begin
factoryMethodType.CreateValue( factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue function(const Params: TDataType.TValue): TDataType.TValue
var var
paramsRec: TDataRecordValue; paramsRec: IDataRecordValue;
begin begin
paramsRec := Params.AsRecord; paramsRec := Params.AsRecord;
var KeltnerChannels := var KeltnerChannels :=
@@ -1446,7 +1446,7 @@ begin
indicatorMethodType.CreateValue( indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue function(const Args: TDataType.TValue): TDataType.TValue
var var
ohlcRec: TDataRecordValue; ohlcRec: IDataRecordValue;
ohlcVal: TOhlcItem; ohlcVal: TOhlcItem;
begin begin
ohlcRec := Args.AsRecord; ohlcRec := Args.AsRecord;
@@ -1526,12 +1526,11 @@ end;
class constructor TMean.CreateClass; class constructor TMean.CreateClass;
begin begin
var paramsType := TDataType.RecordOf([]);
var argsType := TDataType.ArrayOf(TDataType.Float); var argsType := TDataType.ArrayOf(TDataType.Float);
var resultType := TDataType.Float; var resultType := TDataType.Float;
var indicatorMethodType := TDataType.MethodOf(argsType, resultType); var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType); var factoryMethodType := TDataType.MethodOf(TDataType.Void, indicatorMethodType);
FFactory := FFactory :=
factoryMethodType.CreateValue( factoryMethodType.CreateValue(
@@ -1543,7 +1542,7 @@ begin
function(const Args: TDataType.TValue): TDataType.TValue function(const Args: TDataType.TValue): TDataType.TValue
var var
i: Integer; i: Integer;
valuesArray: TDataArrayValue; valuesArray: IDataArrayValue;
values: TArray<Double>; values: TArray<Double>;
begin begin
valuesArray := Args.AsArray; valuesArray := Args.AsArray;
+2 -1
View File
@@ -31,7 +31,8 @@ uses
Myc.Data.Types.Float in 'Myc.Data.Types.Float.pas', Myc.Data.Types.Float in 'Myc.Data.Types.Float.pas',
Myc.Data.Types.Arrays in 'Myc.Data.Types.Arrays.pas', Myc.Data.Types.Arrays in 'Myc.Data.Types.Arrays.pas',
TestDataTypes in '..\Src\Data\TestDataTypes.pas', TestDataTypes in '..\Src\Data\TestDataTypes.pas',
Myc.Data.Types.Method in '..\Src\Data\Myc.Data.Types.Method.pas'; Myc.Data.Types.Method in '..\Src\Data\Myc.Data.Types.Method.pas',
Myc.Data.Types.Void in '..\Src\Data\Myc.Data.Types.Void.pas';
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit } { keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
{$IFNDEF TESTINSIGHT} {$IFNDEF TESTINSIGHT}
+1
View File
@@ -133,6 +133,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
<DCCReference Include="Myc.Data.Types.Arrays.pas"/> <DCCReference Include="Myc.Data.Types.Arrays.pas"/>
<DCCReference Include="..\Src\Data\TestDataTypes.pas"/> <DCCReference Include="..\Src\Data\TestDataTypes.pas"/>
<DCCReference Include="..\Src\Data\Myc.Data.Types.Method.pas"/> <DCCReference Include="..\Src\Data\Myc.Data.Types.Method.pas"/>
<DCCReference Include="..\Src\Data\Myc.Data.Types.Void.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>