Michael Schimmel
677 lines
30 KiB
ObjectPascal
677 lines
30 KiB
ObjectPascal
unit TestDataTypes;
|
|
|
|
interface
|
|
|
|
uses
|
|
DUnitX.TestFramework;
|
|
|
|
type
|
|
[TestFixture]
|
|
[IgnoreMemoryLeaks]
|
|
TTestDataTypes = class
|
|
public
|
|
[Test]
|
|
procedure TestRecords;
|
|
[Test]
|
|
procedure TestRecords_Generic;
|
|
[Test]
|
|
procedure TestTuples;
|
|
[Test]
|
|
procedure TestTuples_Generic;
|
|
[Test]
|
|
procedure TestArrays;
|
|
[Test]
|
|
procedure TestArrays_OptimizedAndGeneric;
|
|
[Test]
|
|
procedure TestTexts;
|
|
[Test]
|
|
procedure TestTexts_OptimizedEmpty;
|
|
[Test]
|
|
procedure TestFloats_OptimizedAndGeneric;
|
|
[Test]
|
|
procedure TestTimestamps;
|
|
[Test]
|
|
procedure TestEnums;
|
|
[Test]
|
|
procedure TestAsString;
|
|
[Test]
|
|
procedure TestAsTValue;
|
|
[Test]
|
|
procedure TestMethods;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Math,
|
|
System.Rtti,
|
|
System.TypInfo,
|
|
Myc.Data.Types,
|
|
Myc.Data.Types.RTTI,
|
|
Myc.Data.Types.JSON;
|
|
|
|
procedure TTestDataTypes.TestRecords;
|
|
var
|
|
intType: TDataType.TOrdinal;
|
|
floatType: TDataType.TFloat;
|
|
personType1, personType2, otherType: TDataType.TRecord;
|
|
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 ---
|
|
intType := TDataType.Ordinal;
|
|
floatType := TDataType.Float;
|
|
|
|
// --- 2. Test Type Creation and Caching ---
|
|
personType1 := TDataType.RecordOf([TDataRecordField.Create('ID', intType), TDataRecordField.Create('Value', floatType)]);
|
|
|
|
// Assertions for the created type
|
|
Assert.IsNotNull(IDataRecordType(personType1), 'RecordType should be created');
|
|
Assert.AreEqual(2, personType1.FieldCount, 'FieldCount should be 2');
|
|
Assert.AreEqual('ID', personType1.Fields[0].Name, 'First field name should be ID');
|
|
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.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(1, personType1.IndexOf('Value'), 'IndexOf Value should be 1');
|
|
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([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([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(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;
|
|
Assert.AreEqual(Int64(123), idValue.Value, 'Value at index 0 is incorrect');
|
|
floatValue := TDataType.TValue(personValue.Items[1]).AsFloat;
|
|
Assert.AreEqual(45.67, floatValue.Value, 'Value at index 1 is incorrect');
|
|
|
|
// Access by name
|
|
floatValue := TDataType.TValue(personValue.Items[personType1.IndexOf('Value')]).AsFloat;
|
|
Assert.AreEqual(45.67, floatValue.Value, 'Value accessed by name is incorrect');
|
|
|
|
// --- 4. Test Validation and Error Handling ---
|
|
// Test for duplicate field names during type creation
|
|
Assert.WillRaise(
|
|
procedure begin TDataType.RecordOf([TDataRecordField.Create('ID', intType), TDataRecordField.Create('ID', floatType)]); end,
|
|
EArgumentException,
|
|
'Duplicate field names should raise an exception'
|
|
);
|
|
|
|
// Test for wrong number of items during value creation
|
|
Assert.WillRaise(
|
|
procedure begin personType1.CreateValue([TDataType.Ordinal.CreateValue(99)]); end,
|
|
EArgumentException,
|
|
'Wrong number of items should raise exception'
|
|
);
|
|
|
|
// Test for wrong item type during value creation
|
|
Assert.WillRaise(
|
|
procedure
|
|
begin
|
|
// Passing Float instead of Integer for the first item
|
|
personType1.CreateValue([TDataType.Float.CreateValue(1.0), TDataType.Float.CreateValue(2.0)]);
|
|
end,
|
|
EArgumentException,
|
|
'Wrong item type should raise exception'
|
|
);
|
|
end;
|
|
|
|
procedure TTestDataTypes.TestRecords_Generic;
|
|
var
|
|
dataType: TDataType.TRecord;
|
|
dataValue: TDataType.TRecord.TValue;
|
|
begin
|
|
// Test the generic implementation for records with > 2 fields.
|
|
dataType :=
|
|
TDataType.RecordOf(
|
|
[
|
|
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(IDataRecordValue(dataValue), 'Generic record value should be created');
|
|
Assert.AreEqual(3, dataType.FieldCount, 'Generic record should have 3 fields');
|
|
|
|
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 TTestDataTypes.TestTuples;
|
|
var
|
|
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.
|
|
// --- 1. Setup: Create some values ---
|
|
intValue := TDataType.Ordinal.CreateValue(123);
|
|
floatValue := TDataType.Float.CreateValue(45.67);
|
|
|
|
// --- 2. Test Value Creation and basic properties ---
|
|
tuple1 := TDataType.TupleOf([intValue, floatValue]);
|
|
|
|
Assert.IsNotNull(IDataTupleValue(tuple1), 'Tuple value should be created');
|
|
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(IDataValue(floatValue), tuple1.Items[1], 'Item at index 1 is incorrect');
|
|
|
|
// --- 3. Test Singleton Type Behavior ---
|
|
// Create more tuples with different structures
|
|
tuple2 := TDataType.TupleOf([TDataType.Ordinal.CreateValue(99), TDataType.Float.CreateValue(1.1)]);
|
|
tuple3 := TDataType.TupleOf([intValue]);
|
|
|
|
// Access the DataType via the underlying interface
|
|
type1 := tuple1.DataType;
|
|
type2 := tuple2.DataType;
|
|
type3 := tuple3.DataType;
|
|
|
|
Assert.IsNotNull(type1, 'DataType interface should be accessible');
|
|
Assert.AreEqual('Tuple<Integer, Float>', type1.Name, 'The type name for all tuples should be Tuple');
|
|
end;
|
|
|
|
procedure TTestDataTypes.TestTuples_Generic;
|
|
var
|
|
tupleValue: TDataType.TTuple.TValue;
|
|
item: TDataType.TOrdinal.TValue;
|
|
begin
|
|
// Test the generic implementation for tuples with > 5 elements.
|
|
tupleValue :=
|
|
TDataType.TupleOf(
|
|
[
|
|
TDataType.Ordinal.CreateValue(1),
|
|
TDataType.Ordinal.CreateValue(2),
|
|
TDataType.Ordinal.CreateValue(3),
|
|
TDataType.Ordinal.CreateValue(4),
|
|
TDataType.Ordinal.CreateValue(5),
|
|
TDataType.Ordinal.CreateValue(6)
|
|
]
|
|
);
|
|
|
|
Assert.IsNotNull(IDataTupleValue(tupleValue), 'Generic tuple value should be created');
|
|
Assert.AreEqual(6, tupleValue.ItemCount, 'Generic tuple should have 6 items');
|
|
|
|
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 TTestDataTypes.TestArrays;
|
|
var
|
|
intType: TDataType.TOrdinal;
|
|
floatType: TDataType.TFloat;
|
|
intArrayType1, intArrayType2: TDataType.TArray;
|
|
floatArrayType: TDataType.TArray;
|
|
arrayValue: TDataType.TArray.TValue;
|
|
v1, v2: TDataType.TOrdinal.TValue;
|
|
item: TDataType.TOrdinal.TValue;
|
|
begin
|
|
// --- 1. Setup ---
|
|
intType := TDataType.Ordinal;
|
|
floatType := TDataType.Float;
|
|
|
|
// --- 2. Test Type Creation and Caching ---
|
|
intArrayType1 := TDataType.ArrayOf(intType);
|
|
|
|
Assert.IsNotNull(IDataArrayType(intArrayType1), 'ArrayType should be created');
|
|
Assert.AreSame(IDataType(intType), intArrayType1.ElementType, 'ElementType should be Integer');
|
|
Assert.AreEqual('Array<Integer>', TDataType(intArrayType1).Name, 'Type name should be Array<Integer>');
|
|
|
|
// Test caching
|
|
intArrayType2 := TDataType.ArrayOf(intType);
|
|
Assert.AreSame(IDataArrayType(intArrayType1), IDataArrayType(intArrayType2), 'Array types should be cached');
|
|
|
|
// Test uniqueness
|
|
floatArrayType := TDataType.ArrayOf(floatType);
|
|
Assert.AreNotSame(
|
|
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 ---
|
|
v1 := TDataType.Ordinal.CreateValue(10);
|
|
v2 := TDataType.Ordinal.CreateValue(20);
|
|
arrayValue := intArrayType1.CreateValue([v1, v2]);
|
|
|
|
Assert.IsNotNull(IDataArrayValue(arrayValue), 'ArrayValue should be created');
|
|
Assert.AreEqual(2, arrayValue.ElementCount, 'ElementCount should be 2');
|
|
|
|
// Access items and check values
|
|
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
|
|
Assert.WillRaise(procedure begin TDataType.ArrayOf(nil); end, EArgumentException, 'Nil element type should raise an exception');
|
|
|
|
// Test creating a value with an incorrect element type (homogeneity check)
|
|
Assert.WillRaise(
|
|
procedure
|
|
begin
|
|
// Try to add a float value to an Array<Integer>
|
|
intArrayType1.CreateValue([v1, TDataType.Float.CreateValue(3.14)]);
|
|
end,
|
|
EArgumentException,
|
|
'Wrong element type should raise an exception'
|
|
);
|
|
end;
|
|
|
|
procedure TTestDataTypes.TestArrays_OptimizedAndGeneric;
|
|
var
|
|
arrayType: TDataType.TArray;
|
|
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(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('[]', IDataValue(empty1).AsString, 'Empty array AsString is incorrect');
|
|
|
|
// Test optimized path for 1 element
|
|
single := arrayType.CreateValue([TDataType.Ordinal.CreateValue(42)]);
|
|
Assert.IsNotNull(IDataArrayValue(single), 'Single element array should be created');
|
|
Assert.AreEqual(1, single.ElementCount, 'Single element array should have 1 element');
|
|
|
|
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(IDataArrayValue(generic), 'Generic array should be created');
|
|
Assert.AreEqual(3, generic.ElementCount, 'Generic array should have 3 elements');
|
|
Assert.AreEqual('[1, 2, 3]', IDataValue(generic).AsString, 'Generic array AsString is incorrect');
|
|
end;
|
|
|
|
procedure TTestDataTypes.TestTexts;
|
|
var
|
|
textType: TDataType.TText;
|
|
textValue1, textValue2, castedValue: TDataType.TText.TValue;
|
|
dataValue: IDataValue;
|
|
begin
|
|
// --- 1. Test Type Creation ---
|
|
textType := TDataType.Text;
|
|
|
|
Assert.IsNotNull(IDataTextType(textType), 'TextType should be created');
|
|
Assert.AreEqual('Text', TDataType(textType).Name, 'Type name should be Text');
|
|
Assert.AreEqual(dkText, TDataType(textType).Kind, 'Type kind should be dkText');
|
|
|
|
// --- 2. Test Value Creation and Access ---
|
|
textValue1 := TDataType.Text.CreateValue('Hello World');
|
|
|
|
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
|
|
textValue2 := TDataType.Text.CreateValue('Delphi');
|
|
Assert.AreEqual('Delphi', textValue2.Value, 'Value should be ''Delphi''');
|
|
|
|
// --- 3. Test AsText casting ---
|
|
dataValue := TDataType.Text.CreateValue('Test Text');
|
|
castedValue := TDataType.TValue(dataValue).AsText;
|
|
Assert.AreEqual('Test Text', castedValue.Value, 'AsText should return correct value');
|
|
|
|
// Test invalid cast
|
|
dataValue := TDataType.Ordinal.CreateValue(123);
|
|
Assert.WillRaise(
|
|
procedure begin TDataType.TValue(dataValue).AsText; end,
|
|
EInvalidCast,
|
|
'Casting non-text to AsText should raise EInvalidCast'
|
|
);
|
|
end;
|
|
|
|
procedure TTestDataTypes.TestTexts_OptimizedEmpty;
|
|
var
|
|
empty1, empty2: TDataType.TText.TValue;
|
|
begin
|
|
// Test the singleton implementation for the empty string.
|
|
empty1 := TDataType.Text.CreateValue('');
|
|
empty2 := TDataType.Text.CreateValue('');
|
|
|
|
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('', IDataValue(empty1).AsString, 'AsString of empty text should be empty');
|
|
end;
|
|
|
|
procedure TTestDataTypes.TestFloats_OptimizedAndGeneric;
|
|
var
|
|
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(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(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', IDataValue(nan1).AsString, 'NaN AsString is incorrect');
|
|
|
|
// Test generic path
|
|
generic := TDataType.Float.CreateValue(123.45);
|
|
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 TTestDataTypes.TestTimestamps;
|
|
var
|
|
tsType: TDataType.TTimestamp;
|
|
tsValue1, tsValue2, castedValue: TDataType.TTimestamp.TValue;
|
|
dataValue: IDataValue;
|
|
now: TDateTime;
|
|
begin
|
|
// --- 1. Test Type Creation ---
|
|
tsType := TDataType.Timestamp;
|
|
|
|
Assert.IsNotNull(IDataTimestampType(tsType), 'TimestampType should be created');
|
|
Assert.AreEqual('Timestamp', TDataType(tsType).Name, 'Type name should be Timestamp');
|
|
Assert.AreEqual(dkTimestamp, TDataType(tsType).Kind, 'Type kind should be dkTimestamp');
|
|
|
|
// --- 2. Test Value Creation and Access ---
|
|
now := System.Sysutils.Now;
|
|
tsValue1 := TDataType.Timestamp.CreateValue(now);
|
|
|
|
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
|
|
tsValue2 := TDataType.Timestamp.CreateValue(Date);
|
|
Assert.AreEqual(Date, tsValue2.Value, 'Value should be the same');
|
|
|
|
// --- 3. Test AsTimestamp casting ---
|
|
dataValue := TDataType.Timestamp.CreateValue(now);
|
|
castedValue := TDataType.TValue(dataValue).AsTimestamp;
|
|
Assert.AreEqual(now, castedValue.Value, 'AsTimestamp should return correct value');
|
|
|
|
// Test invalid cast
|
|
dataValue := TDataType.Ordinal.CreateValue(123);
|
|
Assert.WillRaise(
|
|
procedure begin TDataType.TValue(dataValue).AsTimestamp; end,
|
|
EInvalidCast,
|
|
'Casting non-timestamp to AsTimestamp should raise EInvalidCast'
|
|
);
|
|
end;
|
|
|
|
procedure TTestDataTypes.TestEnums;
|
|
var
|
|
colorType: TDataType.TEnum;
|
|
red, green, blue: TDataType.TEnum.TValue;
|
|
begin
|
|
// --- 1. Test Type Creation ---
|
|
colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']);
|
|
|
|
Assert.IsNotNull(IDataEnumType(colorType), 'EnumType should be created');
|
|
Assert.AreEqual('Color', TDataType(colorType).Name, 'Name should be Color');
|
|
Assert.AreEqual(dkEnum, TDataType(colorType).Kind, 'Kind should be dkEnum');
|
|
Assert.AreEqual(3, colorType.IdentifierCount, 'IdentifierCount should be 3');
|
|
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('Blue', colorType.Identifiers[2], 'Identifier at index 2 should be Blue');
|
|
Assert.AreEqual(1, colorType.IndexOf('Green'), 'IndexOf Green should be 1');
|
|
Assert.AreEqual(-1, colorType.IndexOf('Yellow'), 'IndexOf Yellow should be -1');
|
|
|
|
// --- 2. Test Value Creation and Access ---
|
|
red := colorType.CreateValue(0);
|
|
green := colorType.CreateValue('Green');
|
|
blue := colorType.CreateValue(2);
|
|
|
|
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', IDataValue(red).AsString, 'AsText of Red should be Red');
|
|
|
|
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', IDataValue(green).AsString, 'AsText of Green should be Green');
|
|
|
|
Assert.AreEqual(2, blue.Value, 'Value of Blue should be 2');
|
|
|
|
// --- 3. Test Validation and Error Handling ---
|
|
// Test creating a type with duplicate identifiers
|
|
Assert.WillRaise(
|
|
procedure begin TDataType.EnumOf('Fails', ['A', 'B', 'A']); end,
|
|
EArgumentException,
|
|
'Duplicate identifiers should raise an exception'
|
|
);
|
|
|
|
// Test creating a value with an invalid index
|
|
Assert.WillRaise(procedure begin colorType.CreateValue(3); end, EArgumentException, 'Invalid index should raise an exception');
|
|
Assert.WillRaise(procedure begin colorType.CreateValue(-1); end, EArgumentException, 'Negative index should raise an exception');
|
|
|
|
// Test creating a value with an unknown identifier
|
|
Assert.WillRaise(
|
|
procedure begin colorType.CreateValue('Yellow'); end,
|
|
EArgumentException,
|
|
'Unknown identifier should raise an exception'
|
|
);
|
|
end;
|
|
|
|
procedure TTestDataTypes.TestAsString;
|
|
var
|
|
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;
|
|
now: TDateTime;
|
|
begin
|
|
// Ordinal
|
|
ordinalValue := TDataType.Ordinal.CreateValue(123);
|
|
Assert.AreEqual('123', IDataValue(ordinalValue).AsString, 'Ordinal AsString incorrect');
|
|
|
|
// Float
|
|
floatValue := TDataType.Float.CreateValue(45.67);
|
|
Assert.AreEqual(FloatToStr(45.67), IDataValue(floatValue).AsString, 'Float AsString incorrect');
|
|
|
|
// Text
|
|
textValue := TDataType.Text.CreateValue('Hello');
|
|
Assert.AreEqual('Hello', IDataValue(textValue).AsString, 'Text AsString incorrect');
|
|
|
|
// Timestamp
|
|
now := System.Sysutils.Now;
|
|
tsValue := TDataType.Timestamp.CreateValue(now);
|
|
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', 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]', IDataValue(arrayValue).AsString, 'Array AsString incorrect');
|
|
|
|
// Record
|
|
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>', IDataValue(recordValue).AsString, 'Record AsString incorrect');
|
|
|
|
// Tuple
|
|
tupleValue := TDataType.TupleOf([TDataType.Ordinal.CreateValue(10), TDataType.Text.CreateValue('Tuple')]);
|
|
Assert.AreEqual('(10, Tuple)', IDataValue(tupleValue).AsString, 'Tuple AsString incorrect');
|
|
end;
|
|
|
|
procedure TTestDataTypes.TestAsTValue;
|
|
var
|
|
dataValue: TDataType.TValue; // Keep as generic interface to test AsTValue
|
|
now: TDateTime;
|
|
colorType: TDataType.TEnum;
|
|
begin
|
|
// This test is specifically for the IDataValue.AsTValue method. No changes needed.
|
|
// --- Ordinal ---
|
|
dataValue := TDataType.Ordinal.CreateValue(123);
|
|
var tv := AsTValue(dataValue);
|
|
Assert.IsFalse(tv.IsEmpty, 'Ordinal TValue should not be empty');
|
|
Assert.AreEqual(tkInt64, tv.Kind, 'Ordinal TValue kind should be tkInt64');
|
|
Assert.AreEqual(Int64(123), tv.AsInt64, 'Ordinal TValue content is incorrect');
|
|
|
|
// --- Float ---
|
|
dataValue := TDataType.Float.CreateValue(45.67);
|
|
tv := AsTValue(dataValue);
|
|
Assert.IsFalse(tv.IsEmpty, 'Float TValue should not be empty');
|
|
Assert.AreEqual(tkFloat, tv.Kind, 'Float TValue kind should be tkFloat');
|
|
Assert.AreEqual(45.67, tv.AsExtended, 'Float TValue content is incorrect');
|
|
|
|
// --- Text ---
|
|
dataValue := TDataType.Text.CreateValue('Hello');
|
|
tv := AsTValue(dataValue);
|
|
Assert.IsFalse(tv.IsEmpty, 'Text TValue should not be empty');
|
|
Assert.AreEqual(tkUString, tv.Kind, 'Text TValue kind should be tkUString');
|
|
Assert.AreEqual('Hello', tv.AsString, 'Text TValue content is incorrect');
|
|
|
|
// --- Timestamp ---
|
|
now := System.SysUtils.Now;
|
|
dataValue := TDataType.Timestamp.CreateValue(now);
|
|
tv := AsTValue(dataValue);
|
|
Assert.IsFalse(tv.IsEmpty, 'Timestamp TValue should not be empty');
|
|
Assert.AreEqual(tkFloat, tv.Kind, 'Timestamp TValue kind is incorrect');
|
|
Assert.AreEqual(now, tv.AsType<TDateTime>, 'Timestamp TValue content is incorrect');
|
|
|
|
// --- Enum ---
|
|
colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']);
|
|
dataValue := colorType.CreateValue('Green');
|
|
tv := AsTValue(dataValue);
|
|
Assert.IsFalse(tv.IsEmpty, 'Enum TValue should not be empty');
|
|
Assert.AreEqual(tkInteger, tv.Kind, 'Enum TValue kind should be tkInteger');
|
|
Assert.AreEqual(1, tv.AsInteger, 'Enum TValue content is incorrect');
|
|
end;
|
|
|
|
procedure TTestDataTypes.TestMethods;
|
|
var
|
|
ordinalType: TDataType.TOrdinal;
|
|
textType: TDataType.TText;
|
|
methodType1, methodType2, otherMethodType: TDataType.TMethod;
|
|
myFunc: TDataType.TMethod.TProc;
|
|
methodValue: TDataType.TMethod.TValue;
|
|
inputValue: TDataType.TOrdinal.TValue;
|
|
resultValue: TDataType.TValue;
|
|
textResult: TDataType.TText.TValue;
|
|
tv: TValue;
|
|
begin
|
|
// --- 1. Setup: Define base types ---
|
|
ordinalType := TDataType.Ordinal;
|
|
textType := TDataType.Text;
|
|
|
|
// --- 2. Test Type Creation and Caching ---
|
|
methodType1 := TDataType.MethodOf(ordinalType, textType);
|
|
|
|
// Assertions for the created type
|
|
Assert.IsNotNull(IDataMethodType(methodType1), 'MethodType should be created');
|
|
Assert.AreEqual(dkMethod, TDataType(methodType1).Kind, 'Kind should be dkMethod');
|
|
Assert.AreSame(IDataType(ordinalType), methodType1.ArgType, 'ArgType should be Ordinal');
|
|
Assert.AreSame(IDataType(textType), methodType1.ResultType, 'ResultType should be Text');
|
|
Assert.AreEqual('Method<Integer -> Text>', TDataType(methodType1).Name, 'Type name should match expected format');
|
|
|
|
// Test if the same definition returns the same cached instance
|
|
methodType2 := TDataType.MethodOf(ordinalType, textType);
|
|
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
|
|
otherMethodType := TDataType.MethodOf(textType, ordinalType);
|
|
Assert.AreNotSame(
|
|
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 ---
|
|
// Define a function that matches the signature Ordinal -> Text
|
|
myFunc :=
|
|
function(const AValue: TDataType.TValue): TDataType.TValue
|
|
var
|
|
ordinalValue: TDataType.TOrdinal.TValue;
|
|
val: Int64;
|
|
begin
|
|
ordinalValue := AValue.AsOrdinal;
|
|
val := ordinalValue.Value;
|
|
Result := TDataType.Text.CreateValue(val.ToString);
|
|
end;
|
|
|
|
methodValue := methodType1.CreateValue(myFunc);
|
|
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(IDataValue(resultValue), 'Execution result should not be nil');
|
|
Assert.AreSame(IDataType(textType), resultValue.DataType, 'Result value should have Text type');
|
|
|
|
textResult := resultValue.AsText;
|
|
Assert.AreEqual('42', textResult.Value, 'Result value content is incorrect');
|
|
|
|
// --- 5. Test AsString and AsTValue ---
|
|
Assert.AreEqual('<METHOD>', IDataValue(methodValue).AsString, 'Method AsString is incorrect');
|
|
|
|
tv := AsTValue(methodValue);
|
|
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');
|
|
|
|
// --- 6. Test Validation and Error Handling ---
|
|
// Test creating a value with a nil function
|
|
Assert.WillRaise(
|
|
procedure begin methodType1.CreateValue(nil); end,
|
|
EArgumentException,
|
|
'CreateValue with nil function should raise an exception'
|
|
);
|
|
end;
|
|
|
|
end.
|