Notifier & Tests added

2025-05-25 14:37:57 +02:00
parent 46264ea041
commit 10ef4cbcf2
8 changed files with 1320 additions and 930 deletions
@@ -0,0 +1,302 @@
+unit TestNotifier_Threading;
+
+interface
+
+uses
+    System.SysUtils,
+    System.Classes, // For TThread
+    System.Generics.Collections,
+    DUnitX.TestFramework,
+    Myc.Core.Notifier; // Your unit
+
+type
+    // The previously known test interface and implementation
+    IMyTestInterface = interface(IInterface)
+        ['{7A8C1A01-1C6B-4A7A-B9D8-28E6A8D02A0F}']
+        procedure Foo;
+        function GetValue: Integer;
+    end;
+
+    TMyTestReceiver = class(TInterfacedObject, IMyTestInterface)
+    private
+        FValue: Integer;
+        FCallCount: Integer;
+    public
+        constructor Create(AValue: Integer);
+        procedure Foo;
+        function GetValue: Integer;
+        property CallCount: Integer read FCallCount write FCallCount;
+    end;
+
+    // Forward declaration for the test fixture class
+    TMycNotifierThreadingTests = class;
+
+    // Helper thread class for concurrent Advise operations
+    TAdviseWorkerThread = class(TThread)
+    private
+        FOwnerFixture: TMycNotifierThreadingTests; // Reference to the test fixture for accessing FNotifier
+        FReceiversToAdd: array of IMyTestInterface;
+        FError: Exception;
+        FStartIndex: Integer;
+        FItemsPerThread: Integer;
+    protected
+        procedure Execute; override;
+    public
+        constructor Create(AOwnerFixture: TMycNotifierThreadingTests; AStartIndex, AItemsPerThread: Integer);
+        destructor Destroy; override;
+        property Error: Exception read FError;
+    end;
+
+    [TestFixture]
+    TMycNotifierThreadingTests = class(TObject)
+    public
+        FNotifier: TMycNotifyList<IMyTestInterface>; // The shared Notifier instance
+        FReceiverMasterList: TList<IMyTestInterface>; // To hold references to all created receivers
+
+        [Setup]
+        procedure Setup;
+        [TearDown]
+        procedure TearDown;
+
+        [Test]
+        procedure Test_ConcurrentAdvise_Then_UnadviseAll_Consistency;
+    end;
+
+implementation
+
+uses
+    System.StrUtils;
+
+{ TMyTestReceiver }
+
+constructor TMyTestReceiver.Create(AValue: Integer);
+begin
+    inherited Create;
+    FValue := AValue;
+    FCallCount := 0;
+end;
+
+procedure TMyTestReceiver.Foo;
+begin
+    Inc(FCallCount);
+end;
+
+function TMyTestReceiver.GetValue: Integer;
+begin
+    Result := FValue;
+end;
+
+{ TAdviseWorkerThread }
+
+constructor TAdviseWorkerThread.Create(AOwnerFixture: TMycNotifierThreadingTests; AStartIndex, AItemsPerThread: Integer);
+var
+    i: Integer;
+begin
+    inherited Create(True); // Creates the thread in a suspended state
+    FreeOnTerminate := False; // The test fixture will free the thread
+    FOwnerFixture := AOwnerFixture;
+    FStartIndex := AStartIndex;
+    FItemsPerThread := AItemsPerThread;
+    FError := nil;
+
+    SetLength(FReceiversToAdd, FItemsPerThread);
+    for i := 0 to FItemsPerThread - 1 do
+    begin
+        FReceiversToAdd[i] := TMyTestReceiver.Create(FStartIndex + i);
+    end;
+end;
+
+destructor TAdviseWorkerThread.Destroy;
+begin
+    // Releases the references to the receivers (ARC takes care of the objects)
+    SetLength(FReceiversToAdd, 0);
+    inherited Destroy;
+end;
+
+procedure TAdviseWorkerThread.Execute;
+var
+    i: Integer;
+    tag: TMycNotifyList<IMyTestInterface>.TTag; // Tag is not used further in this test design
+begin
+    inherited; // Important for TThread
+    try
+        for i := 0 to High(FReceiversToAdd) do
+        begin
+            if Terminated then
+                Break; // Respond to termination request
+
+            // Acquire lock before calling Advise
+            FOwnerFixture.FNotifier.Lock;
+            try
+                tag := FOwnerFixture.FNotifier.Advise(FReceiversToAdd[i]);
+                // The 'tag' could be used here if necessary for other test scenarios
+            finally
+                // Definitely release lock in the finally block
+                FOwnerFixture.FNotifier.Release;
+            end;
+
+            // A short Sleep(Random(X)) could increase the probability here
+            // of thread interleaving issues, but makes the test less deterministic.
+            // Sleep(0); // or
+            if Random(10) < 2 then
+                Sleep(Random(2));
+        end;
+    except
+        on E: Exception do
+        begin
+            FError := E; // Store the first error that occurred in the thread
+        end;
+    end;
+end;
+
+{ TMycNotifierThreadingTests }
+
+procedure TMycNotifierThreadingTests.Setup;
+begin
+    Randomize;
+    FNotifier.Create;
+    FReceiverMasterList := TList<IMyTestInterface>.Create;
+end;
+
+procedure TMycNotifierThreadingTests.TearDown;
+var
+    i: Integer;
+begin
+    // Attempt to shut down the Notifier cleanly.
+    // This assumes that FNotifier is not irreparably damaged.
+    try
+        FNotifier.Lock; // Lock for the cleanup process
+        try
+            // UnadviseAll should be safe if the IsFinalized guard is present
+            // and the FFirst state is not pathological.
+            if not FNotifier.IsFinalized then
+            begin
+                FNotifier.UnadviseAll;
+            end;
+        finally
+            if FNotifier.IsLocked then // Only release if the lock is still held
+                FNotifier.Release;
+        end;
+    except
+        // Suppress errors during teardown to avoid interfering with other tests.
+        // In a real test environment, this would be logged.
+    end;
+
+    // FNotifier is a record field of the fixture and is "destroyed" with it.
+    // Setup reinitializes it for each test.
+
+    if Assigned(FReceiverMasterList) then
+    begin
+        // Release references in the master list (ARC takes care of the objects)
+        for i := 0 to FReceiverMasterList.Count - 1 do
+            FReceiverMasterList[i] := nil;
+        FReceiverMasterList.Clear;
+        FReceiverMasterList.Free;
+        FReceiverMasterList := nil;
+    end;
+end;
+
+procedure TMycNotifierThreadingTests.Test_ConcurrentAdvise_Then_UnadviseAll_Consistency;
+const
+    NumThreads = 24; // Number of threads
+    ItemsPerThread = 2500; // Number of Advise operations per thread
+var
+    threads: array of TAdviseWorkerThread;
+    i: Integer;
+    totalAdvisedExpected: Integer;
+    currentNotifyCount: Integer;
+    receiver: IMyTestInterface;
+    LThreadError: Exception; // For safe error message handling
+    LMessage: string;       // For safe error message handling
+begin
+    totalAdvisedExpected := NumThreads * ItemsPerThread;
+    SetLength(threads, NumThreads);
+
+    // Create threads
+    for i := 0 to NumThreads - 1 do
+    begin
+        threads[i] := TAdviseWorkerThread.Create(Self, i * ItemsPerThread, ItemsPerThread);
+    end;
+
+    // Start all threads
+    for i := 0 to NumThreads - 1 do
+    begin
+        threads[i].Start;
+    end;
+
+    // Wait for all threads to complete and check for errors
+    for i := 0 to NumThreads - 1 do
+    begin
+        threads[i].WaitFor;
+
+        LThreadError := threads[i].Error;
+        if Assigned(LThreadError) then
+        begin
+            LMessage := 'Thread ' + i.ToString + ' reported an error: ' + LThreadError.Message;
+            Assert.IsNull(LThreadError, LMessage); // This will fail and show the message
+        end
+        else
+        begin
+            Assert.IsNull(LThreadError); // This will pass
+        end;
+
+        // Add the receivers added by this thread to the MasterList,
+        // to ensure their lifetime for the duration of the test.
+        for receiver in threads[i].FReceiversToAdd do
+        begin
+            FReceiverMasterList.Add(receiver);
+        end;
+        threads[i].Free; // Free thread object
+    end;
+    SetLength(threads, 0);
+
+    // 1. Consistency check: Number of items in the Notifier after all Advise operations.
+    // Since TMycNotifyList does not have a direct Count property, we count via Notify.
+    currentNotifyCount := 0;
+    FNotifier.Lock;
+    try
+        FNotifier.Notify(
+            function(Item: IMyTestInterface): Boolean
+            begin
+                Inc(currentNotifyCount);
+                Result := True; // Keep item in the Notifier
+            end
+        );
+    finally
+        FNotifier.Release;
+    end;
+    Assert.AreEqual(totalAdvisedExpected, currentNotifyCount,
+        'The number of items in the Notifier after all Advise operations (' + currentNotifyCount.ToString +
+        ') does not match the expected number (' + totalAdvisedExpected.ToString + ').');
+
+    // 2. Execute UnadviseAll
+    FNotifier.Lock;
+    try
+        FNotifier.UnadviseAll; // Should remove all items
+    finally
+        FNotifier.Release;
+    end;
+
+    // 3. Consistency check: Notifier should be empty after UnadviseAll.
+    currentNotifyCount := 0;
+    FNotifier.Lock;
+    try
+        FNotifier.Notify(
+            function(Item: IMyTestInterface): Boolean
+            begin
+                Inc(currentNotifyCount);
+                Result := True;
+            end
+        );
+    finally
+        FNotifier.Release;
+    end;
+    Assert.AreEqual(0, currentNotifyCount,
+        'The Notifier should be empty after UnadviseAll, but still contains ' + currentNotifyCount.ToString + ' items.');
+end;
+
+initialization
+
+TDUnitX.RegisterTestFixture(TMycNotifierThreadingTests);
+
+end.