DataRecord almost finished

2025-07-19 14:24:04 +02:00
parent 57319a55c1
commit 6010f61953
6 changed files with 747 additions and 257 deletions
@@ -0,0 +1,399 @@
+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 TestFinalizeWithValue_True_Succeeds;
+
+        [Test]
+        procedure TestFinalizeWithValue_False_Leaks;
+    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.TestFinalizeWithValue_True_Succeeds;
+var
+    Buffer: TBytes;
+    P: Pointer;
+    s: string;
+begin
+    // 1. Create a managed string and place it in a raw buffer
+    s := 'This is a test string that should be finalized.';
+    SetLength(Buffer, SizeOf(string));
+    P := @Buffer[0];
+    PString(P)^ := s;
+    s := ''; // Clear the original variable, the buffer is now the owner
+
+    // 2. Try to finalize the string in the buffer using TValue
+    var Val: TValue;
+    TValue.MakeWithoutCopy(P, TypeInfo(string), Val, true);
+
+    // If 'true' works as expected (takes ownership and finalizes), this test will pass without leaks.
+    Assert.IsTrue(true);
+end;
+
+procedure TDataRecordTests.TestFinalizeWithValue_False_Leaks;
+var
+    Buffer: TBytes;
+    P: Pointer;
+    s: string;
+begin
+    // 1. Create a managed string and place it in a raw buffer
+    s := 'This string will be leaked.';
+    SetLength(Buffer, SizeOf(string));
+    P := @Buffer[0];
+    PString(P)^ := s;
+    s := ''; // Clear the original variable, the buffer is now the owner
+
+    // 2. Try to "finalize" the string using 'false'
+    var Val: TValue;
+    TValue.MakeWithoutCopy(P, TypeInfo(string), Val, false);
+
+    // If 'false' does NOT take ownership, this test will report a memory leak.
+    //    Log.Info('This test is expected to report a memory leak.');
+    Assert.IsTrue(true);
+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.