Indicator with new types
This commit is contained in:
Michael Schimmel
+91
-19
@@ -10,9 +10,6 @@ type
|
||||
[IgnoreMemoryLeaks]
|
||||
TMyTestObject = class
|
||||
public
|
||||
[TestFixtureTearDown]
|
||||
procedure FixtureTearDown;
|
||||
|
||||
[Test]
|
||||
procedure TestRecords;
|
||||
[Test]
|
||||
@@ -39,6 +36,8 @@ type
|
||||
procedure TestAsString;
|
||||
[Test]
|
||||
procedure TestAsTValue;
|
||||
[Test]
|
||||
procedure TestMethods;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@@ -50,15 +49,6 @@ uses
|
||||
System.TypInfo,
|
||||
Myc.Data.Types;
|
||||
|
||||
{ TMyTestObject }
|
||||
|
||||
procedure TMyTestObject.FixtureTearDown;
|
||||
begin
|
||||
// Clear global type caches to release any interfaces created during tests.
|
||||
// This prevents access violations on shutdown from dangling pointers in the registries.
|
||||
TDataType.ClearRegistries;
|
||||
end;
|
||||
|
||||
procedure TMyTestObject.TestRecords;
|
||||
var
|
||||
intType: IDataType;
|
||||
@@ -236,18 +226,18 @@ begin
|
||||
floatType := TDataType.Float;
|
||||
|
||||
// --- 2. Test Type Creation and Caching ---
|
||||
intArrayType1 := TDataType.ArrayOfType(intType);
|
||||
intArrayType1 := TDataType.ArrayOf(intType);
|
||||
|
||||
Assert.IsNotNull(intArrayType1, 'ArrayType should be created');
|
||||
Assert.AreSame(intType, intArrayType1.ElementType, 'ElementType should be Integer');
|
||||
Assert.AreEqual('Array<Integer>', intArrayType1.Name, 'Type name should be Array<Integer>');
|
||||
|
||||
// Test caching
|
||||
intArrayType2 := TDataType.ArrayOfType(intType);
|
||||
intArrayType2 := TDataType.ArrayOf(intType);
|
||||
Assert.AreSame(intArrayType1, intArrayType2, 'Array types should be cached');
|
||||
|
||||
// Test uniqueness
|
||||
floatArrayType := TDataType.ArrayOfType(floatType);
|
||||
floatArrayType := TDataType.ArrayOf(floatType);
|
||||
Assert.AreNotSame(intArrayType1, floatArrayType, 'Different element types should result in different array types');
|
||||
Assert.AreEqual('Array<Float>', floatArrayType.Name, 'Type name should be Array<Float>');
|
||||
|
||||
@@ -265,7 +255,7 @@ begin
|
||||
|
||||
// --- 4. Test Validation and Error Handling ---
|
||||
// Test creating an array with a nil element type
|
||||
Assert.WillRaise(procedure begin TDataType.ArrayOfType(nil); end, EArgumentException, 'Nil element type should raise an exception');
|
||||
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(
|
||||
@@ -284,7 +274,7 @@ var
|
||||
arrayType: IDataArrayType;
|
||||
empty1, empty2, single, generic: IDataArrayValue;
|
||||
begin
|
||||
arrayType := TDataType.ArrayOfType(TDataType.Ordinal);
|
||||
arrayType := TDataType.ArrayOf(TDataType.Ordinal);
|
||||
|
||||
// Test optimized path for 0 elements (cached singleton per type)
|
||||
empty1 := arrayType.CreateValue([]);
|
||||
@@ -515,7 +505,7 @@ begin
|
||||
Assert.AreEqual('Green', enumValue.AsString, 'Enum AsString incorrect');
|
||||
|
||||
// Array
|
||||
intArrayType := TDataType.ArrayOfType(TDataType.Ordinal);
|
||||
intArrayType := TDataType.ArrayOf(TDataType.Ordinal);
|
||||
arrayValue := intArrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2)]);
|
||||
Assert.AreEqual('[1, 2]', arrayValue.AsString, 'Array AsString incorrect');
|
||||
|
||||
@@ -576,7 +566,7 @@ begin
|
||||
Assert.AreEqual(1, tv.AsInteger, 'Enum TValue content is incorrect');
|
||||
|
||||
// --- Array ---
|
||||
intArrayType := TDataType.ArrayOfType(TDataType.Ordinal);
|
||||
intArrayType := TDataType.ArrayOf(TDataType.Ordinal);
|
||||
dataValue := intArrayType.CreateValue([TDataValue.FromOrdinal(10), TDataValue.FromOrdinal(20)]);
|
||||
tv := dataValue.AsTValue;
|
||||
Assert.IsFalse(tv.IsEmpty, 'Array TValue should not be empty');
|
||||
@@ -620,4 +610,86 @@ begin
|
||||
Assert.AreEqual('Red', tv.GetArrayElement(1).AsType<TValue>.AsString, 'Tuple TValue element 1 is incorrect');
|
||||
end;
|
||||
|
||||
procedure TMyTestObject.TestMethods;
|
||||
var
|
||||
ordinalType, textType: IDataType;
|
||||
methodType1, methodType2, otherMethodType: IDataMethodType;
|
||||
myFunc: TMethodProc;
|
||||
methodValue: IDataMethodValue;
|
||||
inputValue, resultValue: IDataValue;
|
||||
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(methodType1, 'MethodType should be created');
|
||||
Assert.AreEqual(dkMethod, methodType1.Kind, 'Kind should be dkMethod');
|
||||
Assert.AreSame(ordinalType, methodType1.ArgType, 'ArgType should be Ordinal');
|
||||
Assert.AreSame(textType, methodType1.ResultType, 'ResultType should be Text');
|
||||
Assert.AreEqual('Method<Integer -> Text>', 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(methodType1, 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(methodType1, otherMethodType, 'Different signatures should result in different types');
|
||||
Assert.AreEqual('Method<Text -> Integer>', 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: IDataValue): IDataValue
|
||||
var
|
||||
ordinalValue: IDataOrdinalValue;
|
||||
val: Int64;
|
||||
begin
|
||||
ordinalValue := TDataValue(AValue).AsOrdinal;
|
||||
val := ordinalValue.Value;
|
||||
Result := TDataValue.FromText(val.ToString);
|
||||
end;
|
||||
|
||||
methodValue := TDataValue.FromMethod(methodType1, myFunc);
|
||||
Assert.IsNotNull(methodValue, 'MethodValue should be created');
|
||||
Assert.AreSame(methodType1, methodValue.DataType, 'Value should have the correct data type');
|
||||
|
||||
// --- 4. Test Execution (Simulated) ---
|
||||
inputValue := TDataValue.FromOrdinal(42);
|
||||
// Execute the function retrieved from the value
|
||||
resultValue := methodValue.Value(inputValue);
|
||||
|
||||
Assert.IsNotNull(resultValue, 'Execution result should not be nil');
|
||||
Assert.AreSame(textType, resultValue.DataType, 'Result value should have Text type');
|
||||
Assert.AreEqual('42', TDataValue(resultValue).AsText.Value, 'Result value content is incorrect');
|
||||
|
||||
// --- 5. Test AsString and AsTValue ---
|
||||
Assert.AreEqual('<METHOD>', methodValue.AsString, 'Method AsString is incorrect');
|
||||
|
||||
tv := 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');
|
||||
|
||||
// --- 6. Test Validation and Error Handling ---
|
||||
// Test creating a value with a nil type
|
||||
Assert.WillRaise(
|
||||
procedure begin TDataValue.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,
|
||||
EArgumentException,
|
||||
'FromMethod with nil function should raise an exception'
|
||||
);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user