Notifier & Tests added
This commit is contained in:
+5
-2
@@ -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
@@ -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>
|
||||
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -3,7 +3,8 @@ unit TestSignals;
|
||||
interface
|
||||
|
||||
uses
|
||||
DUnitX.TestFramework;
|
||||
DUnitX.TestFramework,
|
||||
Myc.Signals;
|
||||
|
||||
type
|
||||
[TestFixture]
|
||||
|
||||
Reference in New Issue
Block a user