MycLib/Test/Test.Myc.Data.Value.pas

unit Test.Myc.Data.Value;

interface

uses
    DUnitX.TestFramework,
    System.SysUtils,
    System.Threading,
    Myc.Data.Value,
    Myc.Data.Scalar;

type
    [TestFixture]
    TTestDataValue = class(TObject)
    private
        type
            // Simple object for interface tests
            TTestObject = class(TInterfacedObject, IInterface)
            public
                ID: Integer;
            end;
    public
        [Test]
        procedure TestReset_Scalar;
        [Test]
        procedure TestReset_Interface;
        [Test]
        procedure TestCompareAndSet_Scalar;
        [Test]
        procedure TestCompareAndSet_Interface;
        [Test]
        procedure TestKindImmutability_ThrowsException;
        [Test]
        procedure TestAtomicity_ConcurrentIncrement;
    end;

implementation

{ TTestDataValue }

procedure TTestDataValue.TestReset_Scalar;
var
    val: TDataValue;
    oldVal: TDataValue;
begin
    // Test with Int64
    val := 10;
    oldVal := val.Reset(20);
    Assert.AreEqual(Int64(20), val.AsScalar.Value.AsInt64, 'Value should be updated to 20');
    Assert.AreEqual(Int64(10), oldVal.AsScalar.Value.AsInt64, 'Reset should return the old value 10');

    // Test with Double
    val := 10.5;
    oldVal := val.Reset(20.5);
    Assert.AreEqual(Double(20.5), val.AsScalar.Value.AsDouble, 'Value should be updated to 20.5');
    Assert.AreEqual(Double(10.5), oldVal.AsScalar.Value.AsDouble, 'Reset should return the old value 10.5');
end;

procedure TTestDataValue.TestReset_Interface;
var
    objA, objB: IInterface;
    val: TDataValue;
    oldVal: TDataValue;
begin
    objA := TTestObject.Create;
    objB := TTestObject.Create;

    val := TDataValue.FromIntf(objA);
    oldVal := val.Reset(TDataValue.FromIntf(objB));

    Assert.AreSame(objB, val.AsIntf<IInterface>, 'Value should be updated to objB');
    Assert.AreSame(objA, oldVal.AsIntf<IInterface>, 'Reset should return the old value objA');
end;

procedure TTestDataValue.TestCompareAndSet_Scalar;
var
    val: TDataValue;
begin
    val := 100;

    // Successful CAS
    Assert.IsTrue(val.CompareAndSet(100, 200), 'CAS should succeed when expected value matches');
    Assert.AreEqual(Int64(200), val.AsScalar.Value.AsInt64, 'Value should be 200 after successful CAS');

    // Failing CAS
    Assert.IsFalse(val.CompareAndSet(100, 300), 'CAS should fail when expected value does not match');
    Assert.AreEqual(Int64(200), val.AsScalar.Value.AsInt64, 'Value should remain 200 after failed CAS');
end;

procedure TTestDataValue.TestCompareAndSet_Interface;
var
    objA, objB, objC: IInterface;
    val: TDataValue;
begin
    objA := TTestObject.Create;
    objB := TTestObject.Create;
    objC := TTestObject.Create;
    val := TDataValue.FromIntf(objA);

    // Successful CAS
    Assert.IsTrue(val.CompareAndSet(TDataValue.FromIntf(objA), TDataValue.FromIntf(objB)), 'CAS should succeed for interfaces');
    Assert.AreSame(objB, val.AsIntf<IInterface>, 'Value should be objB after successful CAS');

    // Failing CAS
    Assert.IsFalse(val.CompareAndSet(TDataValue.FromIntf(objA), TDataValue.FromIntf(objC)), 'CAS should fail for interfaces');
    Assert.AreSame(objB, val.AsIntf<IInterface>, 'Value should remain objB after failed CAS');
end;

procedure TTestDataValue.TestKindImmutability_ThrowsException;
var
    scalarVal, textVal: TDataValue;
begin
    scalarVal := 10;
    textVal := 'hello';

    // Test Reset
    Assert.WillRaise(procedure begin scalarVal.Reset(textVal); end, EArgumentException, 'Reset must throw exception on kind mismatch');

    // Test CompareAndSet
    Assert.WillRaise(
        procedure
        begin
            // NewValue has wrong kind
            scalarVal.CompareAndSet(10, textVal);
        end,
        EArgumentException,
        'CompareAndSet must throw exception on kind mismatch'
    );

    // Expected value doesn't match kind, should just fail silently (return False)
    Assert.IsFalse(scalarVal.CompareAndSet(textVal, 20), 'CAS should return False if kinds of self and expected differ');
end;

procedure TTestDataValue.TestAtomicity_ConcurrentIncrement;
const
    NumThreads = 8;
    IncrementsPerThread = 25000;
var
    sharedValue: TDataValue;
    tasks: array of ITask;
    i: Integer;
begin
    sharedValue := 0; // TDataValue of kind vkScalar, Ordinal
    SetLength(tasks, NumThreads);

    for i := 0 to High(tasks) do
    begin
        tasks[i] :=
            TTask.Run(
                procedure
                var
                    j: Integer;
                    oldVal, newVal: TDataValue;
                begin
                    for j := 1 to IncrementsPerThread do
                    begin
                        // This is the classic lock-free swap loop
                        repeat
                            oldVal := sharedValue; // Read current value
                            newVal := oldVal.AsScalar.Value.AsInt64 + 1;
                        until sharedValue.CompareAndSet(oldVal, newVal);
                    end;
                end
            );
    end;

    TTask.WaitForAll(tasks);

    const Expected = NumThreads * IncrementsPerThread;
    Assert.AreEqual(Int64(Expected), sharedValue.AsScalar.Value.AsInt64, 'Concurrent increments should result in the correct total sum');
end;

end.