Heap Tests

.gitignore

@@ -30,14 +30,14 @@
 # Default Delphi compiler directories
 # Content of this directories are generated with each Compile/Construct of a project.
 # Most of the time, files here have not there place in a code repository.
-#Win32/
+Win32/
-#Win64/
+Win64/
-#OSX64/
+OSX64/
-#OSXARM64/
+OSXARM64/
-#Android/
+Android/
-#Android64/
+Android64/
-#iOSDevice64/
+iOSDevice64/
-#Linux64/
+Linux64/
 
 # Delphi compiler-generated binaries (safe to delete)
 *.exe

Src/Myc.Atomic.pas

@@ -0,0 +1,108 @@
+unit Myc.Atomic;
+
+interface
+
+uses
+    Myc.Heap;
+
+type
+    IAtomicStack<T> = interface
+        function Pop: T;
+        function TryPop( out Item: T ): Boolean;
+        procedure Push( const Data: T );
+    end;
+
+    TMycAtomicStack<T> = class( TInterfacedObject, IAtomicStack<T> )
+    private
+    type
+        PItem = ^TItem;
+        TItem = packed record
+            Next: Pointer;
+            Data: T;
+        end;
+
+    var
+        FSList: PSList;
+
+    public
+        constructor Create;
+        destructor Destroy; override;
+        function Pop: T; inline;
+        function TryPop(out Item: T): Boolean; inline;
+        procedure Push( const Data: T ); inline;
+        function Alloc: PItem; inline;
+        procedure PushPtr(Item: PItem); inline;
+        function PopPtr: PItem;
+    end;
+
+implementation
+
+uses Winapi.Windows;
+
+constructor TMycAtomicStack<T>.Create;
+begin
+    inherited Create;
+    FSList := TSList.Create;
+end;
+
+destructor TMycAtomicStack<T>.Destroy;
+var
+    Item: PItem;
+begin
+    Item := PopPtr;
+    while Item <> nil do
+    begin
+        Item.Data := Default ( T );
+        FreeMem( Item );
+        Item := PopPtr;
+    end;
+
+    FSList.Free;
+    inherited;
+end;
+
+function TMycAtomicStack<T>.Alloc: PItem;
+begin
+    Result := AllocMem( sizeof( TItem ) );
+end;
+
+function TMycAtomicStack<T>.Pop: T;
+begin
+    if not TryPop( Result ) then
+        Result := Default ( T );
+end;
+
+function TMycAtomicStack<T>.PopPtr: PItem;
+begin
+    Result := PItem( FSList.Pop );
+end;
+
+procedure TMycAtomicStack<T>.Push(const Data: T);
+var
+    Item: PItem;
+begin
+    Item := Alloc;
+    Item.Data := Data;
+    PushPtr( Item );
+end;
+
+procedure TMycAtomicStack<T>.PushPtr(Item: PItem);
+begin
+    FSList.Push( PSListEntry(Item) );
+end;
+
+function TMycAtomicStack<T>.TryPop(out Item: T): Boolean;
+var
+    P: PItem;
+begin
+    P := PopPtr;
+    Result := P <> nil;
+    if Result then
+    begin
+        Item := P.Data;
+        P.Data := Default ( T );
+        FreeMem( P );
+    end;
+end;
+
+end.

Src/Myc.Heap.pas

@@ -0,0 +1,144 @@
+unit Myc.Heap;
+
+interface
+
+{$align on}
+uses
+    {$ifndef NO_FASTMM}
+    FastMM5,
+    {$endif}
+    Winapi.Windows;
+
+type
+    TSListEntry = Winapi.Windows.TSListEntry;
+    PSListEntry = Winapi.Windows.PSListEntry;
+
+    PSList = ^TSList;
+    TSList = packed record
+    private
+        FList: TSListHeader;
+
+    public
+        class function Create: PSList; static;
+        procedure Init;
+        procedure Free;
+        function Push( ListEntry: PSListEntry ): PSListEntry;
+        function Pop: PSListEntry;
+        function QueryDepth: Integer;
+    end;
+
+procedure GetMemAligned( var P; Size: NativeUInt );
+procedure FreeMemAligned( var P );
+
+procedure InitializeSListHead( ListHead: PSListHeader ); stdcall; external kernel32;
+function InterlockedPushEntrySList( ListHead: PSListHeader; ListEntry: PSListEntry ): PSListEntry; stdcall; external kernel32;
+function InterlockedPopEntrySList( ListHead: PSListHeader ): PSListEntry; stdcall; external kernel32;
+function QueryDepthSList( ListHead: PSListHeader ): Word; stdcall; external kernel32;
+
+implementation
+
+const
+    // Defines the alignment boundary (16 bytes for SList and common SIMD operations)
+    AlignmentBoundary = 16;
+    // Mask to achieve alignment, (AlignmentBoundary - 1)
+    AlignmentMask = AlignmentBoundary - 1;
+
+{$ifdef NO_FASTMM}
+
+const
+    MetaDataSize = SizeOf(Pointer);
+
+procedure GetMemAligned(var P; Size: NativeUInt);
+var
+    rawAllocatedPtr: Pointer;
+    alignedUserPtrVal: NativeUInt;
+    rawAllocatedPtrVal: NativeUInt;
+    totalSizeToAllocate: NativeUInt;
+begin
+    totalSizeToAllocate := Size + MetaDataSize + AlignmentMask;
+    System.GetMem(rawAllocatedPtr, totalSizeToAllocate);
+    if rawAllocatedPtr = nil then
+    begin
+        Pointer(P) := nil;
+        Exit;
+    end;
+    rawAllocatedPtrVal := NativeUInt(rawAllocatedPtr);
+    alignedUserPtrVal := (rawAllocatedPtrVal + MetaDataSize + AlignmentMask) and not AlignmentMask;
+    Pointer(P) := Pointer(alignedUserPtrVal);
+    PPointer(alignedUserPtrVal - MetaDataSize)^ := rawAllocatedPtr;
+    Assert((NativeUInt(P) and AlignmentMask) = 0, 'GetMemAligned did not return an aligned pointer.');
+end;
+
+procedure FreeMemAligned( var P );
+var
+    alignedUserPtrVal: NativeUInt;
+    rawAllocatedPtr: Pointer;
+    ptrToRawAllocatedPtr: PPointer;
+begin
+    if Pointer(P) = nil then
+        Exit;
+    alignedUserPtrVal := NativeUInt(P);
+    ptrToRawAllocatedPtr := PPointer(alignedUserPtrVal - MetaDataSize);
+    rawAllocatedPtr := ptrToRawAllocatedPtr^;
+    System.FreeMem(rawAllocatedPtr);
+    Pointer(P) := nil;
+end;
+
+{$else}
+
+procedure GetMemAligned(var P; Size: NativeUInt); inline;
+begin
+    FastMM_EnterMinimumAddressAlignment(maa16Bytes);
+    try
+        GetMem( Pointer(P), Size );
+    finally
+        FastMM_ExitMinimumAddressAlignment(maa16Bytes)
+    end;
+end;
+
+procedure FreeMemAligned( var P ); inline;
+begin
+    FreeMem( Pointer(P) );
+end;
+
+{$endif}
+
+{ TSList }
+
+class function TSList.Create: PSList;
+begin
+    GetMemAligned( Result, sizeof( TSList ) );
+    Result.Init;
+end;
+
+procedure TSList.Free;
+var
+    P: Pointer;
+begin
+    P := @Self;
+    FreeMemAligned( P );
+end;
+
+procedure TSList.Init;
+begin
+    Assert( NativeUInt( @FList ) and AlignmentMask = 0, 'ListHeader not aligned' );
+    InitializeSListHead( @FList );
+end;
+
+function TSList.Pop: PSListEntry;
+begin
+    Result := InterlockedPopEntrySList( @FList );
+end;
+
+function TSList.Push( ListEntry: PSListEntry ): PSListEntry;
+begin
+    Assert( NativeUInt( ListEntry ) and AlignmentMask = 0, 'ListEntry not aligned' );
+    Result := InterlockedPushEntrySList( @FList, ListEntry );
+end;
+
+function TSList.QueryDepth: Integer;
+begin
+    Result := QueryDepthSList( @FList );
+end;
+
+end.

Test/MycTests.dpr

@@ -0,0 +1,72 @@
+program MycTests;
+
+{$IFNDEF TESTINSIGHT}
+{$APPTYPE CONSOLE}
+{$ENDIF}
+{$STRONGLINKTYPES ON}
+uses
+  FastMM5,
+  DUnitX.MemoryLeakMonitor.FastMM5,
+  System.SysUtils,
+  {$IFDEF TESTINSIGHT}
+  TestInsight.DUnitX,
+  {$ELSE}
+  DUnitX.Loggers.Console,
+  DUnitX.Loggers.Xml.NUnit,
+  {$ENDIF }
+  DUnitX.TestFramework,
+  TestSignals in 'TestSignals.pas',
+  TestHeap in 'TestHeap.pas';
+
+{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
+{$IFNDEF TESTINSIGHT}
+var
+  runner: ITestRunner;
+  results: IRunResults;
+  logger: ITestLogger;
+  nunitLogger : ITestLogger;
+{$ENDIF}
+begin
+{$IFDEF TESTINSIGHT}
+  TestInsight.DUnitX.RunRegisteredTests;
+{$ELSE}
+  try
+    //Check command line options, will exit if invalid
+    TDUnitX.CheckCommandLine;
+    //Create the test runner
+    runner := TDUnitX.CreateRunner;
+    //Tell the runner to use RTTI to find Fixtures
+    runner.UseRTTI := True;
+    //When true, Assertions must be made during tests;
+    runner.FailsOnNoAsserts := False;
+
+    //tell the runner how we will log things
+    //Log to the console window if desired
+    if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then
+    begin
+      logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet);
+      runner.AddLogger(logger);
+    end;
+    //Generate an NUnit compatible XML File
+    nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
+    runner.AddLogger(nunitLogger);
+
+    //Run tests
+    results := runner.Execute;
+    if not results.AllPassed then
+      System.ExitCode := EXIT_ERRORS;
+
+    {$IFNDEF CI}
+    //We don't want this happening when running under CI.
+    if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then
+    begin
+      System.Write('Done.. press <Enter> key to quit.');
+      System.Readln;
+    end;
+    {$ENDIF}
+  except
+    on E: Exception do
+      System.Writeln(E.ClassName, ': ', E.Message);
+  end;
+{$ENDIF}
+end.

Test/TestHeap.pas

@@ -0,0 +1,436 @@
+unit TestHeap;
+
+interface
+
+uses
+  DUnitX.TestFramework,
+  Myc.Heap,         // 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]
+  TMycTestHeap = 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;
+
+    // Sample method (can be removed if not needed)
+    [Test]
+    procedure Test1;
+  end;
+
+implementation
+
+uses
+  System.Math,      // For Random and Randomize
+  System.Classes,   // For TThread
+  System.Types;     // For TWaitResult
+
+// --- Helper Implementations (static) ---
+
+class function TMycTestHeap.CreateTestListItem(ID: Integer): PTestListItem;
+begin
+  Myc.Heap.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 TMycTestHeap.FreeTestListItem(var Item: PTestListItem);
+var
+  tempPtr: Pointer;
+begin
+  if Item <> nil then
+  begin
+    tempPtr := Item;
+    Myc.Heap.FreeMemAligned(tempPtr);
+    Item := nil;
+  end;
+end;
+
+// --- Fixture Setup/TearDown ---
+
+procedure TMycTestHeap.Setup;
+begin
+  Randomize;
+end;
+
+procedure TMycTestHeap.TearDown;
+begin
+end;
+
+// --- Alignment Stress Test Implementation ---
+
+procedure TMycTestHeap.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;
+  isNilAfterFreeExpected: Boolean;
+  originalPtrBeforeFree: Pointer;
+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
+      Myc.Heap.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
+      Myc.Heap.FreeMemAligned(ptr);
+    end;
+  end;
+end;
+
+// --- TSList Single-Threaded Test Implementations ---
+
+procedure TMycTestHeap.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 TMycTestHeap.TestTSList_PushPopSingleEntry;
+var
+  sListPtr: PSList;
+  item1: PTestListItem;
+  poppedInternalListEntry: PSListEntry;
+  poppedItem: PTestListItem;
+begin
+  sListPtr := TSList.Create;
+  Assert.IsNotNull(sListPtr);
+  item1 := TMycTestHeap.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.');
+  TMycTestHeap.FreeTestListItem(item1);
+  sListPtr.Free;
+end;
+
+procedure TMycTestHeap.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] := TMycTestHeap.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
+    TMycTestHeap.FreeTestListItem(items[i]);
+  end;
+  sListPtr.Free;
+end;
+
+procedure TMycTestHeap.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 := TMycTestHeap.CreateTestListItem(301);
+  sListPtr.Push(@item1.ListEntry);
+  Assert.AreEqual(1, sListPtr.QueryDepth, 'Depth should be 1 after one push.');
+  item2 := TMycTestHeap.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.');
+  TMycTestHeap.FreeTestListItem(item1);
+  TMycTestHeap.FreeTestListItem(item2);
+  sListPtr.Free;
+end;
+
+procedure TMycTestHeap.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 TMycTestHeap.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 := TMycTestHeap.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]));
+              TMycTestHeap.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]));
+    TMycTestHeap.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;
+
+// --- Existing Sample Test ---
+procedure TMycTestHeap.Test1;
+begin
+  // Example: Assert.IsTrue(True, 'Test1 passed');
+end;
+
+initialization
+  TDUnitX.RegisterTestFixture(TMycTestHeap);
+end.

Test/TestSignals.pas

@@ -0,0 +1,49 @@
+unit TestSignals;
+
+interface
+
+uses
+  DUnitX.TestFramework,
+  Myc.Atomic;
+
+type
+  [TestFixture]
+  TMycTest = class
+  public
+    [Setup]
+    procedure Setup;
+    [TearDown]
+    procedure TearDown;
+    // Sample Methods
+    // Simple single Test
+    [Test]
+    procedure Test1;
+    // Test with TestCase Attribute to supply parameters.
+    [Test]
+    [TestCase('TestA','1,2')]
+    [TestCase('TestB','3,4')]
+    procedure Test2(const AValue1 : Integer;const AValue2 : Integer);
+  end;
+
+implementation
+
+procedure TMycTest.Setup;
+begin
+end;
+
+procedure TMycTest.TearDown;
+begin
+end;
+
+procedure TMycTest.Test1;
+begin
+end;
+
+procedure TMycTest.Test2(const AValue1 : Integer;const AValue2 : Integer);
+begin
+end;
+
+initialization
+  TDUnitX.RegisterTestFixture(TMycTest);
+
+end.