diff --git a/Src/Myc.Core.Signals.pas b/Src/Myc.Core.Signals.pas index b8b5fb6..07d5cbf 100644 --- a/Src/Myc.Core.Signals.pas +++ b/Src/Myc.Core.Signals.pas @@ -212,6 +212,7 @@ function TMycLatch.Subscribe(Subscriber: IMycSubscriber): Pointer; var alreadySet: Boolean; begin + Result := nil; if not Assigned(Subscriber) then exit; @@ -332,7 +333,7 @@ end; function TMycDirty.Subscribe(Subscriber: IMycSubscriber): Pointer; begin if not Assigned(Subscriber) then - exit; + exit(nil); // For TMycDirty, we always add the subscriber and then check if we need to notify immediately. // Ref counting for the subscriber interface is assumed to be handled by TMycNotifyList.Advise/Unadvise. diff --git a/Src/Myc.Core.Tasks.pas b/Src/Myc.Core.Tasks.pas index 9f57d45..546a33e 100644 --- a/Src/Myc.Core.Tasks.pas +++ b/Src/Myc.Core.Tasks.pas @@ -4,7 +4,7 @@ interface uses System.SysUtils, System.Classes, System.SyncObjs, - Myc.Core.Atomic, Myc.TaskManager, Myc.Signals; // Myc.Signals now requires direct use of TMycLatch static members + Myc.Core.Atomic, Myc.TaskManager, Myc.Signals; type IMycTaskFactory = interface( IMycTaskManager ) @@ -85,13 +85,13 @@ type // Initialize global TaskManager class procedure AquireTaskManager; class procedure ReleaseTaskManager; + + property ThreadsRunning: Integer read FThreadsRunning; + property WorkThreads: TArray read FWorkThreads; end; implementation -uses - Myc.Core.Signals; - type TMycPendingJob = class(TInterfacedObject, IMycSubscriber) private @@ -357,7 +357,7 @@ begin if lock = nil then lock := TSemaphore.Create(nil, 0, 1, ''); try - var subscription := State.Subscribe(TMycTaskWait.Create(lock)); + {var subscription :=} State.Subscribe(TMycTaskWait.Create(lock)); lock.Acquire; finally FWaitSemaphores.Push(lock); diff --git a/Src/Myc.Signals.pas b/Src/Myc.Signals.pas index 4b8fa98..245bf17 100644 --- a/Src/Myc.Signals.pas +++ b/Src/Myc.Signals.pas @@ -30,7 +30,6 @@ type private FState: IMycState; FTag: Pointer; // Tag identifying this subscription within the notifier list. - function GetState: IMycState; constructor Create( const AState: IMycState; ATag: Pointer ); public class operator Initialize( out Dest: TSubscription ); @@ -123,11 +122,6 @@ begin FTag := nil; end; -function TState.TSubscription.GetState: IMycState; -begin - Result := FState -end; - class operator TState.TSubscription.Initialize( out Dest: TSubscription ); begin Dest.FState := TState.Null; diff --git a/Src/Myc.TaskManager.pas b/Src/Myc.TaskManager.pas index 0b258cc..7af11e4 100644 --- a/Src/Myc.TaskManager.pas +++ b/Src/Myc.TaskManager.pas @@ -57,7 +57,8 @@ end; function TMycExecMock.Notify: Boolean; begin - if Assigned(FProc) then + Result := Assigned(FProc); + if Result then begin FProc(); FProc := nil; diff --git a/Src/Myc.Test.Core.Atomic.pas b/Src/Myc.Test.Core.Atomic.pas new file mode 100644 index 0000000..a71a5a7 --- /dev/null +++ b/Src/Myc.Test.Core.Atomic.pas @@ -0,0 +1,498 @@ +unit Myc.Test.Core.Atomic; + +interface + +uses + System.SysUtils, + Winapi.Windows, // For PSListEntry in helper records for TSList tests + DUnitX.TestFramework, + Myc.Core.Atomic; + +const + // Alignment constants from Myc.Core.Atomic.pas, used for verification + AlignmentBoundary = 16; + AlignmentMask = AlignmentBoundary - 1; + +type + // Helper record to manage data for TSList entries in tests + PTestSListEntryData = ^TTestSListEntryData; + TTestSListEntryData = record + Entry: TSListEntry; // The SList entry structure + ID: Integer; // Sample data associated with the entry + end; + + [TestFixture] + TTestSList = class(TObject) + private + FList: PSList; // The SList instance being tested + FEntries: TArray; // To keep track of allocated entries for cleanup + + // Helper to allocate an aligned TTestSListEntryData record + function AllocEntryData(Id: Integer): PTestSListEntryData; + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + [Test] + procedure TestCreateAndFree; + [Test] + procedure TestInitCalledByCreate; + [Test] + procedure TestPushPop_SingleEntry; + [Test] + procedure TestPushPop_MultipleEntries_LIFO; + [Test] + procedure TestPop_FromEmptyList_ReturnsNil; + [Test] + procedure TestQueryDepth_EmptyList_ReturnsZero; + [Test] + procedure TestQueryDepth_WithEntries; + [Test] + procedure TestPush_RequiresAlignedEntries; + end; + + [TestFixture] + TTestMycAtomicStack_Integer = class(TObject) + private + FStack: TMycAtomicStack; // The atomic stack record; Initialize/Finalize are auto-managed + public + [Setup] + procedure Setup; // Record Initialize operator is called by the compiler + [TearDown] + procedure TearDown; // Record Finalize operator is called by the compiler + + [Test] + procedure TestInitialization_FSListIsCreated; + [Test] + procedure TestPushPop_SingleInteger; + [Test] + procedure TestPushPop_MultipleIntegers_LIFO; + [Test] + procedure TestPop_FromEmptyStack_ReturnsDefaultInteger; + [Test] + procedure TestTryPop_FromEmptyStack_ReturnsFalse; + [Test] + procedure TestTryPop_WithInteger_ReturnsTrueAndCorrectValue; + [Test] + procedure TestClear_EmptiesStack; + [Test] + procedure TestClear_OnEmptyStack; + end; + + [TestFixture] + TTestMycAtomicStack_String = class(TObject) + private + FStack: TMycAtomicStack; // The atomic stack record for strings + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + [Test] + procedure TestInitialization_FSListIsCreated; + [Test] + procedure TestPushPop_SingleString; + [Test] + procedure TestPushPop_MultipleStrings_LIFO; + [Test] + procedure TestPop_FromEmptyStack_ReturnsDefaultString; + [Test] + procedure TestTryPop_FromEmptyStack_ReturnsFalse; + [Test] + procedure TestTryPop_WithString_ReturnsTrueAndCorrectValue; + [Test] + procedure TestClear_EmptiesStackAndManagesStrings; + end; + +implementation + +uses System.TypInfo; + +{ TTestSList } + +function TTestSList.AllocEntryData(Id: Integer): PTestSListEntryData; +begin + // Allocate memory for the helper record, ensuring it's aligned + GetMemAligned(Pointer(Result), SizeOf(TTestSListEntryData)); + // Ensure the allocated memory is aligned as expected by SList functions + Assert.IsTrue((NativeUInt(Result) and AlignmentMask) = 0, 'AllocEntryData did not return an aligned pointer for the record.'); + Assert.IsTrue((NativeUInt(@Result.Entry) and AlignmentMask) = 0, 'AllocEntryData.Entry field is not aligned.'); + FillChar(Result^, SizeOf(TTestSListEntryData), 0); // Initialize memory + Result.ID := Id; + // Add to internal list for cleanup in TearDown + SetLength(FEntries, Length(FEntries) + 1); + FEntries[High(FEntries)] := Result; +end; + +procedure TTestSList.Setup; +begin + FList := nil; + SetLength(FEntries, 0); // Reset entry tracking +end; + +procedure TTestSList.TearDown; +var + entryNode: PTestSListEntryData; + tempList: PSList; +begin + // Clean up any remaining entries in the list to prevent memory leaks + // especially if a test failed mid-operation. + if FList <> nil then + begin + while FList.Pop <> nil do + begin + // Popping to empty the list if not already empty + end; + tempList := FList; // Store to call Free + FList := nil; // Prevent using FList after Free + tempList.Free; // Free the TSList structure itself + end; + + // Free all allocated PTestSListEntryData + for entryNode in FEntries do + begin + var P:= entryNode; + FreeMemAligned(P); + end; + SetLength(FEntries, 0); +end; + +procedure TTestSList.TestCreateAndFree; +begin + Assert.IsNull(FList, 'FList should be nil initially.'); + FList := TSList.Create; // TSList.Create allocates and initializes the list + Assert.IsNotNull(FList, 'TSList.Create should return a non-nil PSList.'); + // FList.Free is called in TearDown +end; + +procedure TTestSList.TestInitCalledByCreate; +var + depth: Integer; +begin + FList := TSList.Create; // Create also calls Init + Assert.IsNotNull(FList, 'TSList.Create failed.'); + // A freshly initialized SList should have a depth of 0. + depth := FList.QueryDepth; + Assert.AreEqual(0, depth, 'QueryDepth on new list should be 0.'); +end; + +procedure TTestSList.TestPushPop_SingleEntry; +var + entryData: PTestSListEntryData; + poppedEntry: PSListEntry; +begin + FList := TSList.Create; + entryData := AllocEntryData(100); // Allocate an aligned entry wrapper + + FList.Push(@entryData.Entry); // Push the address of the TSListEntry field + Assert.AreEqual(1, FList.QueryDepth, 'QueryDepth after one push should be 1.'); + + poppedEntry := FList.Pop; + Assert.IsNotNull(poppedEntry, 'Pop should return a non-nil entry.'); + // Verify that the popped entry is the one we pushed + Assert.AreEqual(Pointer(@entryData.Entry), Pointer(poppedEntry), 'Popped entry is not the same as pushed entry.'); + Assert.AreEqual(0, FList.QueryDepth, 'QueryDepth after pop should be 0.'); + + // The poppedEntry still points to memory managed by AllocEntryData, + // which will be freed in TearDown. +end; + +procedure TTestSList.TestPushPop_MultipleEntries_LIFO; +var + entryData1, entryData2, entryData3: PTestSListEntryData; + poppedEntry: PSListEntry; +begin + FList := TSList.Create; + entryData1 := AllocEntryData(10); + entryData2 := AllocEntryData(20); + entryData3 := AllocEntryData(30); + + FList.Push(@entryData1.Entry); // Pushed first: 10 + FList.Push(@entryData2.Entry); // Pushed second: 20 + FList.Push(@entryData3.Entry); // Pushed third: 30 + Assert.AreEqual(3, FList.QueryDepth, 'QueryDepth after three pushes should be 3.'); + + // Pop should follow LIFO (Last-In, First-Out) + poppedEntry := FList.Pop; // Should be entryData3 (ID 30) + Assert.IsNotNull(poppedEntry, 'First pop should return a non-nil entry.'); + Assert.AreEqual(Pointer(@entryData3.Entry), Pointer(poppedEntry), 'First popped entry mismatch (LIFO).'); + Assert.AreEqual(2, FList.QueryDepth, 'QueryDepth after first pop should be 2.'); + + poppedEntry := FList.Pop; // Should be entryData2 (ID 20) + Assert.IsNotNull(poppedEntry, 'Second pop should return a non-nil entry.'); + Assert.AreEqual(Pointer(@entryData2.Entry), Pointer(poppedEntry), 'Second popped entry mismatch (LIFO).'); + Assert.AreEqual(1, FList.QueryDepth, 'QueryDepth after second pop should be 1.'); + + poppedEntry := FList.Pop; // Should be entryData1 (ID 10) + Assert.IsNotNull(poppedEntry, 'Third pop should return a non-nil entry.'); + Assert.AreEqual(Pointer(@entryData1.Entry), Pointer(poppedEntry), 'Third popped entry mismatch (LIFO).'); + Assert.AreEqual(0, FList.QueryDepth, 'QueryDepth after third pop should be 0.'); +end; + +procedure TTestSList.TestPop_FromEmptyList_ReturnsNil; +var + poppedEntry: PSListEntry; +begin + FList := TSList.Create; + poppedEntry := FList.Pop; // Pop from an empty list + Assert.IsNull(poppedEntry, 'Pop from empty list should return nil.'); +end; + +procedure TTestSList.TestQueryDepth_EmptyList_ReturnsZero; +begin + FList := TSList.Create; + Assert.AreEqual(0, FList.QueryDepth, 'QueryDepth on an empty list should be 0.'); +end; + +procedure TTestSList.TestQueryDepth_WithEntries; +var + entryData1, entryData2: PTestSListEntryData; +begin + FList := TSList.Create; + entryData1 := AllocEntryData(1); + entryData2 := AllocEntryData(2); + + Assert.AreEqual(0, FList.QueryDepth, 'Initial QueryDepth should be 0.'); + FList.Push(@entryData1.Entry); + Assert.AreEqual(1, FList.QueryDepth, 'QueryDepth after one push should be 1.'); + FList.Push(@entryData2.Entry); + Assert.AreEqual(2, FList.QueryDepth, 'QueryDepth after two pushes should be 2.'); + + FList.Pop; + Assert.AreEqual(1, FList.QueryDepth, 'QueryDepth after one pop should be 1.'); + FList.Pop; + Assert.AreEqual(0, FList.QueryDepth, 'QueryDepth after two pops should be 0.'); +end; + +procedure TTestSList.TestPush_RequiresAlignedEntries; +var + entryData: PTestSListEntryData; +begin + FList := TSList.Create; + // AllocEntryData ensures alignment. The assertion is within AllocEntryData + // and TSList.Push itself has an Assert for entry alignment. + // This test confirms that using an aligned entry from AllocEntryData works. + entryData := AllocEntryData(123); + // This should not raise an assertion error from TSList.Push. + Assert.WillNotRaise(procedure + begin + FList.Push(@entryData.Entry); + end, nil, 'Pushing an aligned entry should not raise an exception/assertion.'); + Assert.AreEqual(1, FList.QueryDepth, 'QueryDepth should be 1 after pushing an aligned entry.'); +end; + +{ TTestMycAtomicStack_Integer } + +procedure TTestMycAtomicStack_Integer.Setup; +begin + // FStack is a record, its Initialize class operator is called by the compiler + // when the FStack variable (fixture member) is initialized. + // We can add a check here to ensure FSList inside FStack is created. +end; + +procedure TTestMycAtomicStack_Integer.TearDown; +begin + // FStack's Finalize class operator is called by the compiler when the fixture + // is destroyed. This operator calls FStack.Clear. + // We can verify Clear's behavior in dedicated tests. +end; + +procedure TTestMycAtomicStack_Integer.TestInitialization_FSListIsCreated; +begin + // The Initialize operator should have created FSList. + // Accessing FSList directly is not possible as it's private to TMycAtomicStack. + // We test this indirectly: if FSList wasn't created, Push/Pop would likely fail. + // A simple Pop should not crash, even if it returns default. + Assert.AreEqual(Default(Integer), FStack.Pop, 'Pop on newly initialized stack should return default.'); +end; + +procedure TTestMycAtomicStack_Integer.TestPushPop_SingleInteger; +var + value, poppedValue: Integer; +begin + value := 123; + FStack.Push(value); + + poppedValue := FStack.Pop; + Assert.AreEqual(value, poppedValue, 'Popped value does not match pushed value.'); + Assert.AreEqual(Default(Integer), FStack.Pop, 'Stack should be empty after one pop.'); +end; + +procedure TTestMycAtomicStack_Integer.TestPushPop_MultipleIntegers_LIFO; +var + val1, val2, val3: Integer; +begin + val1 := 10; + val2 := 20; + val3 := 30; + + FStack.Push(val1); // Pushed first + FStack.Push(val2); // Pushed second + FStack.Push(val3); // Pushed third + + Assert.AreEqual(val3, FStack.Pop, 'First pop should be the last pushed value (LIFO).'); + Assert.AreEqual(val2, FStack.Pop, 'Second pop should be the middle value (LIFO).'); + Assert.AreEqual(val1, FStack.Pop, 'Third pop should be the first pushed value (LIFO).'); + Assert.AreEqual(Default(Integer), FStack.Pop, 'Stack should be empty after all pops.'); +end; + +procedure TTestMycAtomicStack_Integer.TestPop_FromEmptyStack_ReturnsDefaultInteger; +begin + Assert.AreEqual(Default(Integer), FStack.Pop, 'Pop from empty stack should return Default(Integer).'); +end; + +procedure TTestMycAtomicStack_Integer.TestTryPop_FromEmptyStack_ReturnsFalse; +var + value: Integer; + success: Boolean; +begin + value := 999; // Initial non-default value + success := FStack.TryPop(value); + Assert.IsFalse(success, 'TryPop on empty stack should return False.'); + // Per TryPop's contract, Item is Default(T) if unsuccessful + Assert.AreEqual(Default(Integer), value, 'Value should be Default(Integer) after failed TryPop.'); +end; + +procedure TTestMycAtomicStack_Integer.TestTryPop_WithInteger_ReturnsTrueAndCorrectValue; +var + pushedValue, poppedValue: Integer; + success: Boolean; +begin + pushedValue := 777; + FStack.Push(pushedValue); + + poppedValue := 0; // Initialize to a different value + success := FStack.TryPop(poppedValue); + Assert.IsTrue(success, 'TryPop should return True when stack is not empty.'); + Assert.AreEqual(pushedValue, poppedValue, 'TryPop did not return the correct value.'); + + // Stack should be empty now + success := FStack.TryPop(poppedValue); + Assert.IsFalse(success, 'TryPop on now-empty stack should return False.'); +end; + +procedure TTestMycAtomicStack_Integer.TestClear_EmptiesStack; +begin + FStack.Push(1); + FStack.Push(2); + FStack.Push(3); + + FStack.Clear; // Explicitly call Clear + + Assert.AreEqual(Default(Integer), FStack.Pop, 'Stack should be empty after Clear.'); + // TryPop should also reflect this + var value: Integer; + Assert.IsFalse(FStack.TryPop(value), 'TryPop after Clear should return False.'); +end; + +procedure TTestMycAtomicStack_Integer.TestClear_OnEmptyStack; +begin + // Clearing an already empty stack should not cause issues + Assert.WillNotRaise(procedure + begin + FStack.Clear; + end, nil, 'Clear on an empty stack should not raise an exception.'); + Assert.AreEqual(Default(Integer), FStack.Pop, 'Stack should remain empty after Clear on empty stack.'); +end; + +{ TTestMycAtomicStack_String } + +procedure TTestMycAtomicStack_String.Setup; +begin + // Compiler calls Initialize for FStack +end; + +procedure TTestMycAtomicStack_String.TearDown; +begin + // Compiler calls Finalize for FStack (which calls Clear) +end; + +procedure TTestMycAtomicStack_String.TestInitialization_FSListIsCreated; +begin + Assert.AreEqual(Default(string), FStack.Pop, 'Pop on newly initialized string stack should return default string.'); +end; + +procedure TTestMycAtomicStack_String.TestPushPop_SingleString; +var + value, poppedValue: string; +begin + value := 'TestString1'; + FStack.Push(value); + + poppedValue := FStack.Pop; + Assert.AreEqual(value, poppedValue, 'Popped string does not match pushed string.'); + Assert.AreEqual(Default(string), FStack.Pop, 'String stack should be empty after one pop.'); +end; + +procedure TTestMycAtomicStack_String.TestPushPop_MultipleStrings_LIFO; +var + val1, val2, val3: string; +begin + val1 := 'FirstStr'; + val2 := 'SecondStr'; + val3 := 'ThirdStr'; + + FStack.Push(val1); + FStack.Push(val2); + FStack.Push(val3); + + Assert.AreEqual(val3, FStack.Pop, 'First popped string mismatch (LIFO).'); + Assert.AreEqual(val2, FStack.Pop, 'Second popped string mismatch (LIFO).'); + Assert.AreEqual(val1, FStack.Pop, 'Third popped string mismatch (LIFO).'); + Assert.AreEqual(Default(string), FStack.Pop, 'String stack should be empty after all pops.'); +end; + +procedure TTestMycAtomicStack_String.TestPop_FromEmptyStack_ReturnsDefaultString; +begin + Assert.AreEqual(Default(string), FStack.Pop, 'Pop from empty string stack should return Default(string).'); +end; + +procedure TTestMycAtomicStack_String.TestTryPop_FromEmptyStack_ReturnsFalse; +var + value: string; + success: Boolean; +begin + value := 'InitialValue'; // Non-default initial string + success := FStack.TryPop(value); + Assert.IsFalse(success, 'TryPop on empty string stack should return False.'); + Assert.AreEqual(Default(string), value, 'String value should be Default(string) after failed TryPop.'); +end; + +procedure TTestMycAtomicStack_String.TestTryPop_WithString_ReturnsTrueAndCorrectValue; +var + pushedValue, poppedValue: string; + success: Boolean; +begin + pushedValue := 'AnotherTest'; + FStack.Push(pushedValue); + + poppedValue := ''; // Initialize to empty string + success := FStack.TryPop(poppedValue); + Assert.IsTrue(success, 'TryPop should return True when string stack is not empty.'); + Assert.AreEqual(pushedValue, poppedValue, 'TryPop did not return the correct string value.'); + + success := FStack.TryPop(poppedValue); + Assert.IsFalse(success, 'TryPop on now-empty string stack should return False.'); +end; + +procedure TTestMycAtomicStack_String.TestClear_EmptiesStackAndManagesStrings; +begin + FStack.Push('StringA'); + FStack.Push('StringB'); + FStack.Push('StringC'); + + FStack.Clear; // Clear should handle string deallocation if necessary (done by Default(T) and FreeMemAligned of item) + + Assert.AreEqual(Default(string), FStack.Pop, 'String stack should be empty after Clear.'); + var value: string; + Assert.IsFalse(FStack.TryPop(value), 'TryPop after Clear on string stack should return False.'); +end; + +initialization + // Register an instance of this test case. + // Other test logic, such as Self点Test.RegisterTest(TTestMyClass), + // is not needed with DUnitX attributes. +end. diff --git a/Src/Myc.Test.Core.Lazy.pas b/Src/Myc.Test.Core.Lazy.pas index 840c3be..6908e63 100644 --- a/Src/Myc.Test.Core.Lazy.pas +++ b/Src/Myc.Test.Core.Lazy.pas @@ -411,7 +411,6 @@ begin funcLazyObj := TMycFuncLazy.Create(sourceDirty.State, function: Integer begin Result := 1; end); Assert.IsTrue(funcLazyObj.Pop(tempVal), 'Initial Pop should succeed'); funcLazyObj.Destroy; - funcLazyObj := nil; Assert.WillNotRaise( procedure begin diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index f7b3748..cb820d2 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -15,8 +15,6 @@ uses {$ENDIF } DUnitX.TestFramework, TestNotifier in 'TestNotifier.pas', - TestSList in 'TestSList.pas', - TestStack in 'TestStack.pas' {/TestNotifier_Threading in 'TestNotifier_Threading.pas',}, TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',}, TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas', TestSignals_Latch in 'TestSignals_Latch.pas', @@ -32,7 +30,8 @@ uses Myc.Lazy in '..\Src\Myc.Lazy.pas', Myc.Core.Lazy in '..\Src\Myc.Core.Lazy.pas', Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas', - Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas'; + Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas', + Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas'; { keep comment here to protect the following conditional from being removed by the IDE when adding a unit } {$IFNDEF TESTINSIGHT} diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index f58aab9..999941b 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -110,10 +110,6 @@ $(PreBuildEvent)]]> MainSource - - -
/TestNotifier_Threading in 'TestNotifier_Threading.pas',
-
/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',
@@ -132,6 +128,7 @@ $(PreBuildEvent)]]> + Base diff --git a/Test/TestNotifier_Threading.pas b/Test/TestNotifier_Threading.pas index 3cce58c..796e081 100644 --- a/Test/TestNotifier_Threading.pas +++ b/Test/TestNotifier_Threading.pas @@ -127,7 +127,7 @@ begin // Acquire lock before calling Advise FOwnerFixture.FNotifier.Lock; try - var tag := FOwnerFixture.FNotifier.Advise(FReceiversToAdd[i]); + {var 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 diff --git a/Test/TestSList.pas b/Test/TestSList.pas deleted file mode 100644 index 0403179..0000000 --- a/Test/TestSList.pas +++ /dev/null @@ -1,415 +0,0 @@ -unit TestSList; - -interface - -uses - DUnitX.TestFramework, - Myc.Core.Atomic, // The unit to be tested. TSListEntry and PSListEntry are expected from here. - System.SysUtils, // For NativeUInt, FillChar, Format static class, etc. - System.SyncObjs, // TInterlocked - Winapi.Windows, // For general Windows API types if needed by Myc.Heap for TSListHeader. - System.Generics.Collections; // For TThreadedQueue, TDictionary - -type - // Test data structure for TSList items - PTestListItem = ^TTestListItem; - TTestListItem = record - ListEntry: TSListEntry; // Using TSListEntry from Myc.Heap.pas - ID: Integer; - end; - - [TestFixture] - TMycTestSList = class - private - const TestAlignmentMask = 15; // Corresponds to AlignmentBoundary = 16 in Myc.Heap.pas - - // Helpers made static to be callable from anonymous threads - class function CreateTestListItem(ID: Integer): PTestListItem; static; - class procedure FreeTestListItem(var Item: PTestListItem); static; - - public - [Setup] - procedure Setup; - [TearDown] - procedure TearDown; - - // Alignment Stress Test - [Test] - procedure TestStressAlignmentAndDataIntegrity; - - // --- TSList Single-Threaded Tests --- - [Test] - procedure TestTSList_CreateAndFree; - [Test] - procedure TestTSList_PushPopSingleEntry; - [Test] - procedure TestTSList_PushPopMultipleEntries_LIFO; - [Test] - procedure TestTSList_QueryDepth; - [Test] - procedure TestTSList_PopFromEmptyList; - - // --- TSList Parallel Access Test --- - [Test] - procedure TestTSList_ParallelPushPop; - end; - -implementation - -uses - System.Math, // For Random and Randomize - System.Classes, // For TThread - System.Types; // For TWaitResult - -// --- Helper Implementations (static) --- - -class function TMycTestSList.CreateTestListItem(ID: Integer): PTestListItem; -begin - GetMemAligned(Result, SizeOf(TTestListItem)); - Assert.IsNotNull(Result, 'Failed to allocate memory for TestListItem.'); // Replaced Format string - FillChar(Result^, SizeOf(TTestListItem), 0); - Result.ID := ID; -end; - -class procedure TMycTestSList.FreeTestListItem(var Item: PTestListItem); -var - tempPtr: Pointer; -begin - if Item <> nil then - begin - tempPtr := Item; - FreeMemAligned(tempPtr); - Item := nil; - end; -end; - -// --- Fixture Setup/TearDown --- - -procedure TMycTestSList.Setup; -begin - Randomize; -end; - -procedure TMycTestSList.TearDown; -begin -end; - -// --- Alignment Stress Test Implementation --- - -procedure TMycTestSList.TestStressAlignmentAndDataIntegrity; -const - NumIterations = 300000; - MaxBlockSize = 1024 * 4; -var - i: Integer; - sizeToAllocate: System.NativeUInt; - ptr: Pointer; - bytePtr: System.PByte; // Variable renamed from pByte - j: System.NativeUInt; - fillValue: Byte; -begin - for i := 1 to NumIterations do - begin - case i mod 10 of - 0: sizeToAllocate := 1; - 1: sizeToAllocate := TestAlignmentMask; - 2: sizeToAllocate := TestAlignmentMask + 1; - 3: sizeToAllocate := TestAlignmentMask + 2; - 4: sizeToAllocate := 0; - 5: sizeToAllocate := MaxBlockSize div 2; - 6: sizeToAllocate := MaxBlockSize; - else - sizeToAllocate := System.NativeUInt(Random(MaxBlockSize -1) + 1); - end; - - ptr := nil; - try - GetMemAligned(ptr, sizeToAllocate); - if sizeToAllocate = 0 then - begin - Assert.IsTrue(True, 'Zero-size allocation processed.'); // Replaced Format string - end - else if ptr = nil then - begin - Assert.Fail('GetMemAligned returned nil for non-zero size.'); // Replaced Format string - end - else - begin - Assert.AreEqual(System.NativeUInt(0), System.NativeUInt(ptr) and TestAlignmentMask, - 'Pointer not 16-byte aligned.'); // Replaced Format string - - fillValue := Byte(i mod 256); - System.FillChar(ptr^, sizeToAllocate, fillValue); - - bytePtr := System.PByte(ptr); - for j := 0 to sizeToAllocate - 1 do - begin - if bytePtr[j] <> fillValue then - begin - Assert.Fail('Data corruption detected.'); // Replaced Format string - Break; - end; - end; - end; - finally - FreeMemAligned(ptr); - end; - end; -end; - -// --- TSList Single-Threaded Test Implementations --- - -procedure TMycTestSList.TestTSList_CreateAndFree; -var - sListPtr: PSList; -begin - sListPtr := TSList.Create; - Assert.IsNotNull(sListPtr, 'TSList.Create should return a non-nil pointer.'); - Assert.AreEqual(0, sListPtr.QueryDepth, 'Newly created TSList should have a depth of 0.'); - sListPtr.Free; -end; - -procedure TMycTestSList.TestTSList_PushPopSingleEntry; -var - sListPtr: PSList; - item1: PTestListItem; - poppedInternalListEntry: PSListEntry; - poppedItem: PTestListItem; -begin - sListPtr := TSList.Create; - Assert.IsNotNull(sListPtr); - item1 := TMycTestSList.CreateTestListItem(101); - Assert.IsNotNull(item1); - sListPtr.Push(@item1.ListEntry); - Assert.AreEqual(1, sListPtr.QueryDepth, 'Depth should be 1 after one push.'); - poppedInternalListEntry := sListPtr.Pop; - Assert.IsNotNull(poppedInternalListEntry, 'Pop should return the pushed item, not nil.'); - poppedItem := PTestListItem(poppedInternalListEntry); - Assert.AreEqual(NativeUInt(item1), NativeUInt(poppedItem), 'Popped item should be the same as pushed item.'); - Assert.AreEqual(item1.ID, poppedItem.ID, 'Popped item ID mismatch.'); - Assert.AreEqual(0, sListPtr.QueryDepth, 'Depth should be 0 after popping the item.'); - TMycTestSList.FreeTestListItem(item1); - sListPtr.Free; -end; - -procedure TMycTestSList.TestTSList_PushPopMultipleEntries_LIFO; -const - NumItems = 5; -var - sListPtr: PSList; - items: array[1..NumItems] of PTestListItem; - poppedInternalListEntry: PSListEntry; - poppedItem: PTestListItem; - i: Integer; -begin - sListPtr := TSList.Create; - Assert.IsNotNull(sListPtr); - for i := 1 to NumItems do - begin - items[i] := TMycTestSList.CreateTestListItem(200 + i); - sListPtr.Push(@items[i].ListEntry); - Assert.AreEqual(i, sListPtr.QueryDepth, 'Depth incorrect after a push operation.'); // Replaced Format string - end; - Assert.AreEqual(NumItems, sListPtr.QueryDepth, 'Final depth after all pushes incorrect.'); - for i := NumItems downto 1 do - begin - poppedInternalListEntry := sListPtr.Pop; - Assert.IsNotNull(poppedInternalListEntry, 'Pop should return a non-nil item.'); // Replaced Format string - poppedItem := PTestListItem(poppedInternalListEntry); - Assert.AreEqual(NativeUInt(items[i]), NativeUInt(poppedItem), - 'LIFO order violated.'); // Replaced Format string - Assert.AreEqual(items[i].ID, poppedItem.ID, 'Popped item ID mismatch.'); - Assert.AreEqual(i - 1, sListPtr.QueryDepth, 'Depth incorrect after a pop operation.'); // Replaced Format string - end; - Assert.AreEqual(0, sListPtr.QueryDepth, 'Depth should be 0 after all items are popped.'); - for i := 1 to NumItems do - begin - TMycTestSList.FreeTestListItem(items[i]); - end; - sListPtr.Free; -end; - -procedure TMycTestSList.TestTSList_QueryDepth; -var - sListPtr: PSList; - item1, item2: PTestListItem; -begin - sListPtr := TSList.Create; - Assert.IsNotNull(sListPtr); - Assert.AreEqual(0, sListPtr.QueryDepth, 'Initial depth should be 0.'); - item1 := TMycTestSList.CreateTestListItem(301); - sListPtr.Push(@item1.ListEntry); - Assert.AreEqual(1, sListPtr.QueryDepth, 'Depth should be 1 after one push.'); - item2 := TMycTestSList.CreateTestListItem(302); - sListPtr.Push(@item2.ListEntry); - Assert.AreEqual(2, sListPtr.QueryDepth, 'Depth should be 2 after two pushes.'); - sListPtr.Pop; - Assert.AreEqual(1, sListPtr.QueryDepth, 'Depth should be 1 after one pop.'); - sListPtr.Pop; - Assert.AreEqual(0, sListPtr.QueryDepth, 'Depth should be 0 after two pops.'); - TMycTestSList.FreeTestListItem(item1); - TMycTestSList.FreeTestListItem(item2); - sListPtr.Free; -end; - -procedure TMycTestSList.TestTSList_PopFromEmptyList; -var - sListPtr: PSList; - poppedInternalListEntry: PSListEntry; -begin - sListPtr := TSList.Create; - Assert.IsNotNull(sListPtr); - Assert.AreEqual(0, sListPtr.QueryDepth, 'Initial depth should be 0.'); - poppedInternalListEntry := sListPtr.Pop; - Assert.IsNull(poppedInternalListEntry, 'Pop from an empty list should return nil.'); - Assert.AreEqual(0, sListPtr.QueryDepth, 'Depth should still be 0 after pop from empty.'); - sListPtr.Free; -end; - -// --- TSList Parallel Access Test Implementation --- -procedure TMycTestSList.TestTSList_ParallelPushPop; -const - NumThreads = 12; - OperationsPerThread = 50000; - QueueCapacityFactor = 2; // Factor to ensure log queues have enough space -var - threads: array of TThread; // TThread from System.Classes - i: Integer; - sharedSList: PSList; - pushedIDs: TThreadedQueue; - poppedIDs: TThreadedQueue; - globalItemID: Integer; - pushedItemsFinal: TDictionary; - currentPushedID: Integer; // Renamed from poppedItemValue for clarity in its context - currentPoppedID: Integer; // Renamed from poppedItemValue for clarity in its context - waitResult: TWaitResult; - remainingItem: PTestListItem; - remainingInternalEntry: PSListEntry; - logQueueCapacity: Integer; -begin - sharedSList := TSList.Create; - Assert.IsNotNull(sharedSList, 'Failed to create shared TSList for parallel test.'); - - logQueueCapacity := NumThreads * OperationsPerThread * QueueCapacityFactor; - pushedIDs := TThreadedQueue.Create(logQueueCapacity, INFINITE, 0); // PopTimeout = 0 - poppedIDs := TThreadedQueue.Create(logQueueCapacity, INFINITE, 0); // PopTimeout = 0 - globalItemID := 0; - - SetLength(threads, NumThreads); - - for i := 0 to High(threads) do - begin - threads[i] := TThread.CreateAnonymousThread( - procedure - var - j: Integer; - item: PTestListItem; - poppedInternalEntry: PSListEntry; - itemID: Integer; - actionRand: Double; - pushLogResult: TWaitResult; // Renamed from pushResult for clarity - begin - for j := 1 to OperationsPerThread do - begin - actionRand := Random; - if actionRand < 0.5 then // Attempt to Push - begin - itemID := TInterlocked.Increment(globalItemID); // TInterlocked from System.SysUtils or System - item := TMycTestSList.CreateTestListItem(itemID); - if item <> nil then - begin - sharedSList.Push(@item.ListEntry); - pushLogResult := pushedIDs.PushItem(itemID); // Use PushItem for TThreadedQueue - Assert.AreEqual(TWaitResult.wrSignaled, pushLogResult, 'Failed to push item to pushedIDs logging queue.'); - end; - end - else // Attempt to Pop - begin - poppedInternalEntry := sharedSList.Pop; - if poppedInternalEntry <> nil then - begin - item := PTestListItem(poppedInternalEntry); - pushLogResult := poppedIDs.PushItem(item.ID); // Use PushItem for TThreadedQueue - Assert.AreEqual(TWaitResult.wrSignaled, pushLogResult, - 'Failed to push item ID to poppedIDs logging queue.'); // Replaced Format string - TMycTestSList.FreeTestListItem(item); - end; - end; - if j mod (OperationsPerThread div 10) = 0 then // Occasional sleep - TThread.Sleep(1); // TThread.Sleep from System.Classes - end; - end); - threads[i].FreeOnTerminate := false; - end; - - for i := 0 to High(threads) do - threads[i].Start; - - for i := 0 to High(threads) do - begin - threads[i].WaitFor; - end; - - for i := 0 to High(threads) do - threads[i].Free; - - while True do - begin - remainingInternalEntry := sharedSList.Pop; - if remainingInternalEntry = nil then Break; - - remainingItem := PTestListItem(remainingInternalEntry); - waitResult := poppedIDs.PushItem(remainingItem.ID); // Use PushItem - Assert.AreEqual(TWaitResult.wrSignaled, waitResult, - 'Failed to push remaining item ID to poppedIDs during drain.'); // Replaced Format string - TMycTestSList.FreeTestListItem(remainingItem); - end; - - Assert.AreEqual(0, sharedSList.QueryDepth, 'TSList should be empty after all operations and draining.'); - - - Assert.AreEqual(pushedIDs.TotalItemsPushed, poppedIDs.TotalItemsPushed, // Compare total items PUSHED to each log queue - 'Mismatch in total logged pushed and popped items.'); // Replaced Format string - - pushedItemsFinal := TDictionary.Create; - try - // Drain pushedIDs queue using PopItem with timeout = 0 behavior - var qz: Integer; - while pushedIDs.PopItem(qz, currentPushedID) = TWaitResult.wrSignaled do - begin - if pushedItemsFinal.ContainsKey(currentPushedID) then - pushedItemsFinal.Items[currentPushedID] := pushedItemsFinal.Items[currentPushedID] + 1 - else - pushedItemsFinal.Add(currentPushedID, 1); - if qz=0 then break; - end; - - // Drain poppedIDs queue using PopItem with timeout = 0 behavior - while poppedIDs.PopItem(qz, currentPoppedID) = TWaitResult.wrSignaled do - begin - Assert.IsTrue(pushedItemsFinal.ContainsKey(currentPoppedID), 'Item ID logged as popped but never as pushed.'); // Replaced Format string - if pushedItemsFinal.ContainsKey(currentPoppedID) then // Re-check for safety before decrementing - begin - pushedItemsFinal.Items[currentPoppedID] := pushedItemsFinal.Items[currentPoppedID] - 1; - end; - if qz=0 then break; - end; - - // Verify that all pushed items were accounted for (counts should be zero) - for currentPushedID in pushedItemsFinal.Keys do - begin - Assert.AreEqual(0, pushedItemsFinal.Items[currentPushedID], 'Item count mismatch. Final count in reconciliation dictionary is not zero.'); - end; - finally - pushedItemsFinal.Free; - end; - - // Final cleanup - sharedSList.Free; - pushedIDs.Free; - poppedIDs.Free; -end; - -initialization - TDUnitX.RegisterTestFixture(TMycTestSList); -end. diff --git a/Test/TestStack.pas b/Test/TestStack.pas deleted file mode 100644 index 1dec766..0000000 --- a/Test/TestStack.pas +++ /dev/null @@ -1,514 +0,0 @@ -unit TestStack; - -interface - -uses - DUnitX.TestFramework, - System.SysUtils; // For GUIDToString if used in messages, and other utils - -type - // Helper record type for testing generic capabilities (as before) - TTestRecord = record - ID: Integer; - Name: string; - Value: Double; - end; - - // --- Interface and implementing class for interface tests --- - ITestInterface = interface - ['{E5A8A1C9-8A8B-45A3-99E1-3A5A0F8D7C6B}'] // Example GUID - Generate a new one for real projects - function GetValue: Integer; - procedure SetValue(AValue: Integer); - property Value: Integer read GetValue write SetValue; - end; - - TTestImplementingObject = class(TInterfacedObject, ITestInterface) - private - FValue: Integer; - public - constructor Create(AValue: Integer); - function GetValue: Integer; - procedure SetValue(AValue: Integer); - end; - - [TestFixture] - TMycTestStackTests = class(TObject) - public - [Setup] - procedure Setup; - [TearDown] - procedure TearDown; - - // --- Tests for TMycAtomicStack --- - [Test] - procedure TestInteger_PopOnEmpty_ReturnsDefault; - [Test] - procedure TestInteger_TryPopOnEmpty_ReturnsFalseAndDefault; - [Test] - procedure TestInteger_PushOne_PopOne_CorrectValue; - [Test] - procedure TestInteger_PushThree_PopThree_LIFO_Order; - [Test] - procedure TestInteger_TryPopWithItems_ReturnsTrueAndCorrectValue; - [Test] - procedure TestInteger_PushPopMixed_MaintainsIntegrity; - [Test] - procedure TestInteger_StressTest_ManyItems; - - // --- Tests for TMycAtomicStack --- - [Test] - procedure TestString_PopOnEmpty_ReturnsDefault; - [Test] - procedure TestString_TryPopOnEmpty_ReturnsFalseAndDefault; - [Test] - procedure TestString_PushOne_PopOne_CorrectValue; - [Test] - procedure TestString_PushThree_PopThree_LIFO_Order; - [Test] - procedure TestString_HandleEmptyAndNilStrings; - - // --- Tests for TMycAtomicStack --- - [Test] - procedure TestRecord_PopOnEmpty_ReturnsDefault; - [Test] - procedure TestRecord_TryPopOnEmpty_ReturnsFalseAndDefault; - [Test] - procedure TestRecord_PushOne_PopOne_CorrectValue; - [Test] - procedure TestRecord_PushThree_PopThree_LIFO_Order; - - // --- Tests for TMycAtomicStack --- - [Test] - procedure TestInterface_PopOnEmpty_ReturnsNil; - [Test] - procedure TestInterface_TryPopOnEmpty_ReturnsFalseAndNil; - [Test] - procedure TestInterface_PushOne_PopOne_CorrectObjectAndValue; - [Test] - procedure TestInterface_PushThree_PopThree_LIFO_OrderAndValues; - [Test] - procedure TestInterface_PushNilInterface_PopNil; - [Test] - procedure TestInterface_ReferenceCountingImplicitCheck; - - end; - -implementation - -uses - Myc.Core.Atomic; // The unit containing TMycAtomicStack - -// --- Implementation for TTestImplementingObject --- -constructor TTestImplementingObject.Create(AValue: Integer); -begin - inherited Create; - FValue := AValue; -end; - -function TTestImplementingObject.GetValue: Integer; -begin - Result := FValue; -end; - -procedure TTestImplementingObject.SetValue(AValue: Integer); -begin - FValue := AValue; -end; - -// --- TestFixture Method Implementations --- -procedure TMycTestStackTests.Setup; -begin - // No specific setup needed per test if stack is local variable in methods. -end; - -procedure TMycTestStackTests.TearDown; -begin - // No specific teardown needed per test. -end; - -// --- Helper Methods for TTestRecord (as before) --- -function AreRecordsEqual(const Rec1, Rec2: TTestRecord): Boolean; -begin - Result := (Rec1.ID = Rec2.ID) and (Rec1.Name = Rec2.Name) and (Rec1.Value = Rec2.Value); -end; - -function TestRecordToString(const Rec: TTestRecord): string; -begin - Result := Format('ID: %d, Name: "%s", Value: %f', [Rec.ID, Rec.Name, Rec.Value]); -end; - -// --- Tests for TMycAtomicStack (implementations as before, omitted for brevity) --- -[Test] -procedure TMycTestStackTests.TestInteger_PopOnEmpty_ReturnsDefault; -var - stack: TMycAtomicStack; - value: Integer; -begin - value := stack.Pop; - Assert.AreEqual(Default(Integer), value, 'Pop on empty integer stack should return Default(Integer).'); -end; - -[Test] -procedure TMycTestStackTests.TestInteger_TryPopOnEmpty_ReturnsFalseAndDefault; -var - stack: TMycAtomicStack; - value: Integer; - success: Boolean; -begin - value := 123; - success := stack.TryPop(value); - Assert.IsFalse(success, 'TryPop on empty integer stack should return False.'); - Assert.AreEqual(Default(Integer), value, 'Item from TryPop on empty integer stack should be Default(Integer).'); -end; - -[Test] -procedure TMycTestStackTests.TestInteger_PushOne_PopOne_CorrectValue; -var - stack: TMycAtomicStack; - pushedValue: Integer; - poppedValue: Integer; - success: Boolean; -begin - pushedValue := 100; - stack.Push(pushedValue); - poppedValue := stack.Pop; - Assert.AreEqual(pushedValue, poppedValue, 'Popped value does not match pushed value.'); - success := stack.TryPop(poppedValue); - Assert.IsFalse(success, 'Stack should be empty after popping the only item.'); -end; - -[Test] -procedure TMycTestStackTests.TestInteger_PushThree_PopThree_LIFO_Order; -var - stack: TMycAtomicStack; - val1, val2, val3: Integer; -begin - val1 := 1; val2 := 2; val3 := 3; - stack.Push(val1); stack.Push(val2); stack.Push(val3); - Assert.AreEqual(val3, stack.Pop, '1st Pop: Expected val3 (LIFO).'); - Assert.AreEqual(val2, stack.Pop, '2nd Pop: Expected val2 (LIFO).'); - Assert.AreEqual(val1, stack.Pop, '3rd Pop: Expected val1 (LIFO).'); - Assert.IsFalse(stack.TryPop(val1), 'Stack should be empty after popping all items.'); -end; - -[Test] -procedure TMycTestStackTests.TestInteger_TryPopWithItems_ReturnsTrueAndCorrectValue; -var - stack: TMycAtomicStack; - pushedValue: Integer; - poppedValue: Integer; - success: Boolean; -begin - pushedValue := 77; - stack.Push(pushedValue); - success := stack.TryPop(poppedValue); - Assert.IsTrue(success, 'TryPop should return True when stack is not empty.'); - Assert.AreEqual(pushedValue, poppedValue, 'TryPop: Popped value does not match pushed value.'); - success := stack.TryPop(poppedValue); - Assert.IsFalse(success, 'Stack should be empty after TryPop on the only item.'); -end; - -[Test] -procedure TMycTestStackTests.TestInteger_PushPopMixed_MaintainsIntegrity; -var - stack: TMycAtomicStack; - value: Integer; -begin - stack.Push(10); stack.Push(20); - Assert.AreEqual(20, stack.Pop, 'Pop 20'); - stack.Push(30); - Assert.AreEqual(30, stack.Pop, 'Pop 30'); - stack.Push(40); - Assert.AreEqual(40, stack.Pop, 'Pop 40'); - Assert.AreEqual(10, stack.Pop, 'Pop 10'); - Assert.IsFalse(stack.TryPop(value), 'Stack should be empty after all operations.'); -end; - -[Test] -procedure TMycTestStackTests.TestInteger_StressTest_ManyItems; -var - stack: TMycAtomicStack; - i: Integer; - count: Integer; -begin - count := 10000; - for i := 1 to count do begin stack.Push(i); end; - for i := count downto 1 do - begin - Assert.AreEqual(i, stack.Pop, Format('Stress test: Popped value mismatch for item %d.', [i])); - end; - Assert.IsFalse(stack.TryPop(i), 'Stack should be empty after stress test.'); -end; - -// --- Tests for TMycAtomicStack (implementations as before, omitted for brevity) --- -[Test] -procedure TMycTestStackTests.TestString_PopOnEmpty_ReturnsDefault; -var - stack: TMycAtomicStack; - value: string; -begin - value := stack.Pop; - Assert.AreEqual(Default(string), value, 'Pop on empty string stack should return Default(string) (nil).'); -end; - -[Test] -procedure TMycTestStackTests.TestString_TryPopOnEmpty_ReturnsFalseAndDefault; -var - stack: TMycAtomicStack; - value: string; - success: Boolean; -begin - value := 'not nil'; - success := stack.TryPop(value); - Assert.IsFalse(success, 'TryPop on empty string stack should return False.'); - Assert.AreEqual(Default(string), value, 'Item from TryPop on empty string stack should be Default(string) (nil).'); -end; - -[Test] -procedure TMycTestStackTests.TestString_PushOne_PopOne_CorrectValue; -var - stack: TMycAtomicStack; - pushedValue: string; - poppedValue: string; -begin - pushedValue := 'Hello Delphi'; - stack.Push(pushedValue); - poppedValue := stack.Pop; - Assert.AreEqual(pushedValue, poppedValue, 'String Pop: Popped value does not match pushed value.'); - Assert.IsFalse(stack.TryPop(poppedValue), 'Stack should be empty.'); -end; - -[Test] -procedure TMycTestStackTests.TestString_PushThree_PopThree_LIFO_Order; -var - stack: TMycAtomicStack; - s1, s2, s3: string; -begin - s1 := 'first'; s2 := 'second'; s3 := 'third'; - stack.Push(s1); stack.Push(s2); stack.Push(s3); - Assert.AreEqual(s3, stack.Pop, 'String LIFO: Expected s3.'); - Assert.AreEqual(s2, stack.Pop, 'String LIFO: Expected s2.'); - Assert.AreEqual(s1, stack.Pop, 'String LIFO: Expected s1.'); - Assert.IsFalse(stack.TryPop(s1), 'Stack should be empty.'); -end; - -[Test] -procedure TMycTestStackTests.TestString_HandleEmptyAndNilStrings; -var - stack: TMycAtomicStack; - poppedValue: string; -begin - stack.Push(''); - stack.Push(Default(string)); - stack.Push('actual string'); - Assert.AreEqual('actual string', stack.Pop, 'Pop "actual string"'); - Assert.AreEqual(Default(string), stack.Pop, 'Pop nil string'); - Assert.AreEqual('', stack.Pop, 'Pop empty string'); - Assert.IsFalse(stack.TryPop(poppedValue), 'Stack should be empty.'); -end; - -// --- Tests for TMycAtomicStack (implementations as before, omitted for brevity) --- -[Test] -procedure TMycTestStackTests.TestRecord_PopOnEmpty_ReturnsDefault; -var - stack: TMycAtomicStack; - value: TTestRecord; -begin - value := stack.Pop; - Assert.IsTrue(AreRecordsEqual(Default(TTestRecord), value), - Format('Pop on empty record stack should return Default(TTestRecord). Got %s', [TestRecordToString(value)])); -end; - -[Test] -procedure TMycTestStackTests.TestRecord_TryPopOnEmpty_ReturnsFalseAndDefault; -var - stack: TMycAtomicStack; - value: TTestRecord; - success: Boolean; -begin - value.ID := -1; - success := stack.TryPop(value); - Assert.IsFalse(success, 'TryPop on empty record stack should return False.'); - Assert.IsTrue(AreRecordsEqual(Default(TTestRecord), value), - Format('Item from TryPop on empty record stack should be Default(TTestRecord). Got %s', [TestRecordToString(value)])); -end; - -[Test] -procedure TMycTestStackTests.TestRecord_PushOne_PopOne_CorrectValue; -var - stack: TMycAtomicStack; - pushedValue: TTestRecord; - poppedValue: TTestRecord; -begin - pushedValue.ID := 1; pushedValue.Name := 'Test Record 1'; pushedValue.Value := 3.14; - stack.Push(pushedValue); - poppedValue := stack.Pop; - Assert.IsTrue(AreRecordsEqual(pushedValue, poppedValue), - Format('Record Pop: Popped value (%s) does not match pushed value (%s).', [TestRecordToString(poppedValue), TestRecordToString(pushedValue)])); - Assert.IsFalse(stack.TryPop(poppedValue), 'Stack should be empty.'); -end; - -[Test] -procedure TMycTestStackTests.TestRecord_PushThree_PopThree_LIFO_Order; -var - stack: TMycAtomicStack; - r1, r2, r3: TTestRecord; - popped: TTestRecord; -begin - r1.ID := 1; r1.Name := 'R1'; r1.Value := 1.0; - r2.ID := 2; r2.Name := 'R2'; r2.Value := 2.0; - r3.ID := 3; r3.Name := 'R3'; r3.Value := 3.0; - stack.Push(r1); stack.Push(r2); stack.Push(r3); - popped := stack.Pop; Assert.IsTrue(AreRecordsEqual(r3, popped), Format('Record LIFO: Expected r3, got %s', [TestRecordToString(popped)])); - popped := stack.Pop; Assert.IsTrue(AreRecordsEqual(r2, popped), Format('Record LIFO: Expected r2, got %s', [TestRecordToString(popped)])); - popped := stack.Pop; Assert.IsTrue(AreRecordsEqual(r1, popped), Format('Record LIFO: Expected r1, got %s', [TestRecordToString(popped)])); - Assert.IsFalse(stack.TryPop(popped), 'Stack should be empty.'); -end; - -// --- Tests for TMycAtomicStack --- - -[Test] -procedure TMycTestStackTests.TestInterface_PopOnEmpty_ReturnsNil; -var - stack: TMycAtomicStack; - value: ITestInterface; -begin - value := stack.Pop; - Assert.IsNull(value, 'Pop on empty interface stack should return nil.'); -end; - -[Test] -procedure TMycTestStackTests.TestInterface_TryPopOnEmpty_ReturnsFalseAndNil; -var - stack: TMycAtomicStack; - value: ITestInterface; - success: Boolean; -begin - value := TTestImplementingObject.Create(-1); // Assign a non-nil to check if TryPop nils it - success := stack.TryPop(value); - Assert.IsFalse(success, 'TryPop on empty interface stack should return False.'); - Assert.IsNull(value, 'Item from TryPop on empty interface stack should be nil.'); -end; - -[Test] -procedure TMycTestStackTests.TestInterface_PushOne_PopOne_CorrectObjectAndValue; -var - stack: TMycAtomicStack; - pushedIntf: ITestInterface; - poppedIntf: ITestInterface; - originalObject: TTestImplementingObject; -begin - originalObject := TTestImplementingObject.Create(123); - pushedIntf := originalObject; // Interface variable now holds the object - stack.Push(pushedIntf); - - poppedIntf := stack.Pop; - Assert.IsNotNull(poppedIntf, 'Popped interface should not be nil.'); - Assert.AreSame(originalObject, poppedIntf as TObject, 'Popped interface should point to the same object instance.'); - if Assigned(poppedIntf) then - begin - Assert.AreEqual(123, poppedIntf.Value, 'Popped interface has incorrect Value.'); - end; - - Assert.IsFalse(stack.TryPop(poppedIntf), 'Stack should be empty after popping the only item.'); -end; - -[Test] -procedure TMycTestStackTests.TestInterface_PushThree_PopThree_LIFO_OrderAndValues; -var - stack: TMycAtomicStack; - i1, i2, i3: ITestInterface; - o1, o2, o3: TTestImplementingObject; - popped: ITestInterface; -begin - o1 := TTestImplementingObject.Create(10); i1 := o1; - o2 := TTestImplementingObject.Create(20); i2 := o2; - o3 := TTestImplementingObject.Create(30); i3 := o3; - - stack.Push(i1); - stack.Push(i2); - stack.Push(i3); - - popped := stack.Pop; - Assert.IsNotNull(popped, '1st popped interface should not be nil.'); - Assert.AreSame(o3, popped as TObject, '1st pop should be o3.'); - if Assigned(popped) then Assert.AreEqual(30, popped.Value); - - popped := stack.Pop; - Assert.IsNotNull(popped, '2nd popped interface should not be nil.'); - Assert.AreSame(o2, popped as TObject, '2nd pop should be o2.'); - if Assigned(popped) then Assert.AreEqual(20, popped.Value); - - popped := stack.Pop; - Assert.IsNotNull(popped, '3rd popped interface should not be nil.'); - Assert.AreSame(o1, popped as TObject, '3rd pop should be o1.'); - if Assigned(popped) then Assert.AreEqual(10, popped.Value); - - Assert.IsNull(stack.Pop, 'Stack should be empty and Pop return nil.'); -end; - -[Test] -procedure TMycTestStackTests.TestInterface_PushNilInterface_PopNil; -var - stack: TMycAtomicStack; - nilIntf: ITestInterface; // This is already nil by default - nonNilIntf: ITestInterface; -begin - nilIntf := nil; // Explicitly nil - nonNilIntf := TTestImplementingObject.Create(999); - - stack.Push(nonNilIntf); - stack.Push(nilIntf); // Push a nil interface - stack.Push(TTestImplementingObject.Create(777)); - - Assert.AreEqual(777, stack.Pop.Value, 'Pop 777.'); - Assert.IsNull(stack.Pop, 'Pop nil interface.'); // Pop the nil interface - Assert.AreEqual(999, stack.Pop.Value, 'Pop 999.'); - - Assert.IsNull(stack.Pop, 'Stack should be empty and Pop return nil.'); -end; - -[Test] -procedure TMycTestStackTests.TestInterface_ReferenceCountingImplicitCheck; -var - stack: TMycAtomicStack; - intf1: ITestInterface; - objRawPtr: TObject; // To observe, not for direct management - initialRefCount, afterPushRefCount, afterPopRefCount, afterClearRefCount: Integer; -begin - // This test is more conceptual as direct ref count assertion is tricky - // and an implementation detail. Correct working of other tests implies - // ref counting is likely correct due to ARC. - // We rely on ARC and TInterfacedObject. - - intf1 := TTestImplementingObject.Create(505); - objRawPtr := intf1 as TObject; - initialRefCount := TInterfacedObject(objRawPtr).RefCount; // Should be 1 - - stack.Push(intf1); - afterPushRefCount := TInterfacedObject(objRawPtr).RefCount; // Should be 2 (intf1 + stack's copy) - Assert.AreEqual(initialRefCount + 1, afterPushRefCount, 'Ref count should increment after push.'); - - intf1 := nil; // Release local variable's reference - afterClearRefCount := TInterfacedObject(objRawPtr).RefCount; // Should be 1 (only stack's copy) - Assert.AreEqual(initialRefCount, afterClearRefCount, 'Ref count should decrement after local var nilled.'); - - - intf1 := stack.Pop; // Retrieve from stack - afterPopRefCount := TInterfacedObject(objRawPtr).RefCount; // Should be 1 (only intf1's copy, stack's copy released) - Assert.AreEqual(initialRefCount, afterPopRefCount, 'Ref count should be back to initial after pop and stack release.'); - - // When intf1 goes out of scope, object should be freed. - // The stack itself is a managed record and its Finalize will clear any remaining - // interface references, decrementing their ref counts. - Assert.IsFalse(stack.TryPop(intf1), 'Stack should be empty.'); - - // Note: Direct RefCount checking can be fragile and version-dependent. - // The main check is that objects are released and no AVs occur. - // The above Asserts on RefCount are illustrative. -end; - - -initialization - TDUnitX.RegisterTestFixture(TMycTestStackTests); -end.