Files
MycLib/Test/Test.Core.Mutable.pas
T

204 lines
5.6 KiB
ObjectPascal

unit Test.Core.Mutable;
interface
uses
System.SysUtils,
System.SyncObjs,
System.Classes,
DUnitX.TestFramework,
Myc.Signals,
Myc.Mutable,
Myc.Core.Mutable;
type
[TestFixture]
TTestCoreMutable = class
private
FNotifyCount: Integer;
procedure SubscriberCallback;
public
[Setup]
procedure Setup;
[Test]
procedure TestNullMutable;
[Test]
procedure TestFuncMutable_GetValue;
[Test]
[TestCase('Writeable', '10,20')]
procedure TestWriteableMutable(InitialValue, NewValue: Integer);
[Test]
[TestCase('Protected', '100,200')]
procedure TestProtectedMutable_Delegation(InitialValue, NewValue: Integer);
[Test]
procedure TestProtectedMutable_ThreadSafety;
end;
implementation
uses
System.Generics.Defaults;
type
// A simple subscriber implementation for testing purposes.
TTestSubscriber = class(TInterfacedObject, TSignal.ISubscriber)
private
FOnNotify: TProc;
public
constructor Create(const AOnNotify: TProc);
function Notify: Boolean;
end;
{ TTestSubscriber }
constructor TTestSubscriber.Create(const AOnNotify: TProc);
begin
inherited Create;
FOnNotify := AOnNotify;
end;
function TTestSubscriber.Notify: Boolean;
begin
if Assigned(FOnNotify) then
begin
FOnNotify;
end;
Result := True;
end;
{ TTestCoreMutable }
procedure TTestCoreMutable.Setup;
begin
FNotifyCount := 0;
end;
procedure TTestCoreMutable.SubscriberCallback;
begin
TInterlocked.Increment(FNotifyCount);
end;
procedure TTestCoreMutable.TestNullMutable;
var
mutable: TMutable<Integer>;
begin
mutable := TMutable<Integer>.Constant(42);
Assert.AreEqual(42, mutable.Value);
// Explicitly cast record helper to fully qualified interface for comparison
Assert.IsTrue(TSignal.ISignal(mutable.Changed) = TSignal.Null, 'Changed signal should be Null');
end;
procedure TTestCoreMutable.TestFuncMutable_GetValue;
var
mutable: TMutable<Integer>;
callCount: Integer;
func: TFunc<Integer>;
begin
callCount := 0;
func :=
function: Integer
begin
Inc(callCount);
Result := 42;
end;
mutable := TMutable<Integer>.Construct(TEvent.CreateEvent.Signal, func);
Assert.AreEqual(42, mutable.Value, 'First value access failed');
Assert.AreEqual(1, callCount, 'Function should have been called once');
end;
procedure TTestCoreMutable.TestWriteableMutable(InitialValue, NewValue: Integer);
var
writeable: TWriteable<Integer>;
subscriber: TSignal.ISubscriber;
subscription: TSignal.TSubscription;
exchangedValue: Integer;
begin
writeable := TWriteable<Integer>.CreateWriteable(InitialValue);
subscriber := TTestSubscriber.Create(SubscriberCallback);
subscription := writeable.Changed.Subscribe(subscriber);
writeable.Value := NewValue;
Assert.AreEqual(1, FNotifyCount, 'Changed.Notify should have been called on SetValue');
subscription.Unsubscribe;
end;
procedure TTestCoreMutable.TestProtectedMutable_Delegation(InitialValue, NewValue: Integer);
var
writeable: TWriteable<Integer>;
protectedWriteable: TWriteable<Integer>;
subscriber: TSignal.ISubscriber;
subscription: TSignal.TSubscription;
begin
writeable := TWriteable<Integer>.CreateWriteable(InitialValue);
protectedWriteable := writeable.Protect;
subscriber := TTestSubscriber.Create(SubscriberCallback);
subscription := protectedWriteable.Changed.Subscribe(subscriber);
protectedWriteable.Value := NewValue;
Assert.AreEqual(1, FNotifyCount, 'Changed.Notify should have been called on SetValue');
subscription.Unsubscribe;
end;
procedure TTestCoreMutable.TestProtectedMutable_ThreadSafety;
const
ThreadCount = 8;
Iterations = 2500;
var
writeable: TWriteable<Integer>;
threads: TArray<TThread>;
i: Integer;
begin
// This test verifies that the lock prevents crashes under concurrent access.
// It does not test for an atomic sum, as the protected mutable does not
// offer a combined Compare-and-Exchange operation.
writeable := TWriteable<Integer>.CreateWriteable(0).Protect;
for i := 0 to ThreadCount - 1 do
begin
threads :=
threads
+ [
TThread.CreateAnonymousThread(
procedure
var
j: Integer;
begin
for j := 1 to Iterations do
begin
// This is an intentional race condition to test lock stability.
// The lock protects the GetValue calls individually,
// preventing memory corruption during concurrent access.
var curr := writeable.Value;
writeable.Value := curr + 1;
end;
end
)];
end;
for var thread in threads do
begin
thread.FreeOnTerminate := false;
thread.Start;
end;
for var thread in threads do
begin
thread.WaitFor;
thread.Free;
end;
// We cannot assert a specific value due to the race condition,
// but success means the test completed without exceptions.
Assert.IsTrue(True, 'Thread safety test completed without exceptions.');
end;
end.