Michael Schimmel
425 lines
16 KiB
ObjectPascal
425 lines
16 KiB
ObjectPascal
unit TestNotifier_ChaosStress;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Classes, // For TThread
|
|
System.SyncObjs, // For TInterlocked, TCriticalSection (needed by implementation)
|
|
System.Generics.Collections, // For TList<T>
|
|
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<IMyStressTestInterface>.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<TAdvisedReceiverInfo>;
|
|
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<TMyStressReceiver>); // Not strictly needed with current verification
|
|
end;
|
|
|
|
[TestFixture]
|
|
TMycNotifierChaosStressTests = class(TObject)
|
|
public
|
|
FNotifier: TMycNotifyList<IMyStressTestInterface>;
|
|
// List of all receivers ever created in this test run, for final verification
|
|
FAllReceiversCreated: TList<IMyStressTestInterface>;
|
|
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<TAdvisedReceiverInfo>.Create;
|
|
end;
|
|
|
|
destructor TStressWorkerThread.Destroy;
|
|
begin
|
|
FMyAdvisedReceivers.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TStressWorkerThread.Execute;
|
|
var
|
|
i, op: Integer;
|
|
newReceiver: TMyStressReceiver;
|
|
tag: TMycNotifyList<IMyStressTestInterface>.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<TMyStressReceiver>);
|
|
// 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<IMyStressTestInterface>.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 = 5000; // Number of random operations per thread
|
|
var
|
|
threads: array of TStressWorkerThread;
|
|
i: Integer;
|
|
LThreadError: Exception;
|
|
LMessage: string;
|
|
totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd: Integer;
|
|
actualLiveReceiversInNotifier: TList<IMyStressTestInterface>; // 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<IMyStressTestInterface>.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.
|