unit TestDataRecord; interface uses System.SysUtils, System.Classes, System.Variants, DUnitX.TestFramework, 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; 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; end; [TestFixture] TDataRecordTests = class private function CreateRecord(const FieldName: string; const Value: T): TDataRecord; public // Test procedures are unchanged [Test] [TestCase('TestZero', '0')] [TestCase('TestPositive', '123')] [TestCase('TestNegative', '-456')] procedure Test_tkInteger_Succeeds(const AValue: Integer); [Test] [TestCase('TestZero', '0')] [TestCase('TestPositive', '1234567890123')] [TestCase('TestNegative', '-9876543210987')] procedure Test_tkInt64_Succeeds(const AValue: Int64); [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; end; implementation uses System.TypInfo, System.Rtti; { TDataRecordTests } function TDataRecordTests.CreateRecord(const FieldName: string; const Value: T): TDataRecord; var // Use the TBuilder helper record. Its lifetime is managed automatically. builder: TDataRecord.TBuilder; begin builder := TDataRecord.CreateBuilder; builder.AddField(FieldName, Value); Result := builder.CreateRec; end; procedure TDataRecordTests.Test_tkInteger_Succeeds(const AValue: Integer); var rec: TDataRecord; field: TDataRecord.IField; begin rec := CreateRecord('Value', AValue); field := rec.GetField('Value'); Assert.IsNotNull(field, 'Field should not be null'); Assert.AreEqual(AValue, field.Value, 'Value should be equal'); end; procedure TDataRecordTests.Test_tkInt64_Succeeds(const AValue: Int64); var rec: TDataRecord; field: TDataRecord.IField; begin rec := CreateRecord('Value', AValue); field := rec.GetField('Value'); Assert.IsNotNull(field, 'Field should not be null'); Assert.AreEqual(AValue, field.Value, 'Value should be equal'); end; procedure TDataRecordTests.Test_tkFloat_Single_Succeeds; const TEST_VAL: Single = 3.14; var rec: TDataRecord; field: TDataRecord.IField; begin rec := CreateRecord('Value', TEST_VAL); field := rec.GetField('Value'); Assert.IsNotNull(field, 'Field should not be null'); Assert.AreEqual(TEST_VAL, field.Value, 'Value should be equal'); end; procedure TDataRecordTests.Test_tkFloat_Double_Succeeds; const TEST_VAL: Double = 123.456; var rec: TDataRecord; field: TDataRecord.IField; begin rec := CreateRecord('Value', TEST_VAL); field := rec.GetField('Value'); Assert.IsNotNull(field, 'Field should not be null'); Assert.AreEqual(TEST_VAL, field.Value, 'Value should be equal'); end; procedure TDataRecordTests.Test_tkChar_Succeeds(const AValue: Char); var rec: TDataRecord; field: TDataRecord.IField; begin rec := CreateRecord('Value', AValue); field := rec.GetField('Value'); Assert.IsNotNull(field, 'Field should not be null'); Assert.AreEqual(AValue, field.Value, 'Value should be equal'); end; procedure TDataRecordTests.Test_tkString_NonGeneric_Succeeds(const AValue: string); var rec: TDataRecord; field: TDataRecord.IField; typedField: TDataRecord.IField; begin rec := CreateRecord('Value', AValue); field := rec.GetField('Value'); Assert.IsNotNull(field, 'Field should not be null'); typedField := rec.GetField('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; begin rec := CreateRecord('Value', AValue); field := rec.GetField('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; begin rec := CreateRecord('Value', teTwo); field := rec.GetField('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; testSet: TTestSet; begin testSet := [teOne, teThree]; rec := CreateRecord('Value', testSet); field := rec.GetField('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; testRec, resultRec: TTestRecord; begin testRec.I := 42; testRec.S := 'Hello Record'; rec := CreateRecord('Value', testRec); field := rec.GetField('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; testMRec, resultMRec: TTestMRecord; begin SetLength(testMRec.FData, 10); testMRec.FData[0] := 1; rec := CreateRecord('Value', testMRec); field := rec.GetField('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>; testArr, resultArr: TArray; begin testArr := [10, 20, 30]; rec := CreateRecord>('Value', testArr); field := rec.GetField>('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; testIntf, resultIntf: ITestInterface; begin testIntf := TTestClass.Create(1337); rec := CreateRecord('Value', testIntf); field := rec.GetField('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; testObj, resultObj: TTestClass; begin testObj := TTestClass.Create(99); try rec := CreateRecord('Value', testObj); field := rec.GetField('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; testVar: Variant; begin testVar := 'Hello Variant'; rec := CreateRecord('Value', testVar); field := rec.GetField('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; begin // Create original record rec1 := CreateRecord('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('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('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; 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('OldValue', 'This should be released'); rec2 := CreateRecord('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('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('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; fieldS: TDataRecord.IField; 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(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('I'); Assert.IsNotNull(fieldI, 'Integer field should exist'); Assert.AreEqual(srcRec.I, fieldI.Value, 'Integer value should match'); fieldS := dataRec.GetField('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(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; begin // Setup a record and create a TDataRecord from it srcRec.I := 456; srcRec.S := 'Original RTTI value'; rec1 := TDataRecord.CreateFrom(srcRec); // Assign the TDataRecord to another, invoking operator Assign rec2 := rec1; // Modify the string field in the copy field2 := rec2.GetField('S'); Assert.IsNotNull(field2, 'Field must exist in copy'); field2.Value := 'Modified in copy'; // Verify that the original TDataRecord is unchanged field1 := rec1.GetField('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; end; initialization TDUnitX.RegisterTestFixture(TDataRecordTests); end.