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; 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; 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.TTag; receiver1, receiver2: IMyTestInterface; begin receiver1 := TMyTestReceiver.Create( 1 ); receiver2 := TMyTestReceiver.Create( 2 ); FNotifier.Lock; try tag1 := FNotifier.Advise( receiver1 ); Assert.AreNotEqual( TMycNotifyList.TTag( nil ), tag1, 'Tag1 should not be nil.' ); FNotifier.Unadvise( tag1 ); tag1 := FNotifier.Advise( receiver1 ); Assert.AreNotEqual( TMycNotifyList.TTag( nil ), tag1, 'Tag1 should not be nil.' ); tag2 := FNotifier.Advise( receiver2 ); Assert.AreNotEqual( TMycNotifyList.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.TTag( nil ), tag1 ); Assert.AreNotEqual( TMycNotifyList.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.