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; // The shared Notifier instance FReceiverMasterList: TList; // 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.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.