Michael Schimmel
416 lines
14 KiB
ObjectPascal
416 lines
14 KiB
ObjectPascal
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]
|
|
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<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, '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<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), '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.
|