unit TestNotifier_ChaosStress; interface uses System.SysUtils, System.Classes, // For TThread System.SyncObjs, // For TInterlocked, TCriticalSection (needed by implementation) System.Generics.Collections, // For TList System.Diagnostics, // For TStopwatch DUnitX.TestFramework, Myc.Core.Notifier; // Your unit type IMyStressTestInterface = interface(IInterface) ['{B8A3F7E1-47D9-4A9C-8C2B-035A1B568E7F}'] procedure Foo(NotificationType: Integer); // NotificationType for more detailed testing function GetValue: Integer; function GetNotificationCount: Integer; function GetInstanceID: Integer; function GetExpectedToBeAdvised: Boolean; procedure SetExpectedToBeAdvised(const Value: Boolean); property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write SetExpectedToBeAdvised; end; TMyStressReceiver = class(TInterfacedObject, IMyStressTestInterface) private FInstanceID: Integer; FValue: Integer; FNotificationCount: Integer; FExpectedToBeAdvised: Boolean; function GetExpectedToBeAdvised: Boolean; procedure SetExpectedToBeAdvised(const Value: Boolean); public // For testing: flag to indicate if the thread that created this believes it's still advised constructor Create(AInstanceID, AValue: Integer); procedure Foo(NotificationType: Integer); function GetValue: Integer; function GetNotificationCount: Integer; function GetInstanceID: Integer; property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write SetExpectedToBeAdvised; end; // Record type to store an advised receiver and its tag TAdvisedReceiverInfo = record Tag: TMycNotifyList.TTag; Receiver: IMyStressTestInterface; end; TMycNotifierChaosStressTests = class; // Forward declaration TStressWorkerThread = class(TThread) private FOwnerFixture: TMycNotifierChaosStressTests; FThreadID: Integer; FIterations: Integer; FError: Exception; // List of receivers this thread has successfully advised and believes are still active FMyAdvisedReceivers: TList; protected procedure Execute; override; public constructor Create(AOwnerFixture: TMycNotifierChaosStressTests; AThreadID, AIterations: Integer); destructor Destroy; override; property Error: Exception read FError; function GetAdvisedReceiverCountByThread: Integer; // procedure GetMyExpectedLiveReceivers(AList: TList); // Not strictly needed with current verification end; [TestFixture] TMycNotifierChaosStressTests = class(TObject) public FNotifier: TMycNotifyList; // List of all receivers ever created in this test run, for final verification FAllReceiversCreated: TList; FCriticalSectionForList: TCriticalSection; // To protect FAllReceiversCreated FNextReceiverInstanceID: Integer; // Atomically incremented ID for receivers [Setup] procedure Setup; [TearDown] procedure TearDown; [Test] procedure Test_MixedOperations_Stress; end; implementation // uses System.StrUtils; // Not needed anymore if IfThen is not used { TMyStressReceiver } constructor TMyStressReceiver.Create(AInstanceID, AValue: Integer); begin inherited Create; FInstanceID := AInstanceID; FValue := AValue; FNotificationCount := 0; FExpectedToBeAdvised := False; // Initially not advised or expecting to be end; procedure TMyStressReceiver.Foo(NotificationType: Integer); begin TInterlocked.Increment(FNotificationCount); // Atomic increment end; function TMyStressReceiver.GetExpectedToBeAdvised: Boolean; begin Result := FExpectedToBeAdvised; end; function TMyStressReceiver.GetValue: Integer; begin Result := FValue; end; function TMyStressReceiver.GetNotificationCount: Integer; begin // Atomic read, ensuring visibility of changes from other threads if FNotificationCount was public // For private field accessed by owner, direct read is fine if Notify is serialized. // TInterlocked.Add(var Target, Value) returns Target+Value. For read: Target+0. Result := TInterlocked.Add(FNotificationCount, 0); end; function TMyStressReceiver.GetInstanceID: Integer; begin Result := FInstanceID; end; procedure TMyStressReceiver.SetExpectedToBeAdvised(const Value: Boolean); begin FExpectedToBeAdvised := Value; end; { TStressWorkerThread } constructor TStressWorkerThread.Create(AOwnerFixture: TMycNotifierChaosStressTests; AThreadID, AIterations: Integer); begin inherited Create(True); // Creates the thread in a suspended state FreeOnTerminate := False; // The test fixture will free the thread FOwnerFixture := AOwnerFixture; FThreadID := AThreadID; FIterations := AIterations; FError := nil; FMyAdvisedReceivers := TList.Create; end; destructor TStressWorkerThread.Destroy; begin FMyAdvisedReceivers.Free; inherited; end; procedure TStressWorkerThread.Execute; var i, op: Integer; newReceiver: TMyStressReceiver; tag: TMycNotifyList.TTag; itemIndex: Integer; advisedItemRec: TAdvisedReceiverInfo; localInstanceID: Integer; begin inherited; // Important for TThread try for i := 1 to FIterations do begin if Terminated then Break; // Respond to termination request op := Random(100); if op < 35 then // 35% chance to Advise begin localInstanceID := TInterlocked.Increment(FOwnerFixture.FNextReceiverInstanceID); newReceiver := TMyStressReceiver.Create(localInstanceID, FThreadID * 10000 + i); // newReceiver.ExpectedToBeAdvised is False by default, will be set to True by this thread upon successful advise. FOwnerFixture.FCriticalSectionForList.Enter; try FOwnerFixture.FAllReceiversCreated.Add(newReceiver); finally FOwnerFixture.FCriticalSectionForList.Leave; end; FOwnerFixture.FNotifier.Lock; try tag := FOwnerFixture.FNotifier.Advise(newReceiver); advisedItemRec.Tag := tag; advisedItemRec.Receiver := newReceiver; FMyAdvisedReceivers.Add(advisedItemRec); newReceiver.ExpectedToBeAdvised := True; // This thread now expects it to be advised finally FOwnerFixture.FNotifier.Release; end; end else if (op < 70) and (FMyAdvisedReceivers.Count > 0) then // 35% chance to Unadvise (if possible) begin itemIndex := Random(FMyAdvisedReceivers.Count); advisedItemRec := FMyAdvisedReceivers[itemIndex]; FOwnerFixture.FNotifier.Lock; try FOwnerFixture.FNotifier.Unadvise(advisedItemRec.Tag); advisedItemRec.Receiver.ExpectedToBeAdvised := False; // This thread no longer expects it to be advised FMyAdvisedReceivers.Delete(itemIndex); finally FOwnerFixture.FNotifier.Release; end; end else // 30% chance to Notify begin FOwnerFixture.FNotifier.Lock; try // if not FOwnerFixture.FNotifier.IsFinalized then // Don't notify if finalized begin FOwnerFixture.FNotifier.Notify( function(Item: IMyStressTestInterface): Boolean begin Item.Foo(FThreadID); // Pass ThreadID as notification type for context Result := True; // Keep item end ); end; finally FOwnerFixture.FNotifier.Release; end; end; if (i mod 75 = 0) then Sleep(0); // Yield occasionally to encourage context switching end; except on E: Exception do FError := E; // Store the first error that occurred in the thread end; end; function TStressWorkerThread.GetAdvisedReceiverCountByThread: Integer; begin Result := FMyAdvisedReceivers.Count; end; // Not strictly needed if main test iterates FAllReceiversCreated and checks ExpectedToBeAdvised flag // procedure TStressWorkerThread.GetMyExpectedLiveReceivers(AList: TList); // var // itemRec: TAdvisedReceiverInfo; // begin // AList.Clear; // for itemRec in FMyAdvisedReceivers do // begin // AList.Add(itemRec.Receiver); // end; // end; { TMycNotifierChaosStressTests } procedure TMycNotifierChaosStressTests.Setup; begin Randomize; // Initialize random number generator FNotifier.Create; FAllReceiversCreated := TList.Create; FCriticalSectionForList := TCriticalSection.Create; FNextReceiverInstanceID := 0; end; procedure TMycNotifierChaosStressTests.TearDown; var // receiver: TMyStressReceiver; // Not used directly in this simplified TearDown i: Integer; begin // Attempt to shut down the Notifier cleanly. 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 when the fixture is destroyed. // Setup reinitializes it for each test. if Assigned(FAllReceiversCreated) then begin // ARC will handle TMyStressReceiver instances when the list is freed/cleared, // as long as no other strong references exist. // Setting list items to nil is good practice if the list itself isn't immediately freed. for i := 0 to FAllReceiversCreated.Count - 1 do FAllReceiversCreated[i] := nil; // Break reference cycles if any, allow ARC FAllReceiversCreated.Free; FAllReceiversCreated := nil; end; if Assigned(FCriticalSectionForList) then begin FCriticalSectionForList.Free; FCriticalSectionForList := nil; end; end; procedure TMycNotifierChaosStressTests.Test_MixedOperations_Stress; const NumThreads = 24; // Number of concurrent worker threads IterationsPerThread = 2000; // Number of random operations per thread var threads: array of TStressWorkerThread; i: Integer; LThreadError: Exception; totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd: Integer; actualLiveReceiversInNotifier: TList; // Store interface type from Notify receiver: IMyStressTestInterface; found: Boolean; stopwatch: TStopwatch; begin stopwatch := TStopwatch.StartNew; SetLength(threads, NumThreads); for i := 0 to NumThreads - 1 do threads[i] := TStressWorkerThread.Create(Self, i + 1, IterationsPerThread); for i := 0 to NumThreads - 1 do threads[i].Start; totalExpectedLiveByThreadsAtEnd := 0; for i := 0 to NumThreads - 1 do begin threads[i].WaitFor; LThreadError := threads[i].Error; if Assigned(LThreadError) then begin // If an error occurred, Assert.IsNull would fail. // The message can safely use LThreadError.Message here. Assert.IsNull(LThreadError, 'Thread ' + threads[i].FThreadID.ToString + ' reported an error: ' + LThreadError.Message); end else begin // If no error, Assert.IsNull will pass. No custom message needed for success. Assert.IsNull(LThreadError); end; totalExpectedLiveByThreadsAtEnd := totalExpectedLiveByThreadsAtEnd + threads[i].GetAdvisedReceiverCountByThread; threads[i].Free; end; SetLength(threads, 0); // --- Verification Phase --- // 1. Get all items actually live in the notifier actualLiveReceiversInNotifier := TList.Create; try FNotifier.Lock; try // if not FNotifier.IsFinalized then begin FNotifier.Notify( function(Item: IMyStressTestInterface): Boolean begin actualLiveReceiversInNotifier.Add(Item); Result := True; end ); end; finally FNotifier.Release; end; actualLiveInNotifierAtEnd := actualLiveReceiversInNotifier.Count; // 2. Compare overall counts Assert.AreEqual( totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd, Format( 'Mismatch in live item count at end. Threads expected %d, Notifier has %d.', [totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd] ) ); // 3. Detailed check: Iterate all receivers ever created. // Their 'ExpectedToBeAdvised' flag (last known state from its managing thread) // should match their presence in 'actualLiveReceiversInNotifier'. FCriticalSectionForList.Enter; try for receiver in FAllReceiversCreated do begin // Check if this receiver (by instance) is in the list of interfaces retrieved from Notify found := False; for var liveIntf in actualLiveReceiversInNotifier do begin if liveIntf = receiver then // Compare object instances begin found := True; Break; end; end; Assert.AreEqual( receiver.ExpectedToBeAdvised, found, Format( 'Receiver ID %d: Thread expected it to be advised=%d, but its presence in Notifier is %d. NotificationCount=%d', [ receiver.GetInstanceID, Integer(receiver.ExpectedToBeAdvised), Integer(found), receiver.GetNotificationCount ] ) ); // Further checks on NotificationCount could be added if specific notification patterns were expected. // For this chaos test, ensuring count is non-negative and consistent with advised state is a good start. Assert.IsTrue( receiver.GetNotificationCount >= 0, Format( 'Receiver ID %d has non-positive notification count: %d', [receiver.GetInstanceID, receiver.GetNotificationCount] ) ); if found and (receiver.GetNotificationCount = 0) then begin // This might be okay if Notify calls were very sparse or the item was just added and not yet notified. // For a long running stress test, one might expect > 0 if Notifies happened while it was live. // Log.Debug(Format('Receiver ID %d found in notifier but has 0 notifications.', [receiver.GetInstanceID])); end; end; finally FCriticalSectionForList.Leave; end; finally actualLiveReceiversInNotifier.Free; end; stopwatch.Stop; end; initialization TDUnitX.RegisterTestFixture(TMycNotifierChaosStressTests); end.