Data Types
This commit is contained in:
Michael Schimmel
+7
-1
@@ -25,7 +25,13 @@ uses
|
||||
Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas',
|
||||
Test.Core.Mutable in 'Test.Core.Mutable.pas',
|
||||
TestDataRecord in 'TestDataRecord.pas',
|
||||
TestDataArray in 'TestDataArray.pas';
|
||||
TestDataArray in 'TestDataArray.pas',
|
||||
Myc.Data.Types in '..\Src\Myc.Data.Types.pas',
|
||||
Myc.Data.Types.Ordinal in 'Myc.Data.Types.Ordinal.pas',
|
||||
Myc.Data.Types.Records in 'Myc.Data.Types.Records.pas',
|
||||
TestDataTypes in 'TestDataTypes.pas',
|
||||
Myc.Data.Types.Float in 'Myc.Data.Types.Float.pas',
|
||||
Myc.Data.Types.Arrays in 'Myc.Data.Types.Arrays.pas';
|
||||
|
||||
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
|
||||
{$IFNDEF TESTINSIGHT}
|
||||
|
||||
+7
-1
@@ -58,7 +58,7 @@
|
||||
<UsingDelphiRTL>true</UsingDelphiRTL>
|
||||
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
|
||||
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
|
||||
<DCC_UnitSearchPath>$(DUnitX);T:\Myc\Src;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
|
||||
<DCC_UnitSearchPath>$(DUnitX);T:\Myc\Src;T:\Myc\Src\Data;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
|
||||
<SanitizedProjectName>MycTests</SanitizedProjectName>
|
||||
<VerInfo_Locale>1031</VerInfo_Locale>
|
||||
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||
@@ -127,6 +127,12 @@ $(PreBuildEvent)]]></PreBuildEvent>
|
||||
<DCCReference Include="Test.Core.Mutable.pas"/>
|
||||
<DCCReference Include="TestDataRecord.pas"/>
|
||||
<DCCReference Include="TestDataArray.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Data.Types.pas"/>
|
||||
<DCCReference Include="Myc.Data.Types.Ordinal.pas"/>
|
||||
<DCCReference Include="Myc.Data.Types.Records.pas"/>
|
||||
<DCCReference Include="TestDataTypes.pas"/>
|
||||
<DCCReference Include="Myc.Data.Types.Float.pas"/>
|
||||
<DCCReference Include="Myc.Data.Types.Arrays.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
|
||||
@@ -0,0 +1,231 @@
|
||||
unit TestDataTypes;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
DUnitX.TestFramework;
|
||||
|
||||
type
|
||||
[TestFixture]
|
||||
TMyTestObject = class
|
||||
public
|
||||
[Test]
|
||||
procedure TestCreateRecords;
|
||||
|
||||
[Test]
|
||||
procedure TestTuples;
|
||||
|
||||
[Test]
|
||||
procedure TestArrays;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
Myc.Data.Types,
|
||||
Myc.Data.Types.Ordinal,
|
||||
Myc.Data.Types.Float,
|
||||
Myc.Data.Types.Tuple,
|
||||
Myc.Data.Types.Arrays,
|
||||
Myc.Data.Types.Records;
|
||||
|
||||
{ TMyTestObject }
|
||||
|
||||
procedure TMyTestObject.TestCreateRecords;
|
||||
var
|
||||
intType: TDataType;
|
||||
floatType: TDataType;
|
||||
fieldDef: TArray<TRecordField>;
|
||||
personType1, personType2, otherType: TRecordType;
|
||||
personValue: TDataValue;
|
||||
idValue: IDataOrdinalValue;
|
||||
floatValue: IDataFloatValue;
|
||||
begin
|
||||
// --- 1. Setup: Define base types and a record structure ---
|
||||
intType := TOrdinalType.CreateValue(0).DataType;
|
||||
floatType := TFloatType.CreateValue(0.0).DataType;
|
||||
|
||||
SetLength(fieldDef, 2);
|
||||
fieldDef[0] := TRecordField.Create('ID', intType);
|
||||
fieldDef[1] := TRecordField.Create('Value', floatType);
|
||||
|
||||
// --- 2. Test Type Creation and Caching ---
|
||||
personType1 := TRecordTypes.GetType(fieldDef);
|
||||
|
||||
// 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(intType.DataType, 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(floatType.DataType, 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>', personType1.Name, 'Type name should match expected format');
|
||||
|
||||
// Test if the same definition returns the same cached instance
|
||||
personType2 := TRecordTypes.GetType(fieldDef);
|
||||
Assert.AreSame(personType1, personType2, 'Types should be cached and return the same instance');
|
||||
|
||||
// Test if a different definition returns a new instance
|
||||
fieldDef[1] := TRecordField.Create('Data', floatType); // Change field name
|
||||
otherType := TRecordTypes.GetType(fieldDef);
|
||||
Assert.AreNotSame(personType1, otherType, 'Different definitions should result in different types');
|
||||
fieldDef[1] := TRecordField.Create('Value', floatType); // Reset for next test
|
||||
|
||||
// --- 3. Test Value Creation and Access ---
|
||||
personType1 := TRecordTypes.GetType(fieldDef); // Get the original type again
|
||||
personValue := personType1.CreateValue([TOrdinalType.CreateValue(123), TFloatType.CreateValue(45.67)]);
|
||||
|
||||
Assert.IsNotNull(IDataRecordValue(personValue.AsRecord), 'RecordValue should be created');
|
||||
Assert.IsTrue(personType1 = personValue.AsRecord.DataType, 'Value should have the correct data type');
|
||||
|
||||
// Access by index
|
||||
idValue := personValue.AsRecord.Items[0].DataValue as IDataOrdinalValue;
|
||||
Assert.AreEqual(Int64(123), idValue.Value, 'Value at index 0 is incorrect');
|
||||
floatValue := personValue.AsRecord.Items[1].DataValue as IDataFloatValue;
|
||||
Assert.AreEqual(45.67, floatValue.Value, 'Value at index 1 is incorrect');
|
||||
|
||||
// Access by name
|
||||
floatValue := personValue.AsRecord.Items[personType1.IndexOf('Value')].DataValue as IDataFloatValue;
|
||||
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
|
||||
var
|
||||
duplicateDef: TArray<TRecordField>;
|
||||
begin
|
||||
SetLength(duplicateDef, 2);
|
||||
duplicateDef[0] := TRecordField.Create('ID', intType);
|
||||
duplicateDef[1] := TRecordField.Create('ID', floatType); // Duplicate name
|
||||
TRecordTypes.GetType(duplicateDef);
|
||||
end,
|
||||
EArgumentException,
|
||||
'Duplicate field names should raise an exception'
|
||||
);
|
||||
|
||||
// Test for wrong number of items during value creation
|
||||
Assert.WillRaise(
|
||||
procedure begin personType1.CreateValue([TOrdinalType.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([TFloatType.CreateValue(1.0), TFloatType.CreateValue(2.0)]);
|
||||
end,
|
||||
EArgumentException,
|
||||
'Wrong item type should raise exception'
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TMyTestObject.TestTuples;
|
||||
var
|
||||
intValue: IDataValue;
|
||||
floatValue: IDataValue;
|
||||
tuple1, tuple2, tuple3: IDataTupleValue;
|
||||
tuple1Helper: TTupleValue;
|
||||
type1, type2, type3: IDataType;
|
||||
begin
|
||||
// --- 1. Setup: Create some values ---
|
||||
intValue := TOrdinalType.CreateValue(123);
|
||||
floatValue := TFloatType.CreateValue(45.67);
|
||||
|
||||
// --- 2. Test Value Creation and basic properties ---
|
||||
tuple1 := TTuple.Create([intValue, floatValue]);
|
||||
tuple1Helper := TTupleValue.Create(tuple1); // Use helper for convenience
|
||||
|
||||
Assert.IsNotNull(tuple1, 'Tuple value should be created');
|
||||
Assert.AreEqual(2, tuple1Helper.ItemCount, 'ItemCount should be on the value');
|
||||
Assert.AreSame(intValue, tuple1Helper.Items[0].DataValue, 'Item at index 0 is incorrect');
|
||||
Assert.AreSame(floatValue, tuple1Helper.Items[1].DataValue, 'Item at index 1 is incorrect');
|
||||
|
||||
// --- 3. Test Singleton Type Behavior ---
|
||||
// Create more tuples with different structures
|
||||
tuple2 := TTuple.Create([TOrdinalType.CreateValue(99), TFloatType.CreateValue(1.1)]);
|
||||
tuple3 := TTuple.Create([intValue]);
|
||||
|
||||
// Access the DataType via the underlying interface, as the helper is "blind".
|
||||
type1 := IDataValue(tuple1).DataType;
|
||||
type2 := IDataValue(tuple2).DataType;
|
||||
type3 := IDataValue(tuple3).DataType;
|
||||
|
||||
Assert.IsNotNull(type1, 'DataType interface should be accessible');
|
||||
Assert.AreEqual('Tuple', type1.Name, 'The type name for all tuples should be Tuple');
|
||||
|
||||
// The core test: All tuples, regardless of their content, must share the exact same singleton type object.
|
||||
Assert.AreSame(type1, type2, 'All tuple types should be the same singleton instance');
|
||||
Assert.AreSame(type1, type3, 'All tuple types should be the same singleton instance');
|
||||
end;
|
||||
|
||||
procedure TMyTestObject.TestArrays;
|
||||
var
|
||||
intType: TDataType;
|
||||
floatType: TDataType;
|
||||
intArrayType1, intArrayType2, floatArrayType: TArrayType;
|
||||
arrayValue: TArrayValue;
|
||||
v1, v2: IDataValue;
|
||||
begin
|
||||
// --- 1. Setup ---
|
||||
intType := TOrdinalType.CreateValue(0).DataType;
|
||||
floatType := TFloatType.CreateValue(0.0).DataType;
|
||||
|
||||
// --- 2. Test Type Creation and Caching ---
|
||||
intArrayType1 := TArrayTypes.GetType(intType);
|
||||
|
||||
Assert.IsNotNull(IDataArrayType(intArrayType1), 'ArrayType should be created');
|
||||
Assert.AreSame(intType.DataType, intArrayType1.ElementType.DataType, 'ElementType should be Integer');
|
||||
Assert.AreEqual('Array<Integer>', intArrayType1.Name, 'Type name should be Array<Integer>');
|
||||
|
||||
// Test caching
|
||||
intArrayType2 := TArrayTypes.GetType(intType);
|
||||
Assert.AreSame(intArrayType1, intArrayType2, 'Array types should be cached');
|
||||
|
||||
// Test uniqueness
|
||||
floatArrayType := TArrayTypes.GetType(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>');
|
||||
|
||||
// --- 3. Test Value Creation and Access ---
|
||||
v1 := TOrdinalType.CreateValue(10);
|
||||
v2 := TOrdinalType.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
|
||||
Assert.AreEqual(Int64(10), (arrayValue.Items[0].DataValue as IDataOrdinalValue).Value, 'Item at index 0 is incorrect');
|
||||
Assert.AreEqual(Int64(20), (arrayValue.Items[1].DataValue as IDataOrdinalValue).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 TArrayTypes.GetType(TDataType.Create(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, TFloatType.CreateValue(3.14)]);
|
||||
end,
|
||||
EArgumentException,
|
||||
'Wrong element type should raise an exception'
|
||||
);
|
||||
end;
|
||||
|
||||
initialization
|
||||
TDUnitX.RegisterTestFixture(TMyTestObject);
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user