MycLib/Src/Myc.Test.Core.Atomic.pas

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<PTestSListEntryData>; // 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<Integer>; // 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<string>; // 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.