Notifier & Tests added
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,424 @@
|
||||
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.
|
||||
Reference in New Issue
Block a user