Notifier & Tests added

This commit is contained in:
Michael Schimmel
2025-05-25 14:37:57 +02:00
parent 46264ea041
commit 10ef4cbcf2
8 changed files with 1320 additions and 930 deletions
+5 -2
View File
@@ -15,9 +15,12 @@ uses
DUnitX.Loggers.Xml.NUnit,
{$ENDIF }
DUnitX.TestFramework,
TestSignals in 'TestSignals.pas',
TestNotifier in 'TestNotifier.pas',
TestSList in 'TestSList.pas',
TestStack in 'TestStack.pas';
TestStack in 'TestStack.pas',
Myc.Core.Notifier in '..\Src\Myc.Core.Notifier.pas',
TestNotifier_Threading in 'TestNotifier_Threading.pas',
TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas';
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
{$IFNDEF TESTINSIGHT}
+4 -1
View File
@@ -105,9 +105,12 @@
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="TestSignals.pas"/>
<DCCReference Include="TestNotifier.pas"/>
<DCCReference Include="TestSList.pas"/>
<DCCReference Include="TestStack.pas"/>
<DCCReference Include="..\Src\Myc.Core.Notifier.pas"/>
<DCCReference Include="TestNotifier_Threading.pas"/>
<DCCReference Include="TestNotifier_ChaosStress.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
+262
View File
@@ -0,0 +1,262 @@
unit TestNotifier;
interface
uses
DUnitX.TestFramework,
System.SysUtils, // For EAssertionFailed, EAccessViolation
Myc.Core.Notifier;
type
// Dummy interface and class for testing
IMyTestInterface = interface( IInterface )
['{7A8C1A01-1C6B-4A7A-B9D8-28E6A8D02A0F}']
// Unique GUID
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;
[TestFixture]
TMycTestNotifierTests = class
private
FNotifier: TMycNotifyList<IMyTestInterface>;
public
[Setup]
procedure Setup;
[TearDown]
procedure TearDown;
[Test]
procedure Test01_DestroyExecutesWithoutErrors;
[Test]
procedure Test02_NotifyOnFinalizedLockedEmptyListExecutesWithoutErrors;
[Test]
procedure Test03_UnadviseAllOnFinalizedLockedEmptyListExecutesWithoutErrors;
[Test]
procedure Test04_AdviseUnadviseBasicFunctionality;
[Test]
procedure Test05_NotifyCallsAdvisedItemsAndCanRemoveThem;
end;
implementation
{ 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;
{ TMycTestNotifierTests }
procedure TMycTestNotifierTests.Setup;
begin
FNotifier.Create;
// FNotifier's internal FFirst is now 1 (unlocked, not finalized)
end;
procedure TMycTestNotifierTests.TearDown;
begin
// DUnitX creates a new test fixture instance for each test method.
// Setup re-initializes FNotifier. FNotifier is a record, so its lifetime is managed
// by the fixture. If it were an object managing external unmanaged resources,
// Destroy would be critical here. Given Destroy's issues, we rely on Setup.
end;
// Test for: Correct execution of Destroy without assertion failures.
// With current buggy code, this test will FAIL due to EAssertionFailed in Destroy.
procedure TMycTestNotifierTests.Test01_DestroyExecutesWithoutErrors;
begin
// This call is expected to succeed without raising EAssertionFailed or other exceptions
// if TMycNotifyList.Destroy is implemented correctly.
FNotifier.Destroy;
Assert.IsTrue( True, 'FNotifier.Destroy completed without raising an exception.' );
end;
// Test for: Correct execution of Notify on an empty, locked, and finalized list.
// It should not cause an Access Violation or call the predicate.
// With current buggy code, this test will FAIL due to an Access Violation.
procedure TMycTestNotifierTests.Test02_NotifyOnFinalizedLockedEmptyListExecutesWithoutErrors;
var
predicateCallCount: Integer;
dummyPredicate: TPredicate<IMyTestInterface>;
begin
predicateCallCount := 0;
dummyPredicate := function( Item: IMyTestInterface ): Boolean
begin
Inc( predicateCallCount );
Result := True;
end;
FNotifier.Lock;
Assert.IsTrue( FNotifier.IsLocked, 'Notifier should be locked.' );
FNotifier.Finalize; // Internally, FFirst becomes 2 (locked & finalized state bits) if it was 0 after Lock
Assert.IsTrue( FNotifier.IsFinalized, 'Notifier should be finalized.' );
// In a corrected Notifier, this call should not cause an AV and not call the predicate.
FNotifier.Notify( dummyPredicate );
Assert.AreEqual( 0, predicateCallCount, 'Notify predicate should not have been called for an empty, finalized list.' );
Assert.IsTrue( True, 'FNotifier.Notify on finalized locked empty list completed without AV.' );
if FNotifier.IsLocked then // Release lock for subsequent operations or cleanup
begin
FNotifier.Release;
end;
end;
// Test for: Correct execution of UnadviseAll on an empty, locked, and finalized list.
// It should not cause an Access Violation.
// With current buggy code, this test will FAIL due to an Access Violation.
procedure TMycTestNotifierTests.Test03_UnadviseAllOnFinalizedLockedEmptyListExecutesWithoutErrors;
begin
FNotifier.Lock;
Assert.IsTrue( FNotifier.IsLocked, 'Notifier should be locked.' );
FNotifier.Finalize; // FFirst becomes 2 internally
Assert.IsTrue( FNotifier.IsFinalized, 'Notifier should be finalized.' );
// In a corrected Notifier, this call should not cause an AV.
FNotifier.UnadviseAll;
Assert.IsTrue( True, 'FNotifier.UnadviseAll on finalized locked empty list completed without AV.' );
if FNotifier.IsLocked then // Release lock
begin
FNotifier.Release;
end;
end;
// Test for: Basic Advise/Unadvise functionality (assumed to use FList).
// This test should PASS with the current code if FList handling is correct.
procedure TMycTestNotifierTests.Test04_AdviseUnadviseBasicFunctionality;
var
tag1, tag2: TMycNotifyList<IMyTestInterface>.TTag;
receiver1, receiver2: IMyTestInterface;
begin
receiver1 := TMyTestReceiver.Create( 1 );
receiver2 := TMyTestReceiver.Create( 2 );
FNotifier.Lock;
try
tag1 := FNotifier.Advise( receiver1 );
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag1, 'Tag1 should not be nil.' );
FNotifier.Unadvise( tag1 );
tag1 := FNotifier.Advise( receiver1 );
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag1, 'Tag1 should not be nil.' );
tag2 := FNotifier.Advise( receiver2 );
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag2, 'Tag2 should not be nil.' );
Assert.AreNotEqual( tag1, tag2, 'Tag1 and Tag2 should be different.' );
FNotifier.Unadvise( tag1 );
FNotifier.Unadvise( tag2 );
// Re-add and unadvise in different order
tag1 := FNotifier.Advise( receiver1 );
tag2 := FNotifier.Advise( receiver2 );
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag1 );
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag2 );
FNotifier.Unadvise( tag2 );
FNotifier.Unadvise( tag1 );
finally
FNotifier.Release;
end;
Assert.IsFalse( FNotifier.IsLocked, 'Notifier should be unlocked.' );
end;
// Test for: Notify calls advised items and can remove items based on the predicate.
// This test should PASS with the current code if FList handling in Notify is correct.
procedure TMycTestNotifierTests.Test05_NotifyCallsAdvisedItemsAndCanRemoveThem;
var
rcv1, rcv2, rcv3: TMyTestReceiver;
itemsProcessedCount: Integer;
begin
rcv1 := TMyTestReceiver.Create( 10 ); // Keep
rcv2 := TMyTestReceiver.Create( 20 ); // Remove
rcv3 := TMyTestReceiver.Create( 30 ); // Keep
FNotifier.Lock;
try
FNotifier.Advise( rcv1 );
FNotifier.Advise( rcv2 );
FNotifier.Advise( rcv3 );
itemsProcessedCount := 0;
FNotifier.Notify(
function( Item: IMyTestInterface ): Boolean
begin
Inc( itemsProcessedCount );
TMyTestReceiver( Item ).Foo;
Result := Item.GetValue <> 20; // Remove item with value 20
end
);
Assert.AreEqual( 3, itemsProcessedCount, 'Notify predicate called for all 3 items.' );
Assert.AreEqual( 1, rcv1.CallCount, 'Receiver1 called once.' );
Assert.AreEqual( 1, rcv2.CallCount, 'Receiver2 called once (before removal).' );
Assert.AreEqual( 1, rcv3.CallCount, 'Receiver3 called once.' );
// Reset counts and check again
rcv1.CallCount := 0;
rcv2.CallCount := 0; // Should remain 0 as it's removed
rcv3.CallCount := 0;
itemsProcessedCount := 0;
FNotifier.Notify(
function( Item: IMyTestInterface ): Boolean
begin
Inc( itemsProcessedCount );
TMyTestReceiver( Item ).Foo;
Result := True; // Keep remaining
end
);
Assert.AreEqual( 2, itemsProcessedCount, 'Notify predicate called for 2 remaining items.' );
Assert.AreEqual( 1, rcv1.CallCount, 'Receiver1 called again.' );
Assert.AreEqual( 0, rcv2.CallCount, 'Receiver2 (removed) not called again.' );
Assert.AreEqual( 1, rcv3.CallCount, 'Receiver3 called again.' );
finally
FNotifier.Release;
end;
// Cleanup remaining items (rcv1, rcv3)
FNotifier.Lock;
try
// This UnadviseAll should work on the remaining FList items.
// If the list becomes empty in a way that FFirst is misconfigured, it might still fail.
FNotifier.UnadviseAll;
finally
FNotifier.Release;
end;
end;
initialization
TDUnitX.RegisterTestFixture( TMycTestNotifierTests );
end.
+424
View File
@@ -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.
+302
View File
@@ -0,0 +1,302 @@
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;
tag: TMycNotifyList<IMyTestInterface>.TTag; // Tag is not used further in this test design
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
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 = 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.
+2 -1
View File
@@ -3,7 +3,8 @@ unit TestSignals;
interface
uses
DUnitX.TestFramework;
DUnitX.TestFramework,
Myc.Signals;
type
[TestFixture]