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

Type System

Browse Source
This commit is contained in:
Michael Schimmel
2025-08-26 12:06:47 +02:00
parent 5adbe67d0b
commit d2f7b01911
5 changed files with 634 additions and 687 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Data/TestDataTypes.pas
+99 -96
View File
@@ -51,9 +51,9 @@ uses
procedure TMyTestObject.TestRecords;
var
intType: TDataOrdinalType;
floatType: TDataFloatType;
personType1, personType2, otherType: TDataRecordType;
intType: TDataType.TOrdinal;
floatType: TDataType.TFloat;
personType1, personType2, otherType: TDataType.TRecord;
personValue: TDataRecordValue;
idValue: TDataOrdinalValue;
floatValue: TDataFloatValue;
@@ -86,19 +86,19 @@ begin
Assert.AreNotSame(IDataRecordType(personType1), IDataRecordType(otherType), 'Different definitions should result in different types');
// --- 3. Test Value Creation and Access ---
personValue := personType1.CreateValue([TDataValue.FromOrdinal(123), TDataValue.FromFloat(45.67)]);
personValue := personType1.CreateValue([TDataType.FromOrdinal(123), TDataType.FromFloat(45.67)]);
Assert.IsNotNull(IDataRecordValue(personValue), 'RecordValue should be created');
Assert.AreSame(IDataRecordType(personType1), IDataRecordValue(personValue).DataType, 'Value should have the correct data type');
// Access by index
idValue := TDataValue(personValue.Items[0]).AsOrdinal;
idValue := TDataType.TValue(personValue.Items[0]).AsOrdinal;
Assert.AreEqual(Int64(123), idValue.Value, 'Value at index 0 is incorrect');
floatValue := TDataValue(personValue.Items[1]).AsFloat;
floatValue := TDataType.TValue(personValue.Items[1]).AsFloat;
Assert.AreEqual(45.67, floatValue.Value, 'Value at index 1 is incorrect');
// Access by name
floatValue := TDataValue(personValue.Items[personType1.IndexOf('Value')]).AsFloat;
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 ---
@@ -111,7 +111,7 @@ begin
// Test for wrong number of items during value creation
Assert.WillRaise(
procedure begin personType1.CreateValue([TDataValue.FromOrdinal(99)]); end,
procedure begin personType1.CreateValue([TDataType.FromOrdinal(99)]); end,
EArgumentException,
'Wrong number of items should raise exception'
);
@@ -121,7 +121,7 @@ begin
procedure
begin
// Passing Float instead of Integer for the first item
personType1.CreateValue([TDataValue.FromFloat(1.0), TDataValue.FromFloat(2.0)]);
personType1.CreateValue([TDataType.FromFloat(1.0), TDataType.FromFloat(2.0)]);
end,
EArgumentException,
'Wrong item type should raise exception'
@@ -130,7 +130,7 @@ end;
procedure TMyTestObject.TestRecords_Generic;
var
dataType: TDataRecordType;
dataType: TDataType.TRecord;
dataValue: TDataRecordValue;
begin
// Test the generic implementation for records with > 2 fields.
@@ -142,13 +142,13 @@ begin
TRecordField.Create('C', TDataType.Float)
]
);
dataValue := dataType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('two'), TDataValue.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.AreEqual(3, dataType.FieldCount, 'Generic record should have 3 fields');
Assert.AreEqual(Int64(1), TDataValue(dataValue.Items[0]).AsOrdinal.Value, 'Field A is incorrect');
Assert.AreEqual('two', TDataValue(dataValue.Items[1]).AsText.Value, 'Field B is incorrect');
Assert.AreEqual(3.0, TDataValue(dataValue.Items[2]).AsFloat.Value, 'Field C is incorrect');
Assert.AreEqual(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>', IDataRecordValue(dataValue).AsString, 'Generic record AsString is incorrect');
end;
@@ -161,11 +161,11 @@ var
begin
// This test covers optimized implementations for 1 and 2 elements.
// --- 1. Setup: Create some values ---
intValue := TDataValue.FromOrdinal(123);
floatValue := TDataValue.FromFloat(45.67);
intValue := TDataType.FromOrdinal(123);
floatValue := TDataType.FromFloat(45.67);
// --- 2. Test Value Creation and basic properties ---
tuple1 := TDataValue.FromTuple([intValue, floatValue]);
tuple1 := TDataType.FromTuple([intValue, floatValue]);
Assert.IsNotNull(IDataTupleValue(tuple1), 'Tuple value should be created');
Assert.AreEqual(2, tuple1.ItemCount, 'ItemCount should be on the value');
@@ -174,8 +174,8 @@ begin
// --- 3. Test Singleton Type Behavior ---
// Create more tuples with different structures
tuple2 := TDataValue.FromTuple([TDataValue.FromOrdinal(99), TDataValue.FromFloat(1.1)]);
tuple3 := TDataValue.FromTuple([intValue]);
tuple2 := TDataType.FromTuple([TDataType.FromOrdinal(99), TDataType.FromFloat(1.1)]);
tuple3 := TDataType.FromTuple([intValue]);
// Access the DataType via the underlying interface
type1 := IDataValue(tuple1).DataType;
@@ -196,29 +196,29 @@ var
begin
// Test the generic implementation for tuples with > 5 elements.
tupleValue :=
TDataValue.FromTuple(
TDataType.FromTuple(
[
TDataValue.FromOrdinal(1),
TDataValue.FromOrdinal(2),
TDataValue.FromOrdinal(3),
TDataValue.FromOrdinal(4),
TDataValue.FromOrdinal(5),
TDataValue.FromOrdinal(6)
TDataType.FromOrdinal(1),
TDataType.FromOrdinal(2),
TDataType.FromOrdinal(3),
TDataType.FromOrdinal(4),
TDataType.FromOrdinal(5),
TDataType.FromOrdinal(6)
]
);
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), TDataValue(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');
end;
procedure TMyTestObject.TestArrays;
var
intType: TDataOrdinalType;
floatType: TDataFloatType;
intArrayType1, intArrayType2: TDataArrayType;
floatArrayType: TDataArrayType;
intType: TDataType.TOrdinal;
floatType: TDataType.TFloat;
intArrayType1, intArrayType2: TDataType.TArray;
floatArrayType: TDataType.TArray;
arrayValue: TDataArrayValue;
v1, v2: TDataOrdinalValue;
begin
@@ -247,16 +247,16 @@ begin
Assert.AreEqual('Array<Float>', TDataType(floatArrayType).Name, 'Type name should be Array<Float>');
// --- 3. Test Value Creation and Access ---
v1 := TDataValue.FromOrdinal(10);
v2 := TDataValue.FromOrdinal(20);
v1 := TDataType.FromOrdinal(10);
v2 := TDataType.FromOrdinal(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
Assert.AreEqual(Int64(10), TDataValue(arrayValue.Items[0]).AsOrdinal.Value, 'Item at index 0 is incorrect');
Assert.AreEqual(Int64(20), TDataValue(arrayValue.Items[1]).AsOrdinal.Value, 'Item at index 1 is incorrect');
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');
// --- 4. Test Validation and Error Handling ---
// Test creating an array with a nil element type
@@ -267,7 +267,7 @@ begin
procedure
begin
// Try to add a float value to an Array<Integer>
intArrayType1.CreateValue([v1, TDataValue.FromFloat(3.14)]);
intArrayType1.CreateValue([v1, TDataType.FromFloat(3.14)]);
end,
EArgumentException,
'Wrong element type should raise an exception'
@@ -276,7 +276,7 @@ end;
procedure TMyTestObject.TestArrays_OptimizedAndGeneric;
var
arrayType: TDataArrayType;
arrayType: TDataType.TArray;
empty1, empty2, single, generic: TDataArrayValue;
begin
arrayType := TDataType.ArrayOf(TDataType.Ordinal);
@@ -290,14 +290,14 @@ begin
Assert.AreEqual('[]', IDataArrayValue(empty1).AsString, 'Empty array AsString is incorrect');
// Test optimized path for 1 element
single := arrayType.CreateValue([TDataValue.FromOrdinal(42)]);
single := arrayType.CreateValue([TDataType.FromOrdinal(42)]);
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), TDataValue(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');
// Test generic path for > 1 elements
generic := arrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2), TDataValue.FromOrdinal(3)]);
generic := arrayType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromOrdinal(2), TDataType.FromOrdinal(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]', IDataArrayValue(generic).AsString, 'Generic array AsString is incorrect');
@@ -305,7 +305,7 @@ end;
procedure TMyTestObject.TestTexts;
var
textType: TDataTextType;
textType: TDataType.TText;
textValue1, textValue2: TDataTextValue;
dataValue: IDataValue;
begin
@@ -317,24 +317,27 @@ begin
Assert.AreEqual(dkText, TDataType(textType).Kind, 'Type kind should be dkText');
// --- 2. Test Value Creation and Access ---
textValue1 := TDataValue.FromText('Hello World');
textValue1 := TDataType.FromText('Hello World');
Assert.IsNotNull(IDataTextValue(textValue1), 'TextValue should be created');
Assert.AreSame(IDataType(textType), IDataTextValue(textValue1).DataType, 'Value should have the correct data type');
Assert.AreEqual('Hello World', textValue1.Value, 'Value should be ''Hello World''');
// Test another text value
textValue2 := TDataValue.FromText('Delphi');
textValue2 := TDataType.FromText('Delphi');
Assert.AreEqual('Delphi', textValue2.Value, 'Value should be ''Delphi''');
// --- 3. Test AsText casting ---
dataValue := TDataValue.FromText('Test Text');
Assert.AreEqual('Test Text', TDataValue(dataValue).AsText.Value, 'AsText should return correct value');
dataValue := TDataType.FromText('Test Text');
Assert.AreEqual('Test Text', TDataType.TValue(dataValue).AsText.Value, 'AsText should return correct value');
// Test invalid cast
dataValue := TDataValue.FromOrdinal(123);
Assert
.WillRaise(procedure begin TDataValue(dataValue).AsText; end, EInvalidCast, 'Casting non-text to AsText should raise EInvalidCast');
dataValue := TDataType.FromOrdinal(123);
Assert.WillRaise(
procedure begin TDataType.TValue(dataValue).AsText; end,
EInvalidCast,
'Casting non-text to AsText should raise EInvalidCast'
);
end;
procedure TMyTestObject.TestTexts_OptimizedEmpty;
@@ -342,8 +345,8 @@ var
empty1, empty2: TDataTextValue;
begin
// Test the singleton implementation for the empty string.
empty1 := TDataValue.FromText('');
empty2 := TDataValue.FromText('');
empty1 := TDataType.FromText('');
empty2 := TDataType.FromText('');
Assert.IsNotNull(IDataTextValue(empty1), 'Empty text value should be created');
Assert.AreSame(IDataTextValue(empty1), IDataTextValue(empty2), 'Empty text value should be a singleton');
@@ -356,22 +359,22 @@ var
zero1, zero2, nan1, nan2, generic: TDataFloatValue;
begin
// Test singleton for 0.0
zero1 := TDataValue.FromFloat(0.0);
zero2 := TDataValue.FromFloat(0.0);
zero1 := TDataType.FromFloat(0.0);
zero2 := TDataType.FromFloat(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 := TDataValue.FromFloat(NaN);
nan2 := TDataValue.FromFloat(NaN);
nan1 := TDataType.FromFloat(NaN);
nan2 := TDataType.FromFloat(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', IDataFloatValue(nan1).AsString, 'NaN AsString is incorrect');
// Test generic path
generic := TDataValue.FromFloat(123.45);
generic := TDataType.FromFloat(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');
@@ -380,7 +383,7 @@ end;
procedure TMyTestObject.TestTimestamps;
var
tsType: TDataTimestampType;
tsType: TDataType.TTimestamp;
tsValue1, tsValue2: TDataTimestampValue;
dataValue: IDataValue;
now: TDateTime;
@@ -394,24 +397,24 @@ begin
// --- 2. Test Value Creation and Access ---
now := System.Sysutils.Now;
tsValue1 := TDataValue.FromTimestamp(now);
tsValue1 := TDataType.FromTimestamp(now);
Assert.IsNotNull(IDataTimestampValue(tsValue1), 'TimestampValue should be created');
Assert.AreSame(IDataType(tsType), IDataTimestampValue(tsValue1).DataType, 'Value should have the correct data type');
Assert.AreEqual(now, tsValue1.Value, 'Value should be the same');
// Test another text value
tsValue2 := TDataValue.FromTimestamp(Date);
tsValue2 := TDataType.FromTimestamp(Date);
Assert.AreEqual(Date, tsValue2.Value, 'Value should be the same');
// --- 3. Test AsTimestamp casting ---
dataValue := TDataValue.FromTimestamp(now);
Assert.AreEqual(now, TDataValue(dataValue).AsTimestamp.Value, 'AsTimestamp should return correct value');
dataValue := TDataType.FromTimestamp(now);
Assert.AreEqual(now, TDataType.TValue(dataValue).AsTimestamp.Value, 'AsTimestamp should return correct value');
// Test invalid cast
dataValue := TDataValue.FromOrdinal(123);
dataValue := TDataType.FromOrdinal(123);
Assert.WillRaise(
procedure begin TDataValue(dataValue).AsTimestamp; end,
procedure begin TDataType.TValue(dataValue).AsTimestamp; end,
EInvalidCast,
'Casting non-timestamp to AsTimestamp should raise EInvalidCast'
);
@@ -419,7 +422,7 @@ end;
procedure TMyTestObject.TestEnums;
var
colorType: TDataEnumType;
colorType: TDataType.TEnum;
red, green, blue: TDataEnumValue;
begin
// --- 1. Test Type Creation ---
@@ -482,26 +485,26 @@ var
arrayValue: TDataArrayValue;
recordValue: TDataRecordValue;
tupleValue: TDataTupleValue;
colorType: TDataEnumType;
personType: TDataRecordType;
intArrayType: TDataArrayType;
colorType: TDataType.TEnum;
personType: TDataType.TRecord;
intArrayType: TDataType.TArray;
now: TDateTime;
begin
// Ordinal
ordinalValue := TDataValue.FromOrdinal(123);
ordinalValue := TDataType.FromOrdinal(123);
Assert.AreEqual('123', IDataOrdinalValue(ordinalValue).AsString, 'Ordinal AsString incorrect');
// Float
floatValue := TDataValue.FromFloat(45.67);
floatValue := TDataType.FromFloat(45.67);
Assert.AreEqual(FloatToStr(45.67), IDataFloatValue(floatValue).AsString, 'Float AsString incorrect');
// Text
textValue := TDataValue.FromText('Hello');
textValue := TDataType.FromText('Hello');
Assert.AreEqual('Hello', IDataTextValue(textValue).AsString, 'Text AsString incorrect');
// Timestamp
now := System.Sysutils.Now;
tsValue := TDataValue.FromTimestamp(now);
tsValue := TDataType.FromTimestamp(now);
Assert.AreEqual(DateTimeToStr(now), IDataTimestampValue(tsValue).AsString, 'Timestamp AsString incorrect');
// Enum
@@ -511,16 +514,16 @@ begin
// Array
intArrayType := TDataType.ArrayOf(TDataType.Ordinal);
arrayValue := intArrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2)]);
arrayValue := intArrayType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromOrdinal(2)]);
Assert.AreEqual('[1, 2]', IDataArrayValue(arrayValue).AsString, 'Array AsString incorrect');
// Record
personType := TDataType.RecordOf([TRecordField.Create('ID', TDataType.Ordinal), TRecordField.Create('Name', TDataType.Text)]);
recordValue := personType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('Bob')]);
recordValue := personType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromText('Bob')]);
Assert.AreEqual('<ID: 1, Name: Bob>', IDataRecordValue(recordValue).AsString, 'Record AsString incorrect');
// Tuple
tupleValue := TDataValue.FromTuple([TDataValue.FromOrdinal(10), TDataValue.FromText('Tuple')]);
tupleValue := TDataType.FromTuple([TDataType.FromOrdinal(10), TDataType.FromText('Tuple')]);
Assert.AreEqual('(10, Tuple)', IDataTupleValue(tupleValue).AsString, 'Tuple AsString incorrect');
end;
@@ -529,26 +532,26 @@ var
dataValue: IDataValue; // Keep as generic interface to test AsTValue
tv, element: TValue;
now: TDateTime;
colorType: TDataEnumType;
intArrayType: TDataArrayType;
personType: TDataRecordType;
colorType: TDataType.TEnum;
intArrayType: TDataType.TArray;
personType: TDataType.TRecord;
begin
// --- Ordinal ---
dataValue := TDataValue.FromOrdinal(123);
dataValue := TDataType.FromOrdinal(123);
tv := dataValue.AsTValue;
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 := TDataValue.FromFloat(45.67);
dataValue := TDataType.FromFloat(45.67);
tv := dataValue.AsTValue;
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 := TDataValue.FromText('Hello');
dataValue := TDataType.FromText('Hello');
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Text TValue should not be empty');
Assert.AreEqual(tkUString, tv.Kind, 'Text TValue kind should be tkUString');
@@ -556,7 +559,7 @@ begin
// --- Timestamp ---
now := System.SysUtils.Now;
dataValue := TDataValue.FromTimestamp(now);
dataValue := TDataType.FromTimestamp(now);
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Timestamp TValue should not be empty');
Assert.AreEqual(tkFloat, tv.Kind, 'Timestamp TValue kind is incorrect');
@@ -572,7 +575,7 @@ begin
// --- Array ---
intArrayType := TDataType.ArrayOf(TDataType.Ordinal);
dataValue := intArrayType.CreateValue([TDataValue.FromOrdinal(10), TDataValue.FromOrdinal(20)]);
dataValue := intArrayType.CreateValue([TDataType.FromOrdinal(10), TDataType.FromOrdinal(20)]);
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Array TValue should not be empty');
Assert.IsTrue(tv.IsArray, 'Array TValue should be an array');
@@ -595,7 +598,7 @@ begin
// --- Record ---
personType := TDataType.RecordOf([TRecordField.Create('ID', TDataType.Ordinal), TRecordField.Create('Name', TDataType.Text)]);
dataValue := personType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('Bob')]);
dataValue := personType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromText('Bob')]);
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Record TValue should not be empty');
Assert.IsTrue(tv.IsArray, 'Record TValue should be represented as an array');
@@ -605,7 +608,7 @@ begin
Assert.AreEqual('Bob', tv.GetArrayElement(1).AsType<TValue>.AsString, 'Record TValue element 1 is incorrect');
// --- Tuple ---
dataValue := TDataValue.FromTuple([TDataValue.FromOrdinal(99), TDataValue.FromText('Red')]);
dataValue := TDataType.FromTuple([TDataType.FromOrdinal(99), TDataType.FromText('Red')]);
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Tuple TValue should not be empty');
Assert.IsTrue(tv.IsArray, 'Tuple TValue should be represented as an array');
@@ -617,10 +620,10 @@ end;
procedure TMyTestObject.TestMethods;
var
ordinalType: TDataOrdinalType;
textType: TDataTextType;
methodType1, methodType2, otherMethodType: TDataMethodType;
myFunc: TMethodProc;
ordinalType: TDataType.TOrdinal;
textType: TDataType.TText;
methodType1, methodType2, otherMethodType: TDataType.TMethod;
myFunc: TDataType.TMethod.TProc;
methodValue: TDataMethodValue;
inputValue: TDataOrdinalValue;
resultValue: IDataValue;
@@ -657,28 +660,28 @@ begin
// --- 3. Test Value Creation ---
// Define a function that matches the signature Ordinal -> Text
myFunc :=
function(const AValue: IDataValue): IDataValue
function(const AValue: TDataType.TValue): TDataType.TValue
var
ordinalValue: TDataOrdinalValue;
val: Int64;
begin
ordinalValue := TDataValue(AValue).AsOrdinal;
ordinalValue := AValue.AsOrdinal;
val := ordinalValue.Value;
Result := TDataValue.FromText(val.ToString);
Result := TDataType.FromText(val.ToString);
end;
methodValue := TDataValue.FromMethod(methodType1, myFunc);
methodValue := TDataType.FromMethod(methodType1, myFunc);
Assert.IsNotNull(IDataMethodValue(methodValue), 'MethodValue should be created');
Assert.AreSame(IDataType(methodType1), IDataMethodValue(methodValue).DataType, 'Value should have the correct data type');
// --- 4. Test Execution (Simulated) ---
inputValue := TDataValue.FromOrdinal(42);
inputValue := TDataType.FromOrdinal(42);
// Execute the function retrieved from the value
resultValue := methodValue.Value(inputValue);
Assert.IsNotNull(resultValue, 'Execution result should not be nil');
Assert.AreSame(IDataType(textType), resultValue.DataType, 'Result value should have Text type');
Assert.AreEqual('42', TDataValue(resultValue).AsText.Value, 'Result value content is incorrect');
Assert.AreEqual('42', TDataType.TValue(resultValue).AsText.Value, 'Result value content is incorrect');
// --- 5. Test AsString and AsTValue ---
Assert.AreEqual('<METHOD>', IDataMethodValue(methodValue).AsString, 'Method AsString is incorrect');
@@ -686,19 +689,19 @@ begin
tv := IDataMethodValue(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(TMethodProc) = tv.TypeInfo, 'TValue should hold TMethodProc type info');
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 type
Assert.WillRaise(
procedure begin TDataValue.FromMethod(nil, myFunc); end,
procedure begin TDataType.FromMethod(nil, myFunc); end,
EArgumentException,
'FromMethod with nil type should raise an exception'
);
// Test creating a value with a nil function
Assert.WillRaise(
procedure begin TDataValue.FromMethod(methodType1, nil); end,
procedure begin TDataType.FromMethod(methodType1, nil); end,
EArgumentException,
'FromMethod with nil function should raise an exception'
);