New type system
This commit is contained in:
Michael Schimmel
@@ -11,25 +11,25 @@ uses
|
||||
|
||||
type
|
||||
// Custom comparer for TArray<TRecordField> to be used as a dictionary key.
|
||||
TRecordFieldComparer = class(TInterfacedObject, IEqualityComparer<TArray<TRecordField>>)
|
||||
TDataRecordFieldComparer = class(TInterfacedObject, IEqualityComparer<TArray<TDataRecordField>>)
|
||||
public
|
||||
function Equals(const Left, Right: TArray<TRecordField>): Boolean; reintroduce;
|
||||
function GetHashCode(const Value: TArray<TRecordField>): Integer; reintroduce;
|
||||
function Equals(const Left, Right: TArray<TDataRecordField>): Boolean; reintroduce;
|
||||
function GetHashCode(const Value: TArray<TDataRecordField>): Integer; reintroduce;
|
||||
end;
|
||||
|
||||
// Implements the record data type.
|
||||
TImplDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType)
|
||||
private
|
||||
FFields: TArray<TRecordField>;
|
||||
FFields: TArray<TDataRecordField>;
|
||||
FFieldMap: TDictionary<string, Integer>; // For fast lookups by name
|
||||
FEmptyValue: IDataRecordValue; // Cached instance for zero-field records
|
||||
function GetName: String;
|
||||
function GetKind: TDataKind;
|
||||
function GetFieldCount: Integer;
|
||||
function GetField(Idx: Integer): TRecordField;
|
||||
function GetField(Idx: Integer): TDataRecordField;
|
||||
function IndexOf(const AName: string): Integer;
|
||||
public
|
||||
constructor Create(const AFields: array of TRecordField);
|
||||
constructor Create(const AFields: array of TDataRecordField);
|
||||
destructor Destroy; override;
|
||||
function CreateValue(const AItems: array of IDataValue): IDataRecordValue;
|
||||
end;
|
||||
@@ -96,9 +96,9 @@ type
|
||||
constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
|
||||
end;
|
||||
|
||||
{ TRecordFieldComparer }
|
||||
{ TDataRecordFieldComparer }
|
||||
|
||||
function TRecordFieldComparer.Equals(const Left, Right: TArray<TRecordField>): Boolean;
|
||||
function TDataRecordFieldComparer.Equals(const Left, Right: TArray<TDataRecordField>): Boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
@@ -113,9 +113,9 @@ begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TRecordFieldComparer.GetHashCode(const Value: TArray<TRecordField>): Integer;
|
||||
function TDataRecordFieldComparer.GetHashCode(const Value: TArray<TDataRecordField>): Integer;
|
||||
var
|
||||
field: TRecordField;
|
||||
field: TDataRecordField;
|
||||
begin
|
||||
Result := 0;
|
||||
for field in Value do
|
||||
@@ -319,10 +319,10 @@ end;
|
||||
|
||||
{ TImplDataRecordType }
|
||||
|
||||
constructor TImplDataRecordType.Create(const AFields: array of TRecordField);
|
||||
constructor TImplDataRecordType.Create(const AFields: array of TDataRecordField);
|
||||
var
|
||||
i: Integer;
|
||||
field: TRecordField;
|
||||
field: TDataRecordField;
|
||||
begin
|
||||
inherited Create;
|
||||
FFieldMap := TDictionary<string, Integer>.Create;
|
||||
@@ -372,7 +372,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TImplDataRecordType.GetField(Idx: Integer): TRecordField;
|
||||
function TImplDataRecordType.GetField(Idx: Integer): TDataRecordField;
|
||||
begin
|
||||
Result := FFields[Idx];
|
||||
end;
|
||||
|
||||
+682
-149
File diff suppressed because it is too large
Load Diff
+118
-98
@@ -54,9 +54,9 @@ var
|
||||
intType: TDataType.TOrdinal;
|
||||
floatType: TDataType.TFloat;
|
||||
personType1, personType2, otherType: TDataType.TRecord;
|
||||
personValue: IDataRecordValue;
|
||||
idValue: IDataOrdinalValue;
|
||||
floatValue: IDataFloatValue;
|
||||
personValue: TDataType.TRecord.TValue;
|
||||
idValue: TDataType.TOrdinal.TValue;
|
||||
floatValue: TDataType.TFloat.TValue;
|
||||
begin
|
||||
// This test covers the optimized implementation for 2 fields.
|
||||
// --- 1. Setup: Define base types and a record structure ---
|
||||
@@ -64,7 +64,7 @@ begin
|
||||
floatType := TDataType.Float;
|
||||
|
||||
// --- 2. Test Type Creation and Caching ---
|
||||
personType1 := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Value', floatType)]);
|
||||
personType1 := TDataType.RecordOf([TDataRecordField.Create('ID', intType), TDataRecordField.Create('Value', floatType)]);
|
||||
|
||||
// Assertions for the created type
|
||||
Assert.IsNotNull(IDataRecordType(personType1), 'RecordType should be created');
|
||||
@@ -78,18 +78,18 @@ begin
|
||||
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
|
||||
personType2 := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Value', floatType)]);
|
||||
personType2 := TDataType.RecordOf([TDataRecordField.Create('ID', intType), TDataRecordField.Create('Value', floatType)]);
|
||||
Assert.AreSame(IDataRecordType(personType1), IDataRecordType(personType2), 'Types should be cached and return the same instance');
|
||||
|
||||
// Test if a different definition returns a new instance
|
||||
otherType := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Data', floatType)]);
|
||||
otherType := TDataType.RecordOf([TDataRecordField.Create('ID', intType), TDataRecordField.Create('Data', floatType)]);
|
||||
Assert.AreNotSame(IDataRecordType(personType1), IDataRecordType(otherType), 'Different definitions should result in different types');
|
||||
|
||||
// --- 3. Test Value Creation and Access ---
|
||||
personValue := personType1.CreateValue([TDataType.Ordinal.CreateValue(123), TDataType.Float.CreateValue(45.67)]);
|
||||
|
||||
Assert.IsNotNull(personValue, 'RecordValue should be created');
|
||||
Assert.AreSame(IDataRecordType(personType1), personValue.DataType, 'Value should have the correct data type');
|
||||
Assert.IsNotNull(IDataRecordValue(personValue), 'RecordValue should be created');
|
||||
Assert.AreSame(IDataRecordType(personType1), IDataRecordType(personValue.DataType), 'Value should have the correct data type');
|
||||
|
||||
// Access by index
|
||||
idValue := TDataType.TValue(personValue.Items[0]).AsOrdinal;
|
||||
@@ -104,7 +104,7 @@ begin
|
||||
// --- 4. Test Validation and Error Handling ---
|
||||
// Test for duplicate field names during type creation
|
||||
Assert.WillRaise(
|
||||
procedure begin TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('ID', floatType)]); end,
|
||||
procedure begin TDataType.RecordOf([TDataRecordField.Create('ID', intType), TDataRecordField.Create('ID', floatType)]); end,
|
||||
EArgumentException,
|
||||
'Duplicate field names should raise an exception'
|
||||
);
|
||||
@@ -131,33 +131,38 @@ end;
|
||||
procedure TMyTestObject.TestRecords_Generic;
|
||||
var
|
||||
dataType: TDataType.TRecord;
|
||||
dataValue: IDataRecordValue;
|
||||
dataValue: TDataType.TRecord.TValue;
|
||||
begin
|
||||
// Test the generic implementation for records with > 2 fields.
|
||||
dataType :=
|
||||
TDataType.RecordOf(
|
||||
[
|
||||
TRecordField.Create('A', TDataType.Ordinal),
|
||||
TRecordField.Create('B', TDataType.Text),
|
||||
TRecordField.Create('C', TDataType.Float)
|
||||
TDataRecordField.Create('A', TDataType.Ordinal),
|
||||
TDataRecordField.Create('B', TDataType.Text),
|
||||
TDataRecordField.Create('C', TDataType.Float)
|
||||
]
|
||||
);
|
||||
dataValue :=
|
||||
dataType.CreateValue([TDataType.Ordinal.CreateValue(1), TDataType.Text.CreateValue('two'), TDataType.Float.CreateValue(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(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(3.0, TDataType.TValue(dataValue.Items[2]).AsFloat.Value, 'Field C is incorrect');
|
||||
Assert.AreEqual('<A: 1, B: two, C: 3>', dataValue.AsString, 'Generic record AsString is incorrect');
|
||||
|
||||
var itemValue0 := dataValue.Items[0].AsOrdinal;
|
||||
Assert.AreEqual(Int64(1), itemValue0.Value, 'Field A is incorrect');
|
||||
var itemValue1 := dataValue.Items[1].AsText;
|
||||
Assert.AreEqual('two', itemValue1.Value, 'Field B is incorrect');
|
||||
var itemValue2 := dataValue.Items[2].AsFloat;
|
||||
Assert.AreEqual(3.0, itemValue2.Value, 'Field C is incorrect');
|
||||
|
||||
Assert.AreEqual('<A: 1, B: two, C: 3>', IDataValue(dataValue).AsString, 'Generic record AsString is incorrect');
|
||||
end;
|
||||
|
||||
procedure TMyTestObject.TestTuples;
|
||||
var
|
||||
intValue: IDataOrdinalValue;
|
||||
floatValue: IDataFloatValue;
|
||||
tuple1, tuple2, tuple3: IDataTupleValue;
|
||||
intValue: TDataType.TOrdinal.TValue;
|
||||
floatValue: TDataType.TFloat.TValue;
|
||||
tuple1, tuple2, tuple3: TDataType.TTuple.TValue;
|
||||
type1, type2, type3: IDataType; // Keep as interface to test AreSame on the raw interface pointer
|
||||
begin
|
||||
// This test covers optimized implementations for 1 and 2 elements.
|
||||
@@ -168,10 +173,10 @@ begin
|
||||
// --- 2. Test Value Creation and basic properties ---
|
||||
tuple1 := TDataType.Tuple.CreateValue([intValue, floatValue]);
|
||||
|
||||
Assert.IsNotNull(tuple1, 'Tuple value should be created');
|
||||
Assert.IsNotNull(IDataTupleValue(tuple1), 'Tuple value should be created');
|
||||
Assert.AreEqual(2, tuple1.ItemCount, 'ItemCount should be on the value');
|
||||
Assert.AreSame(intValue, tuple1.Items[0], 'Item at index 0 is incorrect');
|
||||
Assert.AreSame(floatValue, tuple1.Items[1], 'Item at index 1 is incorrect');
|
||||
Assert.AreSame(IDataValue(intValue), tuple1.Items[0], 'Item at index 0 is incorrect');
|
||||
Assert.AreSame(IDataValue(floatValue), tuple1.Items[1], 'Item at index 1 is incorrect');
|
||||
|
||||
// --- 3. Test Singleton Type Behavior ---
|
||||
// Create more tuples with different structures
|
||||
@@ -193,7 +198,8 @@ end;
|
||||
|
||||
procedure TMyTestObject.TestTuples_Generic;
|
||||
var
|
||||
tupleValue: IDataTupleValue;
|
||||
tupleValue: TDataType.TTuple.TValue;
|
||||
item: TDataType.TOrdinal.TValue;
|
||||
begin
|
||||
// Test the generic implementation for tuples with > 5 elements.
|
||||
tupleValue :=
|
||||
@@ -208,10 +214,12 @@ 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(Int64(6), TDataType.TValue(tupleValue.Items[5]).AsOrdinal.Value, 'Last item is incorrect');
|
||||
Assert.AreEqual('(1, 2, 3, 4, 5, 6)', tupleValue.AsString, 'Generic tuple AsString is incorrect');
|
||||
|
||||
item := TDataType.TValue(tupleValue.Items[5]).AsOrdinal;
|
||||
Assert.AreEqual(Int64(6), item.Value, 'Last item is incorrect');
|
||||
Assert.AreEqual('(1, 2, 3, 4, 5, 6)', IDataValue(tupleValue).AsString, 'Generic tuple AsString is incorrect');
|
||||
end;
|
||||
|
||||
procedure TMyTestObject.TestArrays;
|
||||
@@ -220,8 +228,9 @@ var
|
||||
floatType: TDataType.TFloat;
|
||||
intArrayType1, intArrayType2: TDataType.TArray;
|
||||
floatArrayType: TDataType.TArray;
|
||||
arrayValue: IDataArrayValue;
|
||||
v1, v2: IDataOrdinalValue;
|
||||
arrayValue: TDataType.TArray.TValue;
|
||||
v1, v2: TDataType.TOrdinal.TValue;
|
||||
item: TDataType.TOrdinal.TValue;
|
||||
begin
|
||||
// --- 1. Setup ---
|
||||
intType := TDataType.Ordinal;
|
||||
@@ -252,12 +261,14 @@ begin
|
||||
v2 := TDataType.Ordinal.CreateValue(20);
|
||||
arrayValue := intArrayType1.CreateValue([v1, v2]);
|
||||
|
||||
Assert.IsNotNull(arrayValue, 'ArrayValue should be created');
|
||||
Assert.IsNotNull(IDataArrayValue(arrayValue), 'ArrayValue should be created');
|
||||
Assert.AreEqual(2, arrayValue.ElementCount, 'ElementCount should be 2');
|
||||
|
||||
// Access items and check values
|
||||
Assert.AreEqual(Int64(10), TDataType.TValue(arrayValue.Items[0]).AsOrdinal.Value, 'Item at index 0 is incorrect');
|
||||
Assert.AreEqual(Int64(20), TDataType.TValue(arrayValue.Items[1]).AsOrdinal.Value, 'Item at index 1 is incorrect');
|
||||
item := TDataType.TValue(arrayValue.Items[0]).AsOrdinal;
|
||||
Assert.AreEqual(Int64(10), item.Value, 'Item at index 0 is incorrect');
|
||||
item := TDataType.TValue(arrayValue.Items[1]).AsOrdinal;
|
||||
Assert.AreEqual(Int64(20), item.Value, 'Item at index 1 is incorrect');
|
||||
|
||||
// --- 4. Test Validation and Error Handling ---
|
||||
// Test creating an array with a nil element type
|
||||
@@ -278,37 +289,40 @@ end;
|
||||
procedure TMyTestObject.TestArrays_OptimizedAndGeneric;
|
||||
var
|
||||
arrayType: TDataType.TArray;
|
||||
empty1, empty2, single, generic: IDataArrayValue;
|
||||
empty1, empty2, single, generic: TDataType.TArray.TValue;
|
||||
item: TDataType.TOrdinal.TValue;
|
||||
begin
|
||||
arrayType := TDataType.ArrayOf(TDataType.Ordinal);
|
||||
|
||||
// Test optimized path for 0 elements (cached singleton per type)
|
||||
empty1 := arrayType.CreateValue([]);
|
||||
empty2 := arrayType.CreateValue([]);
|
||||
Assert.IsNotNull(empty1, 'Empty array value should be created');
|
||||
Assert.AreSame(empty1, empty2, 'Empty array value should be cached and reused');
|
||||
Assert.IsNotNull(IDataArrayValue(empty1), 'Empty array value should be created');
|
||||
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('[]', empty1.AsString, 'Empty array AsString is incorrect');
|
||||
Assert.AreEqual('[]', IDataValue(empty1).AsString, 'Empty array AsString is incorrect');
|
||||
|
||||
// Test optimized path for 1 element
|
||||
single := arrayType.CreateValue([TDataType.Ordinal.CreateValue(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(Int64(42), TDataType.TValue(single.Items[0]).AsOrdinal.Value, 'Single element value is incorrect');
|
||||
Assert.AreEqual('[42]', single.AsString, 'Single element array AsString is incorrect');
|
||||
|
||||
item := TDataType.TValue(single.Items[0]).AsOrdinal;
|
||||
Assert.AreEqual(Int64(42), item.Value, 'Single element value is incorrect');
|
||||
Assert.AreEqual('[42]', IDataValue(single).AsString, 'Single element array AsString is incorrect');
|
||||
|
||||
// Test generic path for > 1 elements
|
||||
generic :=
|
||||
arrayType.CreateValue([TDataType.Ordinal.CreateValue(1), TDataType.Ordinal.CreateValue(2), TDataType.Ordinal.CreateValue(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('[1, 2, 3]', generic.AsString, 'Generic array AsString is incorrect');
|
||||
Assert.AreEqual('[1, 2, 3]', IDataValue(generic).AsString, 'Generic array AsString is incorrect');
|
||||
end;
|
||||
|
||||
procedure TMyTestObject.TestTexts;
|
||||
var
|
||||
textType: TDataType.TText;
|
||||
textValue1, textValue2: IDataTextValue;
|
||||
textValue1, textValue2, castedValue: TDataType.TText.TValue;
|
||||
dataValue: IDataValue;
|
||||
begin
|
||||
// --- 1. Test Type Creation ---
|
||||
@@ -321,8 +335,8 @@ begin
|
||||
// --- 2. Test Value Creation and Access ---
|
||||
textValue1 := TDataType.Text.CreateValue('Hello World');
|
||||
|
||||
Assert.IsNotNull(textValue1, 'TextValue should be created');
|
||||
Assert.AreSame(IDataType(textType), textValue1.DataType, 'Value should have the correct data type');
|
||||
Assert.IsNotNull(IDataTextValue(textValue1), 'TextValue should be created');
|
||||
Assert.AreSame(IDataType(textType), IDataType(textValue1.DataType), 'Value should have the correct data type');
|
||||
Assert.AreEqual('Hello World', textValue1.Value, 'Value should be ''Hello World''');
|
||||
|
||||
// Test another text value
|
||||
@@ -331,7 +345,8 @@ begin
|
||||
|
||||
// --- 3. Test AsText casting ---
|
||||
dataValue := TDataType.Text.CreateValue('Test Text');
|
||||
Assert.AreEqual('Test Text', TDataType.TValue(dataValue).AsText.Value, 'AsText should return correct value');
|
||||
castedValue := TDataType.TValue(dataValue).AsText;
|
||||
Assert.AreEqual('Test Text', castedValue.Value, 'AsText should return correct value');
|
||||
|
||||
// Test invalid cast
|
||||
dataValue := TDataType.Ordinal.CreateValue(123);
|
||||
@@ -344,49 +359,49 @@ end;
|
||||
|
||||
procedure TMyTestObject.TestTexts_OptimizedEmpty;
|
||||
var
|
||||
empty1, empty2: IDataTextValue;
|
||||
empty1, empty2: TDataType.TText.TValue;
|
||||
begin
|
||||
// Test the singleton implementation for the empty string.
|
||||
empty1 := TDataType.Text.CreateValue('');
|
||||
empty2 := TDataType.Text.CreateValue('');
|
||||
|
||||
Assert.IsNotNull(empty1, 'Empty text value should be created');
|
||||
Assert.AreSame(empty1, empty2, 'Empty text value should be a singleton');
|
||||
Assert.IsNotNull(IDataTextValue(empty1), 'Empty text value should be created');
|
||||
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.AsString, 'AsString of empty text should be empty');
|
||||
Assert.AreEqual('', IDataValue(empty1).AsString, 'AsString of empty text should be empty');
|
||||
end;
|
||||
|
||||
procedure TMyTestObject.TestFloats_OptimizedAndGeneric;
|
||||
var
|
||||
zero1, zero2, nan1, nan2, generic: IDataFloatValue;
|
||||
zero1, zero2, nan1, nan2, generic: TDataType.TFloat.TValue;
|
||||
begin
|
||||
// Test singleton for 0.0
|
||||
zero1 := TDataType.Float.CreateValue(0.0);
|
||||
zero2 := TDataType.Float.CreateValue(0.0);
|
||||
Assert.IsNotNull(zero1, 'Zero float should be created');
|
||||
Assert.AreSame(zero1, zero2, 'Zero float should be a singleton');
|
||||
Assert.IsNotNull(IDataFloatValue(zero1), 'Zero float should be created');
|
||||
Assert.AreSame(IDataFloatValue(zero1), IDataFloatValue(zero2), 'Zero float should be a singleton');
|
||||
Assert.AreEqual(0.0, zero1.Value, 'Value of zero float is incorrect');
|
||||
|
||||
// Test singleton for NaN
|
||||
nan1 := TDataType.Float.CreateValue(NaN);
|
||||
nan2 := TDataType.Float.CreateValue(NaN);
|
||||
Assert.IsNotNull(nan1, 'NaN float should be created');
|
||||
Assert.AreSame(nan1, nan2, 'NaN float should be a singleton');
|
||||
Assert.IsNotNull(IDataFloatValue(nan1), 'NaN float should be created');
|
||||
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.AreEqual('NaN', nan1.AsString, 'NaN AsString is incorrect');
|
||||
Assert.AreEqual('NaN', IDataValue(nan1).AsString, 'NaN AsString is incorrect');
|
||||
|
||||
// Test generic path
|
||||
generic := TDataType.Float.CreateValue(123.45);
|
||||
Assert.IsNotNull(generic, 'Generic float should be created');
|
||||
Assert.AreNotSame(zero1, generic, 'Generic float should not be the zero singleton');
|
||||
Assert.AreNotSame(nan1, generic, 'Generic float should not be the NaN singleton');
|
||||
Assert.IsNotNull(IDataFloatValue(generic), 'Generic float should be created');
|
||||
Assert.AreNotSame(IDataFloatValue(zero1), IDataFloatValue(generic), 'Generic float should not be the zero 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');
|
||||
end;
|
||||
|
||||
procedure TMyTestObject.TestTimestamps;
|
||||
var
|
||||
tsType: TDataType.TTimestamp;
|
||||
tsValue1, tsValue2: IDataTimestampValue;
|
||||
tsValue1, tsValue2, castedValue: TDataType.TTimestamp.TValue;
|
||||
dataValue: IDataValue;
|
||||
now: TDateTime;
|
||||
begin
|
||||
@@ -401,8 +416,8 @@ begin
|
||||
now := System.Sysutils.Now;
|
||||
tsValue1 := TDataType.Timestamp.CreateValue(now);
|
||||
|
||||
Assert.IsNotNull(tsValue1, 'TimestampValue should be created');
|
||||
Assert.AreSame(IDataType(tsType), tsValue1.DataType, 'Value should have the correct data type');
|
||||
Assert.IsNotNull(IDataTimestampValue(tsValue1), 'TimestampValue should be created');
|
||||
Assert.AreSame(IDataType(tsType), IDataType(tsValue1.DataType), 'Value should have the correct data type');
|
||||
Assert.AreEqual(now, tsValue1.Value, 'Value should be the same');
|
||||
|
||||
// Test another text value
|
||||
@@ -411,7 +426,8 @@ begin
|
||||
|
||||
// --- 3. Test AsTimestamp casting ---
|
||||
dataValue := TDataType.Timestamp.CreateValue(now);
|
||||
Assert.AreEqual(now, TDataType.TValue(dataValue).AsTimestamp.Value, 'AsTimestamp should return correct value');
|
||||
castedValue := TDataType.TValue(dataValue).AsTimestamp;
|
||||
Assert.AreEqual(now, castedValue.Value, 'AsTimestamp should return correct value');
|
||||
|
||||
// Test invalid cast
|
||||
dataValue := TDataType.Ordinal.CreateValue(123);
|
||||
@@ -425,7 +441,7 @@ end;
|
||||
procedure TMyTestObject.TestEnums;
|
||||
var
|
||||
colorType: TDataType.TEnum;
|
||||
red, green, blue: IDataEnumValue;
|
||||
red, green, blue: TDataType.TEnum.TValue;
|
||||
begin
|
||||
// --- 1. Test Type Creation ---
|
||||
colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']);
|
||||
@@ -445,15 +461,15 @@ begin
|
||||
green := colorType.CreateValue('Green');
|
||||
blue := colorType.CreateValue(2);
|
||||
|
||||
Assert.IsNotNull(red, 'EnumValue from index should be created');
|
||||
Assert.AreSame(IDataType(colorType), red.DataType, 'Red should have the correct data type');
|
||||
Assert.IsNotNull(IDataEnumValue(red), 'EnumValue from index should be created');
|
||||
Assert.AreSame(IDataType(colorType), IDataType(red.DataType), 'Red should have the correct data type');
|
||||
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', IDataValue(red).AsString, 'AsText of Red should be Red');
|
||||
|
||||
Assert.IsNotNull(green, 'EnumValue from identifier should be created');
|
||||
Assert.AreSame(IDataType(colorType), green.DataType, 'Green should have the correct data type');
|
||||
Assert.IsNotNull(IDataEnumValue(green), 'EnumValue from identifier should be created');
|
||||
Assert.AreSame(IDataType(colorType), IDataType(green.DataType), 'Green should have the correct data type');
|
||||
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', IDataValue(green).AsString, 'AsText of Green should be Green');
|
||||
|
||||
Assert.AreEqual(2, blue.Value, 'Value of Blue should be 2');
|
||||
|
||||
@@ -479,14 +495,14 @@ end;
|
||||
|
||||
procedure TMyTestObject.TestAsString;
|
||||
var
|
||||
ordinalValue: IDataOrdinalValue;
|
||||
floatValue: IDataFloatValue;
|
||||
textValue: IDataTextValue;
|
||||
tsValue: IDataTimestampValue;
|
||||
enumValue: IDataEnumValue;
|
||||
arrayValue: IDataArrayValue;
|
||||
recordValue: IDataRecordValue;
|
||||
tupleValue: IDataTupleValue;
|
||||
ordinalValue: TDataType.TOrdinal.TValue;
|
||||
floatValue: TDataType.TFloat.TValue;
|
||||
textValue: TDataType.TText.TValue;
|
||||
tsValue: TDataType.TTimestamp.TValue;
|
||||
enumValue: TDataType.TEnum.TValue;
|
||||
arrayValue: TDataType.TArray.TValue;
|
||||
recordValue: TDataType.TRecord.TValue;
|
||||
tupleValue: TDataType.TTuple.TValue;
|
||||
colorType: TDataType.TEnum;
|
||||
personType: TDataType.TRecord;
|
||||
intArrayType: TDataType.TArray;
|
||||
@@ -494,39 +510,39 @@ var
|
||||
begin
|
||||
// Ordinal
|
||||
ordinalValue := TDataType.Ordinal.CreateValue(123);
|
||||
Assert.AreEqual('123', ordinalValue.AsString, 'Ordinal AsString incorrect');
|
||||
Assert.AreEqual('123', IDataValue(ordinalValue).AsString, 'Ordinal AsString incorrect');
|
||||
|
||||
// Float
|
||||
floatValue := TDataType.Float.CreateValue(45.67);
|
||||
Assert.AreEqual(FloatToStr(45.67), floatValue.AsString, 'Float AsString incorrect');
|
||||
Assert.AreEqual(FloatToStr(45.67), IDataValue(floatValue).AsString, 'Float AsString incorrect');
|
||||
|
||||
// Text
|
||||
textValue := TDataType.Text.CreateValue('Hello');
|
||||
Assert.AreEqual('Hello', textValue.AsString, 'Text AsString incorrect');
|
||||
Assert.AreEqual('Hello', IDataValue(textValue).AsString, 'Text AsString incorrect');
|
||||
|
||||
// Timestamp
|
||||
now := System.Sysutils.Now;
|
||||
tsValue := TDataType.Timestamp.CreateValue(now);
|
||||
Assert.AreEqual(DateTimeToStr(now), tsValue.AsString, 'Timestamp AsString incorrect');
|
||||
Assert.AreEqual(DateTimeToStr(now), IDataValue(tsValue).AsString, 'Timestamp AsString incorrect');
|
||||
|
||||
// Enum
|
||||
colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']);
|
||||
enumValue := colorType.CreateValue('Green');
|
||||
Assert.AreEqual('Green', enumValue.AsString, 'Enum AsString incorrect');
|
||||
Assert.AreEqual('Green', IDataValue(enumValue).AsString, 'Enum AsString incorrect');
|
||||
|
||||
// Array
|
||||
intArrayType := TDataType.ArrayOf(TDataType.Ordinal);
|
||||
arrayValue := intArrayType.CreateValue([TDataType.Ordinal.CreateValue(1), TDataType.Ordinal.CreateValue(2)]);
|
||||
Assert.AreEqual('[1, 2]', arrayValue.AsString, 'Array AsString incorrect');
|
||||
Assert.AreEqual('[1, 2]', IDataValue(arrayValue).AsString, 'Array AsString incorrect');
|
||||
|
||||
// Record
|
||||
personType := TDataType.RecordOf([TRecordField.Create('ID', TDataType.Ordinal), TRecordField.Create('Name', TDataType.Text)]);
|
||||
personType := TDataType.RecordOf([TDataRecordField.Create('ID', TDataType.Ordinal), TDataRecordField.Create('Name', TDataType.Text)]);
|
||||
recordValue := personType.CreateValue([TDataType.Ordinal.CreateValue(1), TDataType.Text.CreateValue('Bob')]);
|
||||
Assert.AreEqual('<ID: 1, Name: Bob>', recordValue.AsString, 'Record AsString incorrect');
|
||||
Assert.AreEqual('<ID: 1, Name: Bob>', IDataValue(recordValue).AsString, 'Record AsString incorrect');
|
||||
|
||||
// Tuple
|
||||
tupleValue := TDataType.Tuple.CreateValue([TDataType.Ordinal.CreateValue(10), TDataType.Text.CreateValue('Tuple')]);
|
||||
Assert.AreEqual('(10, Tuple)', tupleValue.AsString, 'Tuple AsString incorrect');
|
||||
Assert.AreEqual('(10, Tuple)', IDataValue(tupleValue).AsString, 'Tuple AsString incorrect');
|
||||
end;
|
||||
|
||||
procedure TMyTestObject.TestAsTValue;
|
||||
@@ -538,6 +554,7 @@ var
|
||||
intArrayType: TDataType.TArray;
|
||||
personType: TDataType.TRecord;
|
||||
begin
|
||||
// This test is specifically for the IDataValue.AsTValue method. No changes needed.
|
||||
// --- Ordinal ---
|
||||
dataValue := TDataType.Ordinal.CreateValue(123);
|
||||
tv := dataValue.AsTValue;
|
||||
@@ -599,7 +616,7 @@ begin
|
||||
Assert.AreEqual(NativeInt(0), tv.GetArrayLength, 'Empty Array TValue length is incorrect');
|
||||
|
||||
// --- Record ---
|
||||
personType := TDataType.RecordOf([TRecordField.Create('ID', TDataType.Ordinal), TRecordField.Create('Name', TDataType.Text)]);
|
||||
personType := TDataType.RecordOf([TDataRecordField.Create('ID', TDataType.Ordinal), TDataRecordField.Create('Name', TDataType.Text)]);
|
||||
dataValue := personType.CreateValue([TDataType.Ordinal.CreateValue(1), TDataType.Text.CreateValue('Bob')]);
|
||||
tv := dataValue.AsTValue;
|
||||
Assert.IsFalse(tv.IsEmpty, 'Record TValue should not be empty');
|
||||
@@ -626,9 +643,10 @@ var
|
||||
textType: TDataType.TText;
|
||||
methodType1, methodType2, otherMethodType: TDataType.TMethod;
|
||||
myFunc: TDataType.TMethod.TProc;
|
||||
methodValue: IDataMethodValue;
|
||||
inputValue: IDataOrdinalValue;
|
||||
resultValue: IDataValue;
|
||||
methodValue: TDataType.TMethod.TValue;
|
||||
inputValue: TDataType.TOrdinal.TValue;
|
||||
resultValue: TDataType.TValue;
|
||||
textResult: TDataType.TText.TValue;
|
||||
tv: TValue;
|
||||
begin
|
||||
// --- 1. Setup: Define base types ---
|
||||
@@ -664,7 +682,7 @@ begin
|
||||
myFunc :=
|
||||
function(const AValue: TDataType.TValue): TDataType.TValue
|
||||
var
|
||||
ordinalValue: IDataOrdinalValue;
|
||||
ordinalValue: TDataType.TOrdinal.TValue;
|
||||
val: Int64;
|
||||
begin
|
||||
ordinalValue := AValue.AsOrdinal;
|
||||
@@ -673,22 +691,24 @@ begin
|
||||
end;
|
||||
|
||||
methodValue := methodType1.CreateValue(myFunc);
|
||||
Assert.IsNotNull(methodValue, 'MethodValue should be created');
|
||||
Assert.AreSame(IDataType(methodType1), methodValue.DataType, 'Value should have the correct data type');
|
||||
Assert.IsNotNull(IDataMethodValue(methodValue), 'MethodValue should be created');
|
||||
Assert.AreSame(IDataType(methodType1), IDataType(methodValue.DataType), 'Value should have the correct data type');
|
||||
|
||||
// --- 4. Test Execution (Simulated) ---
|
||||
inputValue := TDataType.Ordinal.CreateValue(42);
|
||||
// Execute the function retrieved from the value
|
||||
resultValue := methodValue.Value(inputValue);
|
||||
|
||||
Assert.IsNotNull(resultValue, 'Execution result should not be nil');
|
||||
Assert.IsNotNull(IDataValue(resultValue), 'Execution result should not be nil');
|
||||
Assert.AreSame(IDataType(textType), resultValue.DataType, 'Result value should have Text type');
|
||||
Assert.AreEqual('42', TDataType.TValue(resultValue).AsText.Value, 'Result value content is incorrect');
|
||||
|
||||
textResult := resultValue.AsText;
|
||||
Assert.AreEqual('42', textResult.Value, 'Result value content is incorrect');
|
||||
|
||||
// --- 5. Test AsString and AsTValue ---
|
||||
Assert.AreEqual('<METHOD>', methodValue.AsString, 'Method AsString is incorrect');
|
||||
Assert.AreEqual('<METHOD>', IDataValue(methodValue).AsString, 'Method AsString is incorrect');
|
||||
|
||||
tv := methodValue.AsTValue;
|
||||
tv := IDataValue(methodValue).AsTValue;
|
||||
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.IsTrue(TypeInfo(TDataMethodProc) = tv.TypeInfo, 'TValue should hold TMethodProc type info');
|
||||
|
||||
Reference in New Issue
Block a user