diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas index e93613c..f7fc619 100644 --- a/Src/Data/Myc.Data.Value.pas +++ b/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; - class function Reset(var Target: TDataValue; const NewValue: TDataValue): TDataValue; static; + // atomic operations + function CompareAndSet(const Expected, NewValue: TDataValue): Boolean; + function Reset(const NewValue: TDataValue): TDataValue; class function FromIntf(const AValue: T): TDataValue; static; function AsIntf: 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).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(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; diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index 4bdec25..d6ecb7d 100644 --- a/Test/MycTests.dpr +++ b/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} diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index 8c1c934..e6e465b 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -137,6 +137,7 @@ $(PreBuildEvent)]]> + Base diff --git a/Test/Test.Myc.Data.Value.pas b/Test/Test.Myc.Data.Value.pas new file mode 100644 index 0000000..781bcec --- /dev/null +++ b/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, 'Value should be updated to objB'); + Assert.AreSame(objA, oldVal.AsIntf, '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, '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, '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.