Atomic operations for TDataValue

Src/Data/Myc.Data.Value.pas

@@ -4,6 +4,7 @@ interface
 
 uses
     System.SysUtils,
+    System.SyncObjs,
     Myc.Utils,
     Myc.Data.Scalar,
     Myc.Data.Series;
@@ -35,7 +36,6 @@ type
             FScalar: TScalar;
             FInterface: IInterface;
 
-        function GetKind: TDataValueKind; inline;
         function GetIsVoid: Boolean; inline;
 
     public
@@ -50,8 +50,9 @@ type
         class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline;
         class operator Implicit(const AValue: TObject): TDataValue; overload; inline;
 
-        class function CompareAndSet(var Target: TDataValue; const Expected, NewValue: TDataValue): Boolean; static;
+        // atomic operations
-        class function Reset(var Target: TDataValue; const NewValue: TDataValue): TDataValue; static;
+        function CompareAndSet(const Expected, NewValue: TDataValue): Boolean;
+        function Reset(const NewValue: TDataValue): TDataValue;
 
         class function FromIntf<T: IInterface>(const AValue: T): TDataValue; static;
         function AsIntf<T: IInterface>: T; inline;
@@ -78,7 +79,7 @@ type
 
         function ToString: String;
         property IsVoid: Boolean read GetIsVoid;
-        property Kind: TDataValueKind read GetKind;
+        property Kind: TDataValueKind read FKind;
     end;
 
     TDataValueKindHelper = record helper for TDataValueKind
@@ -89,7 +90,7 @@ type
 implementation
 
 uses
-    TypInfo;
+    System.TypInfo;
 
 type
     TMapSeries = class(TInterfacedObject, ISeries)
@@ -197,9 +198,51 @@ begin
     Result := (FInterface as TVal<String>).Value;
 end;
 
-class function TDataValue.CompareAndSet(var Target: TDataValue; const Expected, NewValue: TDataValue): Boolean;
+function TDataValue.CompareAndSet(const Expected, NewValue: TDataValue): Boolean;
+
+    function IntfCompareExchange(var VTarget: IInterface; const AValue, Compare: IInterface): IInterface; inline;
+    begin
+        if AValue <> nil then
+            AValue._AddRef;
+
+        Result := IInterface(TInterlocked.CompareExchange(Pointer(VTarget), Pointer(AValue), Pointer(Compare)));
+
+        if (AValue <> nil) and (Pointer(Result) <> Pointer(Compare)) then
+            AValue._Release;
+    end;
+
 begin
-    //    Result := ;
+    Result := false;
+    if FKind <> Expected.Kind then
+        exit;
+    if FKind <> NewValue.Kind then
+        raise EArgumentException.Create('Value kinds have to match');
+
+    if FKind = vkVoid then
+        raise EArgumentException.Create('Value is void');
+
+    case FKind of
+        vkScalar:
+            case FScalar.Kind of
+                TScalar.TKind.Ordinal:
+                    Result :=
+                        TInterlocked
+                                .CompareExchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64, Expected.AsScalar.Value.AsInt64)
+                            = Expected.AsScalar.Value.AsInt64;
+                TScalar.TKind.Float:
+                    Result :=
+                        TInterlocked
+                                .CompareExchange(FScalar.Value.AsDouble, NewValue.AsScalar.Value.AsDouble, Expected.AsScalar.Value.AsDouble)
+                            = Expected.AsScalar.Value.AsDouble;
+            end;
+        vkPointer:
+            Result :=
+                TInterlocked.CompareExchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64, Expected.AsScalar.Value.AsInt64)
+                    = Expected.AsScalar.Value.AsInt64;
+
+        vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric:
+            Result := IntfCompareExchange(FInterface, NewValue.FInterface, Expected.FInterface) = Expected.FInterface;
+    end;
 end;
 
 class function TDataValue.FromIntf<T>(const AValue: T): TDataValue;
@@ -257,19 +300,45 @@ begin
     Result := FKind = vkVoid;
 end;
 
-function TDataValue.GetKind: TDataValueKind;
-begin
-    Result := TDataValueKind(FKind);
-end;
-
 class function TDataValue.Map(const SourceSeries: ISeries; const MapperFunc: TFunc): ISeries;
 begin
     Result := TMapSeries.Create(SourceSeries, MapperFunc);
 end;
 
-class function TDataValue.Reset(var Target: TDataValue; const NewValue: TDataValue): TDataValue;
+function TDataValue.Reset(const NewValue: TDataValue): TDataValue;
+
+    function IntfExchange(var VTarget: IInterface; const AValue: IInterface): IInterface; inline;
+    begin
+        if AValue <> nil then
+            AValue._AddRef;
+
+        Result := IInterface(TInterlocked.Exchange(Pointer(VTarget), Pointer(AValue)));
+
+        if AValue <> nil then
+            AValue._Release;
+    end;
+
 begin
-    //    Result := ;
+    if FKind <> NewValue.Kind then
+        raise EArgumentException.Create('Value kinds have to match');
+
+    if FKind = vkVoid then
+        raise EArgumentException.Create('Value is void');
+
+    case FKind of
+        vkScalar:
+            case FScalar.Kind of
+                TScalar.TKind.Ordinal: Result := TInterlocked.Exchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64);
+                TScalar.TKind.Float: Result := TInterlocked.Exchange(FScalar.Value.AsDouble, NewValue.AsScalar.Value.AsDouble);
+            end;
+        vkPointer: Result := TInterlocked.Exchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64);
+
+        vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric:
+        begin
+            Result.FKind := FKind;
+            Result.FInterface := IntfExchange(FInterface, NewValue.FInterface);
+        end;
+    end;
 end;
 
 function TDataValue.ToString: String;

Test/MycTests.dpr

@@ -33,7 +33,8 @@ uses
     TestDataDecimal in 'TestDataDecimal.pas',
     TestDataPOD in 'TestDataPOD.pas',
     Test.Ast.Interpreter.Scope in 'Test.Ast.Interpreter.Scope.pas',
-    Myc.Data.Chunks in '..\Src\Data\Myc.Data.Chunks.pas';
+    Myc.Data.Chunks in '..\Src\Data\Myc.Data.Chunks.pas',
+    Test.Myc.Data.Value in 'Test.Myc.Data.Value.pas';
 
 { keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
 {$IFNDEF TESTINSIGHT}

Test/MycTests.dproj

@@ -137,6 +137,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
         <DCCReference Include="TestDataPOD.pas"/>
         <DCCReference Include="Test.Ast.Interpreter.Scope.pas"/>
         <DCCReference Include="..\Src\Data\Myc.Data.Chunks.pas"/>
+        <DCCReference Include="Test.Myc.Data.Value.pas"/>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>

Test/Test.Myc.Data.Value.pas

@@ -0,0 +1,173 @@
+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.