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.