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

Refactoring DataFlow, 1st Generic Data records working

Browse Source
This commit is contained in:
Michael Schimmel
2025-07-22 01:13:01 +02:00
parent dd50049b06
commit bf4ef71cba
11 changed files with 1074 additions and 907 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Test/TestDataRecord.pas
+103 -429
View File
@@ -3,472 +3,146 @@ unit TestDataRecord;
interface
uses
DunitX.TestFramework,
System.SysUtils,
System.Classes,
System.Variants,
DUnitX.TestFramework,
System.DateUtils,
Myc.DataRecord;
type
// Helper types for various TypeKind tests
TTestEnum = (teOne, teTwo, teThree);
TTestSet = set of TTestEnum;
TTestRecord = record
I: Integer;
S: string;
end;
TTestMRecord = record
private
FData: TArray<Byte>;
class operator Initialize(out Dest: TTestMRecord);
class operator Finalize(var Dest: TTestMRecord);
end;
ITestInterface = interface
['{B1E5119C-A2B4-43C1-99C1-39B6A687363E}']
function GetValue: Integer;
end;
TTestClass = class(TInterfacedObject, ITestInterface)
private
FValue: Integer;
public
constructor Create(AValue: Integer);
function GetValue: Integer;
// A record that contains all supported data types for testing
TMyTestRecord = record
MyInteger: Integer;
MyInt64: Int64;
MySingle: Single;
MyDouble: Double;
MyString: string;
MyTimestamp: TDateTime;
end;
[TestFixture]
TDataRecordTests = class
private
function CreateRecord<T>(const FieldName: string; const Value: T): TDataRecord;
TTestDataRecord = class(TObject)
public
// Test procedures are unchanged
[Test]
[TestCase('TestZero', '0')]
[TestCase('TestPositive', '123')]
[TestCase('TestNegative', '-456')]
procedure Test_tkInteger_Succeeds(const AValue: Integer);
procedure TestLayoutCreation;
[Test]
[TestCase('TestZero', '0')]
[TestCase('TestPositive', '1234567890123')]
[TestCase('TestNegative', '-9876543210987')]
procedure Test_tkInt64_Succeeds(const AValue: Int64);
procedure TestCreateFromInstanceAndGetValue;
[Test]
procedure Test_tkFloat_Single_Succeeds;
[Test]
procedure Test_tkFloat_Double_Succeeds;
[Test]
[TestCase('Test_A', 'A')]
procedure Test_tkChar_Succeeds(const AValue: Char);
[Test]
[TestCase('TestEmpty', '')]
[TestCase('TestSimple', 'Hello World')]
procedure Test_tkString_NonGeneric_Succeeds(const AValue: string);
[Test]
[TestCase('TestLeak', 'This test will leak memory')]
procedure Test_tkString_Generic_LeaksMemory(const AValue: string);
[Test]
procedure Test_tkEnumeration_Succeeds;
[Test]
procedure Test_tkSet_Succeeds;
[Test]
procedure Test_tkRecord_Succeeds;
[Test]
procedure Test_tkMRecord_Succeeds;
[Test]
procedure Test_tkDynArray_Succeeds;
[Test]
procedure Test_tkInterface_Succeeds;
[Test]
procedure Test_tkClass_Succeeds_With_Manual_Cleanup;
[Test]
procedure Test_tkVariant_Succeeds;
[Test]
procedure Test_Assign_CreatesIndependentCopy;
[Test]
procedure Test_Reassign_ReleasesOldData;
// New tests for RTTI-based creation and assignment
[Test]
[IgnoreMemoryLeaks]
procedure Test_CreateFrom_AssignTo_Succeeds;
[Test]
[IgnoreMemoryLeaks]
procedure Test_Assign_FromCreateFrom_IsIndependentCopy;
procedure TestSetValueAndGetValue;
end;
implementation
uses
System.TypInfo,
System.Rtti;
{ TDataRecordTests }
{ TTestDataRecord }
function TDataRecordTests.CreateRecord<T>(const FieldName: string; const Value: T): TDataRecord;
procedure TTestDataRecord.TestLayoutCreation;
var
// Use the TBuilder helper record. Its lifetime is managed automatically.
builder: TDataRecord.TBuilder;
layout: TDataRecord.TRecordLayout;
idx: Integer;
expectedSize: Integer;
begin
builder := TDataRecord.CreateBuilder;
builder.AddField<T>(FieldName, Value);
Result := builder.CreateRec;
// Test: Create layout from a record type
layout := TDataRecord.TRecordLayout.CreateFrom<TMyTestRecord>;
// Assert: Check field count
Assert.IsTrue(Length(layout.Fields) = 6, 'Layout should have 6 fields');
// Assert: Check specific fields for correct type mapping
idx := layout.IndexOf('MyInteger');
Assert.IsTrue(idx > -1, 'Field MyInteger not found');
Assert.AreEqual(TDataFieldType.dfInteger, layout.Fields[idx].FieldType, 'MyInteger should be mapped to dfInteger');
idx := layout.IndexOf('MyString');
Assert.IsTrue(idx > -1, 'Field MyString not found');
Assert.AreEqual(TDataFieldType.dfString, layout.Fields[idx].FieldType, 'MyString should be mapped to dfString');
idx := layout.IndexOf('MySingle');
Assert.IsTrue(idx > -1, 'Field MySingle not found');
Assert.AreEqual(TDataFieldType.dfFloat, layout.Fields[idx].FieldType, 'MySingle should be mapped to dfFloat');
idx := layout.IndexOf('MyTimestamp');
Assert.IsTrue(idx > -1, 'Field MyTimestamp not found');
Assert.AreEqual(TDataFieldType.dfTimestamp, layout.Fields[idx].FieldType, 'MyTimestamp should be mapped to dfTimestamp');
// Assert: Check total buffer size (6 fields * 8 bytes each on x64 due to type promotion and alignment)
expectedSize := (sizeof(Int64) * 2) + (sizeof(Double) * 2) + sizeof(String) + sizeof(TDateTime);
Assert.AreEqual(expectedSize, layout.GetBufferSize, 'Buffer size calculation is incorrect');
end;
procedure TDataRecordTests.Test_tkInteger_Succeeds(const AValue: Integer);
procedure TTestDataRecord.TestCreateFromInstanceAndGetValue;
var
rec: TDataRecord;
field: TDataRecord.IField<Integer>;
srcRecord: TMyTestRecord;
dataRecord: TDataRecord;
begin
rec := CreateRecord<Integer>('Value', AValue);
field := rec.GetField<Integer>('Value');
Assert.IsNotNull(field, 'Field should not be null');
Assert.AreEqual(AValue, field.Value, 'Value should be equal');
// Setup: Create and populate a source record
srcRecord.MyInteger := 12345;
srcRecord.MyInt64 := 9876543210;
srcRecord.MySingle := 123.456;
srcRecord.MyDouble := 789.012345;
srcRecord.MyString := 'Hello Delphi!';
srcRecord.MyTimestamp := EncodeDateTime(2024, 7, 19, 10, 30, 0, 0);
// Test: Create a TDataRecord from the source record instance
dataRecord := TDataRecord.CreateFrom<TMyTestRecord>(srcRecord);
// Assert: Retrieve each value and check for correctness
Assert.AreEqual(srcRecord.MyInt64, dataRecord.GetValue<Int64>('MyInt64'), 'Int64 value mismatch');
Assert.AreEqual(srcRecord.MyInteger, dataRecord.GetValue<Integer>('MyInteger'), 'Integer value mismatch');
Assert.AreEqual(srcRecord.MyString, dataRecord.GetValue<string>('MyString'), 'String value mismatch');
Assert.AreEqual(srcRecord.MyTimestamp, dataRecord.GetValue<TDateTime>('MyTimestamp'), 'TDateTime value mismatch');
// Assert: Check float values with a tolerance for precision differences
Assert.AreEqual(srcRecord.MySingle, dataRecord.GetValue<Single>('MySingle'), 1e-6, 'Single value mismatch');
Assert.AreEqual(srcRecord.MyDouble, dataRecord.GetValue<Double>('MyDouble'), 1e-9, 'Double value mismatch');
// Assert: Test type promotion (reading an Integer as Int64)
Assert.IsTrue(srcRecord.MyInteger = dataRecord.GetValue<Int64>('MyInteger'), 'Integer to Int64 promotion failed');
end;
procedure TDataRecordTests.Test_tkInt64_Succeeds(const AValue: Int64);
procedure TTestDataRecord.TestSetValueAndGetValue;
var
rec: TDataRecord;
field: TDataRecord.IField<Int64>;
dataRecord: TDataRecord;
testInt: Integer;
testInt64: Int64;
testSingle: Single;
testDouble: Double;
testString: string;
testTimestamp: TDateTime;
begin
rec := CreateRecord<Int64>('Value', AValue);
field := rec.GetField<Int64>('Value');
Assert.IsNotNull(field, 'Field should not be null');
Assert.AreEqual(AValue, field.Value, 'Value should be equal');
end;
// Setup: Create an empty TDataRecord with the layout of TMyTestRecord
dataRecord := TDataRecord.CreateFrom<TMyTestRecord>;
procedure TDataRecordTests.Test_tkFloat_Single_Succeeds;
const
TEST_VAL: Single = 3.14;
var
rec: TDataRecord;
field: TDataRecord.IField<Single>;
begin
rec := CreateRecord<Single>('Value', TEST_VAL);
field := rec.GetField<Single>('Value');
Assert.IsNotNull(field, 'Field should not be null');
Assert.AreEqual(TEST_VAL, field.Value, 'Value should be equal');
end;
// Setup: Define test values
testInt := 54321;
testInt64 := 12345678901;
testSingle := 987.654;
testDouble := 543.210987;
testString := 'Testing SetValue';
testTimestamp := Now;
procedure TDataRecordTests.Test_tkFloat_Double_Succeeds;
const
TEST_VAL: Double = 123.456;
var
rec: TDataRecord;
field: TDataRecord.IField<Double>;
begin
rec := CreateRecord<Double>('Value', TEST_VAL);
field := rec.GetField<Double>('Value');
Assert.IsNotNull(field, 'Field should not be null');
Assert.AreEqual(TEST_VAL, field.Value, 'Value should be equal');
end;
// Test: Set values for each field by name
dataRecord.SetValue<Integer>('MyInteger', testInt);
dataRecord.SetValue<Int64>('MyInt64', testInt64);
dataRecord.SetValue<Single>('MySingle', testSingle);
dataRecord.SetValue<Double>('MyDouble', testDouble);
dataRecord.SetValue<string>('MyString', testString);
dataRecord.SetValue<TDateTime>('MyTimestamp', testTimestamp);
procedure TDataRecordTests.Test_tkChar_Succeeds(const AValue: Char);
var
rec: TDataRecord;
field: TDataRecord.IField<Char>;
begin
rec := CreateRecord<Char>('Value', AValue);
field := rec.GetField<Char>('Value');
Assert.IsNotNull(field, 'Field should not be null');
Assert.AreEqual(AValue, field.Value, 'Value should be equal');
end;
// Assert: Retrieve the values and check if they match what was set
Assert.AreEqual(testInt, dataRecord.GetValue<Integer>('MyInteger'), 'SetValue failed for Integer');
Assert.AreEqual(testInt64, dataRecord.GetValue<Int64>('MyInt64'), 'SetValue failed for Int64');
Assert.AreEqual(testString, dataRecord.GetValue<string>('MyString'), 'SetValue failed for String');
Assert.AreEqual(testTimestamp, dataRecord.GetValue<TDateTime>('MyTimestamp'), 'SetValue failed for TDateTime');
procedure TDataRecordTests.Test_tkString_NonGeneric_Succeeds(const AValue: string);
var
rec: TDataRecord;
field: TDataRecord.IField;
typedField: TDataRecord.IField<string>;
begin
rec := CreateRecord<string>('Value', AValue);
field := rec.GetField('Value');
Assert.IsNotNull(field, 'Field should not be null');
typedField := rec.GetField<string>('Value');
Assert.AreEqual(AValue, typedField.Value, 'Value should be equal');
typedField.Value := 'New Value';
Assert.AreEqual('New Value', typedField.Value, 'Value should be updated');
end;
procedure TDataRecordTests.Test_tkString_Generic_LeaksMemory(const AValue: string);
var
rec: TDataRecord;
field: TDataRecord.IField<string>;
begin
rec := CreateRecord<string>('Value', AValue);
field := rec.GetField<string>('Value');
Assert.IsNotNull(field, 'Field should not be null');
Assert.AreEqual(AValue, field.Value, 'Initial value should be correct');
field.Value := 'A new string that will be leaked';
end;
procedure TDataRecordTests.Test_tkEnumeration_Succeeds;
var
rec: TDataRecord;
field: TDataRecord.IField<TTestEnum>;
begin
rec := CreateRecord<TTestEnum>('Value', teTwo);
field := rec.GetField<TTestEnum>('Value');
Assert.IsNotNull(field, 'Field should not be null');
Assert.AreEqual(teTwo, field.Value, 'Value should be teTwo');
end;
procedure TDataRecordTests.Test_tkSet_Succeeds;
var
rec: TDataRecord;
field: TDataRecord.IField<TTestSet>;
testSet: TTestSet;
begin
testSet := [teOne, teThree];
rec := CreateRecord<TTestSet>('Value', testSet);
field := rec.GetField<TTestSet>('Value');
Assert.IsNotNull(field, 'Field should not be null');
Assert.IsTrue(testSet = field.Value, 'Value should be [teOne, teThree]');
end;
procedure TDataRecordTests.Test_tkRecord_Succeeds;
var
rec: TDataRecord;
field: TDataRecord.IField<TTestRecord>;
testRec, resultRec: TTestRecord;
begin
testRec.I := 42;
testRec.S := 'Hello Record';
rec := CreateRecord<TTestRecord>('Value', testRec);
field := rec.GetField<TTestRecord>('Value');
Assert.IsNotNull(field, 'Field should not be null');
resultRec := field.Value;
Assert.AreEqual(testRec.I, resultRec.I, 'Record.I should match');
Assert.AreEqual(testRec.S, resultRec.S, 'Record.S should match');
end;
procedure TDataRecordTests.Test_tkMRecord_Succeeds;
var
rec: TDataRecord;
field: TDataRecord.IField<TTestMRecord>;
testMRec, resultMRec: TTestMRecord;
begin
SetLength(testMRec.FData, 10);
testMRec.FData[0] := 1;
rec := CreateRecord<TTestMRecord>('Value', testMRec);
field := rec.GetField<TTestMRecord>('Value');
Assert.IsNotNull(field, 'Field should not be null');
resultMRec := field.Value;
Assert.AreEqual(Length(testMRec.FData), Length(resultMRec.FData), 'MRecord.FData length should match');
Assert.AreEqual(testMRec.FData[0], resultMRec.FData[0], 'MRecord.FData content should match');
end;
procedure TDataRecordTests.Test_tkDynArray_Succeeds;
var
rec: TDataRecord;
field: TDataRecord.IField<TArray<Integer>>;
testArr, resultArr: TArray<Integer>;
begin
testArr := [10, 20, 30];
rec := CreateRecord<TArray<Integer>>('Value', testArr);
field := rec.GetField<TArray<Integer>>('Value');
Assert.IsNotNull(field, 'Field should not be null');
resultArr := field.Value;
Assert.AreEqual(Length(testArr), Length(resultArr), 'DynArray length should match');
Assert.AreEqual(testArr[1], resultArr[1], 'DynArray content should match');
end;
procedure TDataRecordTests.Test_tkInterface_Succeeds;
var
rec: TDataRecord;
field: TDataRecord.IField<ITestInterface>;
testIntf, resultIntf: ITestInterface;
begin
testIntf := TTestClass.Create(1337);
rec := CreateRecord<ITestInterface>('Value', testIntf);
field := rec.GetField<ITestInterface>('Value');
Assert.IsNotNull(field, 'Field should not be null');
resultIntf := field.Value;
Assert.IsNotNull(resultIntf, 'Result interface should not be null');
Assert.AreEqual(1337, resultIntf.GetValue, 'Interface method should return correct value');
end;
procedure TDataRecordTests.Test_tkClass_Succeeds_With_Manual_Cleanup;
var
rec: TDataRecord;
field: TDataRecord.IField<TTestClass>;
testObj, resultObj: TTestClass;
begin
testObj := TTestClass.Create(99);
try
rec := CreateRecord<TTestClass>('Value', testObj);
field := rec.GetField<TTestClass>('Value');
Assert.IsNotNull(field, 'Field should not be null');
resultObj := field.Value;
Assert.AreSame(testObj, resultObj, 'Should be the same object instance');
Assert.AreEqual(99, resultObj.GetValue, 'Object method should return correct value');
finally
testObj.Free;
end;
end;
procedure TDataRecordTests.Test_tkVariant_Succeeds;
var
rec: TDataRecord;
field: TDataRecord.IField<Variant>;
testVar: Variant;
begin
testVar := 'Hello Variant';
rec := CreateRecord<Variant>('Value', testVar);
field := rec.GetField<Variant>('Value');
Assert.IsNotNull(field, 'Field should not be null');
Assert.AreEqual(testVar, field.Value, 'Variant value should match');
end;
procedure TDataRecordTests.Test_Assign_CreatesIndependentCopy;
var
rec1, rec2: TDataRecord;
field1, field2: TDataRecord.IField<string>;
begin
// Create original record
rec1 := CreateRecord<string>('Value', 'Original');
// Assign to a new record, invoking operator Assign. This covers 'CreateFromRec'.
rec2 := rec1;
// Verify the copy
Assert.IsTrue(Length(rec2.Layout) = 1, 'Copied record should have one field');
Assert.AreEqual('Value', rec2.Layout[0].Name, 'Field name should be copied');
field2 := rec2.GetField<string>('Value');
Assert.IsNotNull(field2, 'Field should exist in copied record');
Assert.AreEqual('Original', field2.Value, 'Field value should be copied');
// Modify the copy and check for independence (deep copy)
field2.Value := 'Modified';
field1 := rec1.GetField<string>('Value');
Assert.AreEqual('Original', field1.Value, 'Original record should not be modified');
Assert.AreEqual('Modified', field2.Value, 'Copied record should reflect modification');
end;
procedure TDataRecordTests.Test_Reassign_ReleasesOldData;
var
rec1, rec2: TDataRecord;
field: TDataRecord.IField<string>;
begin
// Create two independent records with managed string fields.
// DUnitX will report a leak if the memory for rec1 is not freed upon reassignment.
rec1 := CreateRecord<string>('OldValue', 'This should be released');
rec2 := CreateRecord<string>('NewValue', 'This should remain');
// Re-assign rec1. This should Finalize the old rec1 and Assign the new data.
rec1 := rec2;
// Verify the state of the reassigned rec1
Assert.AreEqual(-1, rec1.IndexOf('OldValue'), 'Old field should not exist anymore');
Assert.AreNotEqual(-1, rec1.IndexOf('NewValue'), 'New field should exist');
field := rec1.GetField<string>('NewValue');
Assert.AreEqual('This should remain', field.Value, 'Value should be from the new record');
// Also check that rec2 is unaffected by the assignment
field := rec2.GetField<string>('NewValue');
Assert.AreEqual('This should remain', field.Value, 'Source record for assignment should be unchanged');
end;
procedure TDataRecordTests.Test_CreateFrom_AssignTo_Succeeds;
var
srcRec, dstRec: TTestRecord;
dataRec: TDataRecord;
fieldI: TDataRecord.IField<Integer>;
fieldS: TDataRecord.IField<string>;
begin
// Setup a standard record with data
srcRec.I := 123;
srcRec.S := 'Hello from RTTI';
// Create a TDataRecord from the standard record via RTTI
dataRec := TDataRecord.CreateFrom<TTestRecord>(srcRec);
// Verify that the data was correctly transferred into the TDataRecord
Assert.IsTrue(Length(dataRec.Layout) = 2, 'Layout should have 2 fields');
fieldI := dataRec.GetField<Integer>('I');
Assert.IsNotNull(fieldI, 'Integer field should exist');
Assert.AreEqual(srcRec.I, fieldI.Value, 'Integer value should match');
fieldS := dataRec.GetField<string>('S');
Assert.IsNotNull(fieldS, 'String field should exist');
Assert.AreEqual(srcRec.S, fieldS.Value, 'String value should match');
// Assign the data back from the TDataRecord to another standard record
dataRec.AssignTo<TTestRecord>(dstRec);
// Verify that the data was correctly restored
Assert.AreEqual(srcRec.I, dstRec.I, 'Assigned back record integer should match');
Assert.AreEqual(srcRec.S, dstRec.S, 'Assigned back record string should match');
end;
procedure TDataRecordTests.Test_Assign_FromCreateFrom_IsIndependentCopy;
var
srcRec: TTestRecord;
rec1, rec2: TDataRecord;
field1, field2: TDataRecord.IField<string>;
begin
// Setup a record and create a TDataRecord from it
srcRec.I := 456;
srcRec.S := 'Original RTTI value';
rec1 := TDataRecord.CreateFrom<TTestRecord>(srcRec);
// Assign the TDataRecord to another, invoking operator Assign
rec2 := rec1;
// Modify the string field in the copy
field2 := rec2.GetField<string>('S');
Assert.IsNotNull(field2, 'Field must exist in copy');
field2.Value := 'Modified in copy';
// Verify that the original TDataRecord is unchanged
field1 := rec1.GetField<string>('S');
Assert.IsNotNull(field1, 'Field must exist in original');
Assert.AreEqual('Original RTTI value', field1.Value, 'Original record should not be modified');
Assert.AreEqual('Modified in copy', field2.Value, 'Copied record should reflect modification');
end;
{ TTestClass }
constructor TTestClass.Create(AValue: Integer);
begin
inherited Create;
FValue := AValue;
end;
function TTestClass.GetValue: Integer;
begin
Result := FValue;
end;
{ TTestMRecord }
class operator TTestMRecord.Finalize(var Dest: TTestMRecord);
begin
Dest.FData := nil;
end;
class operator TTestMRecord.Initialize(out Dest: TTestMRecord);
begin
Dest.FData := nil;
Assert.AreEqual(testSingle, dataRecord.GetValue<Single>('MySingle'), 1e-6, 'SetValue failed for Single');
Assert.AreEqual(testDouble, dataRecord.GetValue<Double>('MyDouble'), 1e-9, 'SetValue failed for Double');
end;
initialization
TDUnitX.RegisterTestFixture(TDataRecordTests);
TDUnitX.RegisterTestFixture(TTestDataRecord);
end.