Files
MycLib/Test/TestNotifier.pas
2025-07-11 11:06:18 +02:00

264 lines
9.1 KiB
ObjectPascal

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's internal FFirst is now 1 (unlocked, not finalized)
FNotifier := Default(TMycNotifyList<IMyTestInterface>);
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.Finalize;
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: TMycNotifyList<IMyTestInterface>.TNotifyProc;
begin
predicateCallCount := 0;
dummyPredicate :=
function(const 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(const 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(const 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.