MycLib/Test/TestNotifier_Threading.pas

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;
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
                var 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 = 250; // 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.