MycLib/Test/TestDataRecord.pas

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<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;
    end;

    [TestFixture]
    TDataRecordTests = class
    private
        function CreateRecord<T>(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<T>(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<T>(FieldName, Value);
    Result := builder.CreateRec;
end;

procedure TDataRecordTests.Test_tkInteger_Succeeds(const AValue: Integer);
var
    rec: TDataRecord;
    field: TDataRecord.IField<Integer>;
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');
end;

procedure TDataRecordTests.Test_tkInt64_Succeeds(const AValue: Int64);
var
    rec: TDataRecord;
    field: TDataRecord.IField<Int64>;
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;

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;

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;

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;

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;
end;

initialization
    TDUnitX.RegisterTestFixture(TDataRecordTests);

end.