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<T>, TDictionary<K,V>

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]
    [Timeout(30000)] // Timeout in milliseconds
    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, Format('Failed to allocate memory for TestListItem ID %d', [ID]));
  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, Format('Zero-size allocation processed (Iteration %d). Pointer: %p', [i, ptr]));
      end
      else if ptr = nil then
      begin
        Assert.Fail(Format('GetMemAligned returned nil for size %u (Iteration %d).',
                     [sizeToAllocate, i]));
      end
      else
      begin
        Assert.AreEqual(System.NativeUInt(0), System.NativeUInt(ptr) and TestAlignmentMask,
          Format('Pointer %p not 16-byte aligned. Size: %u, Iteration: %d. (Value AND Mask = %u)',
                 [ptr, sizeToAllocate, i, System.NativeUInt(ptr) and TestAlignmentMask]));

        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(Format('Data corruption at offset %u for pointer %p. Size: %u, Iteration: %d. Expected %u, got %u.',
                         [j, ptr, sizeToAllocate, i, fillValue, bytePtr[j]]));
            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, Format('Depth should be %d after %d pushes.', [i,i]));
  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, Format('Pop should return an item, not nil (iteration %d).', [i]));
    poppedItem := PTestListItem(poppedInternalListEntry);
    Assert.AreEqual(NativeUInt(items[i]), NativeUInt(poppedItem),
      Format('LIFO order violated. Expected item ID %d (original index %d), got ID %d.', [items[i].ID, i, poppedItem.ID]));
    Assert.AreEqual(items[i].ID, poppedItem.ID, 'Popped item ID mismatch.');
    Assert.AreEqual(i - 1, sListPtr.QueryDepth, Format('Depth incorrect after pop %d.', [NumItems - i + 1]));
  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<Integer>;
  poppedIDs: TThreadedQueue<Integer>;
  globalItemID: Integer;
  pushedItemsFinal: TDictionary<Integer, Integer>;
  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<Integer>.Create(logQueueCapacity, INFINITE, 0); // PopTimeout = 0
  poppedIDs := TThreadedQueue<Integer>.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,
                Format('Failed to push item ID %d to pushedIDs logging queue.', [itemID]));
            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,
                Format('Failed to push item ID %d to poppedIDs logging queue.', [item.ID]));
              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,
        Format('Failed to push remaining item ID %d to poppedIDs logging queue during drain.', [remainingItem.ID]));
    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
    Format('Mismatch between total logged pushed items (%u) and total logged popped items (%u).',
           [pushedIDs.TotalItemsPushed, poppedIDs.TotalItemsPushed]));

  pushedItemsFinal := TDictionary<Integer, Integer>.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),
        Format('Item ID %d was logged as popped but never logged as pushed.', [currentPoppedID]));
      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],
        Format('Item ID %d count mismatch. Final count in reconciliation dictionary is not zero (is %d).',
               [currentPushedID, pushedItemsFinal.Items[currentPushedID]]));
    end;
  finally
    pushedItemsFinal.Free;
  end;

  // Final cleanup
  sharedSList.Free;
  pushedIDs.Free;
  poppedIDs.Free;
end;

initialization
  TDUnitX.RegisterTestFixture(TMycTestSList);
end.