Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

New tests for atomic ops

Browse Source
This commit is contained in:
Michael Schimmel
2025-06-03 19:49:48 +02:00
parent 556690fa5e
commit f438c91dbd
11 changed files with 511 additions and 951 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Test/MycTests.dpr
+2 -3
View File
@@ -15,8 +15,6 @@ uses
{$ENDIF }
DUnitX.TestFramework,
TestNotifier in 'TestNotifier.pas',
TestSList in 'TestSList.pas',
TestStack in 'TestStack.pas' {/TestNotifier_Threading in 'TestNotifier_Threading.pas',},
TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',},
TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',
TestSignals_Latch in 'TestSignals_Latch.pas',
@@ -32,7 +30,8 @@ uses
Myc.Lazy in '..\Src\Myc.Lazy.pas',
Myc.Core.Lazy in '..\Src\Myc.Core.Lazy.pas',
Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas',
Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas';
Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas',
Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas';
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
{$IFNDEF TESTINSIGHT}
Test/MycTests.dproj
+1 -4
View File
@@ -110,10 +110,6 @@ $(PreBuildEvent)]]></PreBuildEvent>
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="TestNotifier.pas"/>
<DCCReference Include="TestSList.pas"/>
<DCCReference Include="TestStack.pas">
<Form>/TestNotifier_Threading in &apos;TestNotifier_Threading.pas&apos;,</Form>
</DCCReference>
<DCCReference Include="TestNotifier_Threading.pas">
<Form>/TestNotifier_ChaosStress in &apos;TestNotifier_ChaosStress.pas&apos;,</Form>
</DCCReference>
@@ -132,6 +128,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
<DCCReference Include="..\Src\Myc.Core.Lazy.pas"/>
<DCCReference Include="..\Src\Myc.Test.Core.Lazy.pas"/>
<DCCReference Include="..\Src\Myc.Test.Lazy.pas"/>
<DCCReference Include="..\Src\Myc.Test.Core.Atomic.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
Test/TestNotifier_Threading.pas
+1 -1
View File
@@ -127,7 +127,7 @@ begin
// Acquire lock before calling Advise
FOwnerFixture.FNotifier.Lock;
try
var tag := FOwnerFixture.FNotifier.Advise(FReceiversToAdd[i]);
{var tag :=} FOwnerFixture.FNotifier.Advise(FReceiversToAdd[i]);
// The 'tag' could be used here if necessary for other test scenarios
finally
// Definitely release lock in the finally block
Test/TestSList.pas
-415
View File
@@ -1,415 +0,0 @@
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.
Test/TestStack.pas
-514
View File
@@ -1,514 +0,0 @@
unit TestStack;
interface
uses
DUnitX.TestFramework,
System.SysUtils; // For GUIDToString if used in messages, and other utils
type
// Helper record type for testing generic capabilities (as before)
TTestRecord = record
ID: Integer;
Name: string;
Value: Double;
end;
// --- Interface and implementing class for interface tests ---
ITestInterface = interface
['{E5A8A1C9-8A8B-45A3-99E1-3A5A0F8D7C6B}'] // Example GUID - Generate a new one for real projects
function GetValue: Integer;
procedure SetValue(AValue: Integer);
property Value: Integer read GetValue write SetValue;
end;
TTestImplementingObject = class(TInterfacedObject, ITestInterface)
private
FValue: Integer;
public
constructor Create(AValue: Integer);
function GetValue: Integer;
procedure SetValue(AValue: Integer);
end;
[TestFixture]
TMycTestStackTests = class(TObject)
public
[Setup]
procedure Setup;
[TearDown]
procedure TearDown;
// --- Tests for TMycAtomicStack<Integer> ---
[Test]
procedure TestInteger_PopOnEmpty_ReturnsDefault;
[Test]
procedure TestInteger_TryPopOnEmpty_ReturnsFalseAndDefault;
[Test]
procedure TestInteger_PushOne_PopOne_CorrectValue;
[Test]
procedure TestInteger_PushThree_PopThree_LIFO_Order;
[Test]
procedure TestInteger_TryPopWithItems_ReturnsTrueAndCorrectValue;
[Test]
procedure TestInteger_PushPopMixed_MaintainsIntegrity;
[Test]
procedure TestInteger_StressTest_ManyItems;
// --- Tests for TMycAtomicStack<string> ---
[Test]
procedure TestString_PopOnEmpty_ReturnsDefault;
[Test]
procedure TestString_TryPopOnEmpty_ReturnsFalseAndDefault;
[Test]
procedure TestString_PushOne_PopOne_CorrectValue;
[Test]
procedure TestString_PushThree_PopThree_LIFO_Order;
[Test]
procedure TestString_HandleEmptyAndNilStrings;
// --- Tests for TMycAtomicStack<TTestRecord> ---
[Test]
procedure TestRecord_PopOnEmpty_ReturnsDefault;
[Test]
procedure TestRecord_TryPopOnEmpty_ReturnsFalseAndDefault;
[Test]
procedure TestRecord_PushOne_PopOne_CorrectValue;
[Test]
procedure TestRecord_PushThree_PopThree_LIFO_Order;
// --- Tests for TMycAtomicStack<ITestInterface> ---
[Test]
procedure TestInterface_PopOnEmpty_ReturnsNil;
[Test]
procedure TestInterface_TryPopOnEmpty_ReturnsFalseAndNil;
[Test]
procedure TestInterface_PushOne_PopOne_CorrectObjectAndValue;
[Test]
procedure TestInterface_PushThree_PopThree_LIFO_OrderAndValues;
[Test]
procedure TestInterface_PushNilInterface_PopNil;
[Test]
procedure TestInterface_ReferenceCountingImplicitCheck;
end;
implementation
uses
Myc.Core.Atomic; // The unit containing TMycAtomicStack
// --- Implementation for TTestImplementingObject ---
constructor TTestImplementingObject.Create(AValue: Integer);
begin
inherited Create;
FValue := AValue;
end;
function TTestImplementingObject.GetValue: Integer;
begin
Result := FValue;
end;
procedure TTestImplementingObject.SetValue(AValue: Integer);
begin
FValue := AValue;
end;
// --- TestFixture Method Implementations ---
procedure TMycTestStackTests.Setup;
begin
// No specific setup needed per test if stack is local variable in methods.
end;
procedure TMycTestStackTests.TearDown;
begin
// No specific teardown needed per test.
end;
// --- Helper Methods for TTestRecord (as before) ---
function AreRecordsEqual(const Rec1, Rec2: TTestRecord): Boolean;
begin
Result := (Rec1.ID = Rec2.ID) and (Rec1.Name = Rec2.Name) and (Rec1.Value = Rec2.Value);
end;
function TestRecordToString(const Rec: TTestRecord): string;
begin
Result := Format('ID: %d, Name: "%s", Value: %f', [Rec.ID, Rec.Name, Rec.Value]);
end;
// --- Tests for TMycAtomicStack<Integer> (implementations as before, omitted for brevity) ---
[Test]
procedure TMycTestStackTests.TestInteger_PopOnEmpty_ReturnsDefault;
var
stack: TMycAtomicStack<Integer>;
value: Integer;
begin
value := stack.Pop;
Assert.AreEqual(Default(Integer), value, 'Pop on empty integer stack should return Default(Integer).');
end;
[Test]
procedure TMycTestStackTests.TestInteger_TryPopOnEmpty_ReturnsFalseAndDefault;
var
stack: TMycAtomicStack<Integer>;
value: Integer;
success: Boolean;
begin
value := 123;
success := stack.TryPop(value);
Assert.IsFalse(success, 'TryPop on empty integer stack should return False.');
Assert.AreEqual(Default(Integer), value, 'Item from TryPop on empty integer stack should be Default(Integer).');
end;
[Test]
procedure TMycTestStackTests.TestInteger_PushOne_PopOne_CorrectValue;
var
stack: TMycAtomicStack<Integer>;
pushedValue: Integer;
poppedValue: Integer;
success: Boolean;
begin
pushedValue := 100;
stack.Push(pushedValue);
poppedValue := stack.Pop;
Assert.AreEqual(pushedValue, poppedValue, 'Popped value does not match pushed value.');
success := stack.TryPop(poppedValue);
Assert.IsFalse(success, 'Stack should be empty after popping the only item.');
end;
[Test]
procedure TMycTestStackTests.TestInteger_PushThree_PopThree_LIFO_Order;
var
stack: TMycAtomicStack<Integer>;
val1, val2, val3: Integer;
begin
val1 := 1; val2 := 2; val3 := 3;
stack.Push(val1); stack.Push(val2); stack.Push(val3);
Assert.AreEqual(val3, stack.Pop, '1st Pop: Expected val3 (LIFO).');
Assert.AreEqual(val2, stack.Pop, '2nd Pop: Expected val2 (LIFO).');
Assert.AreEqual(val1, stack.Pop, '3rd Pop: Expected val1 (LIFO).');
Assert.IsFalse(stack.TryPop(val1), 'Stack should be empty after popping all items.');
end;
[Test]
procedure TMycTestStackTests.TestInteger_TryPopWithItems_ReturnsTrueAndCorrectValue;
var
stack: TMycAtomicStack<Integer>;
pushedValue: Integer;
poppedValue: Integer;
success: Boolean;
begin
pushedValue := 77;
stack.Push(pushedValue);
success := stack.TryPop(poppedValue);
Assert.IsTrue(success, 'TryPop should return True when stack is not empty.');
Assert.AreEqual(pushedValue, poppedValue, 'TryPop: Popped value does not match pushed value.');
success := stack.TryPop(poppedValue);
Assert.IsFalse(success, 'Stack should be empty after TryPop on the only item.');
end;
[Test]
procedure TMycTestStackTests.TestInteger_PushPopMixed_MaintainsIntegrity;
var
stack: TMycAtomicStack<Integer>;
value: Integer;
begin
stack.Push(10); stack.Push(20);
Assert.AreEqual(20, stack.Pop, 'Pop 20');
stack.Push(30);
Assert.AreEqual(30, stack.Pop, 'Pop 30');
stack.Push(40);
Assert.AreEqual(40, stack.Pop, 'Pop 40');
Assert.AreEqual(10, stack.Pop, 'Pop 10');
Assert.IsFalse(stack.TryPop(value), 'Stack should be empty after all operations.');
end;
[Test]
procedure TMycTestStackTests.TestInteger_StressTest_ManyItems;
var
stack: TMycAtomicStack<Integer>;
i: Integer;
count: Integer;
begin
count := 10000;
for i := 1 to count do begin stack.Push(i); end;
for i := count downto 1 do
begin
Assert.AreEqual(i, stack.Pop, Format('Stress test: Popped value mismatch for item %d.', [i]));
end;
Assert.IsFalse(stack.TryPop(i), 'Stack should be empty after stress test.');
end;
// --- Tests for TMycAtomicStack<string> (implementations as before, omitted for brevity) ---
[Test]
procedure TMycTestStackTests.TestString_PopOnEmpty_ReturnsDefault;
var
stack: TMycAtomicStack<string>;
value: string;
begin
value := stack.Pop;
Assert.AreEqual(Default(string), value, 'Pop on empty string stack should return Default(string) (nil).');
end;
[Test]
procedure TMycTestStackTests.TestString_TryPopOnEmpty_ReturnsFalseAndDefault;
var
stack: TMycAtomicStack<string>;
value: string;
success: Boolean;
begin
value := 'not nil';
success := stack.TryPop(value);
Assert.IsFalse(success, 'TryPop on empty string stack should return False.');
Assert.AreEqual(Default(string), value, 'Item from TryPop on empty string stack should be Default(string) (nil).');
end;
[Test]
procedure TMycTestStackTests.TestString_PushOne_PopOne_CorrectValue;
var
stack: TMycAtomicStack<string>;
pushedValue: string;
poppedValue: string;
begin
pushedValue := 'Hello Delphi';
stack.Push(pushedValue);
poppedValue := stack.Pop;
Assert.AreEqual(pushedValue, poppedValue, 'String Pop: Popped value does not match pushed value.');
Assert.IsFalse(stack.TryPop(poppedValue), 'Stack should be empty.');
end;
[Test]
procedure TMycTestStackTests.TestString_PushThree_PopThree_LIFO_Order;
var
stack: TMycAtomicStack<string>;
s1, s2, s3: string;
begin
s1 := 'first'; s2 := 'second'; s3 := 'third';
stack.Push(s1); stack.Push(s2); stack.Push(s3);
Assert.AreEqual(s3, stack.Pop, 'String LIFO: Expected s3.');
Assert.AreEqual(s2, stack.Pop, 'String LIFO: Expected s2.');
Assert.AreEqual(s1, stack.Pop, 'String LIFO: Expected s1.');
Assert.IsFalse(stack.TryPop(s1), 'Stack should be empty.');
end;
[Test]
procedure TMycTestStackTests.TestString_HandleEmptyAndNilStrings;
var
stack: TMycAtomicStack<string>;
poppedValue: string;
begin
stack.Push('');
stack.Push(Default(string));
stack.Push('actual string');
Assert.AreEqual('actual string', stack.Pop, 'Pop "actual string"');
Assert.AreEqual(Default(string), stack.Pop, 'Pop nil string');
Assert.AreEqual('', stack.Pop, 'Pop empty string');
Assert.IsFalse(stack.TryPop(poppedValue), 'Stack should be empty.');
end;
// --- Tests for TMycAtomicStack<TTestRecord> (implementations as before, omitted for brevity) ---
[Test]
procedure TMycTestStackTests.TestRecord_PopOnEmpty_ReturnsDefault;
var
stack: TMycAtomicStack<TTestRecord>;
value: TTestRecord;
begin
value := stack.Pop;
Assert.IsTrue(AreRecordsEqual(Default(TTestRecord), value),
Format('Pop on empty record stack should return Default(TTestRecord). Got %s', [TestRecordToString(value)]));
end;
[Test]
procedure TMycTestStackTests.TestRecord_TryPopOnEmpty_ReturnsFalseAndDefault;
var
stack: TMycAtomicStack<TTestRecord>;
value: TTestRecord;
success: Boolean;
begin
value.ID := -1;
success := stack.TryPop(value);
Assert.IsFalse(success, 'TryPop on empty record stack should return False.');
Assert.IsTrue(AreRecordsEqual(Default(TTestRecord), value),
Format('Item from TryPop on empty record stack should be Default(TTestRecord). Got %s', [TestRecordToString(value)]));
end;
[Test]
procedure TMycTestStackTests.TestRecord_PushOne_PopOne_CorrectValue;
var
stack: TMycAtomicStack<TTestRecord>;
pushedValue: TTestRecord;
poppedValue: TTestRecord;
begin
pushedValue.ID := 1; pushedValue.Name := 'Test Record 1'; pushedValue.Value := 3.14;
stack.Push(pushedValue);
poppedValue := stack.Pop;
Assert.IsTrue(AreRecordsEqual(pushedValue, poppedValue),
Format('Record Pop: Popped value (%s) does not match pushed value (%s).', [TestRecordToString(poppedValue), TestRecordToString(pushedValue)]));
Assert.IsFalse(stack.TryPop(poppedValue), 'Stack should be empty.');
end;
[Test]
procedure TMycTestStackTests.TestRecord_PushThree_PopThree_LIFO_Order;
var
stack: TMycAtomicStack<TTestRecord>;
r1, r2, r3: TTestRecord;
popped: TTestRecord;
begin
r1.ID := 1; r1.Name := 'R1'; r1.Value := 1.0;
r2.ID := 2; r2.Name := 'R2'; r2.Value := 2.0;
r3.ID := 3; r3.Name := 'R3'; r3.Value := 3.0;
stack.Push(r1); stack.Push(r2); stack.Push(r3);
popped := stack.Pop; Assert.IsTrue(AreRecordsEqual(r3, popped), Format('Record LIFO: Expected r3, got %s', [TestRecordToString(popped)]));
popped := stack.Pop; Assert.IsTrue(AreRecordsEqual(r2, popped), Format('Record LIFO: Expected r2, got %s', [TestRecordToString(popped)]));
popped := stack.Pop; Assert.IsTrue(AreRecordsEqual(r1, popped), Format('Record LIFO: Expected r1, got %s', [TestRecordToString(popped)]));
Assert.IsFalse(stack.TryPop(popped), 'Stack should be empty.');
end;
// --- Tests for TMycAtomicStack<ITestInterface> ---
[Test]
procedure TMycTestStackTests.TestInterface_PopOnEmpty_ReturnsNil;
var
stack: TMycAtomicStack<ITestInterface>;
value: ITestInterface;
begin
value := stack.Pop;
Assert.IsNull(value, 'Pop on empty interface stack should return nil.');
end;
[Test]
procedure TMycTestStackTests.TestInterface_TryPopOnEmpty_ReturnsFalseAndNil;
var
stack: TMycAtomicStack<ITestInterface>;
value: ITestInterface;
success: Boolean;
begin
value := TTestImplementingObject.Create(-1); // Assign a non-nil to check if TryPop nils it
success := stack.TryPop(value);
Assert.IsFalse(success, 'TryPop on empty interface stack should return False.');
Assert.IsNull(value, 'Item from TryPop on empty interface stack should be nil.');
end;
[Test]
procedure TMycTestStackTests.TestInterface_PushOne_PopOne_CorrectObjectAndValue;
var
stack: TMycAtomicStack<ITestInterface>;
pushedIntf: ITestInterface;
poppedIntf: ITestInterface;
originalObject: TTestImplementingObject;
begin
originalObject := TTestImplementingObject.Create(123);
pushedIntf := originalObject; // Interface variable now holds the object
stack.Push(pushedIntf);
poppedIntf := stack.Pop;
Assert.IsNotNull(poppedIntf, 'Popped interface should not be nil.');
Assert.AreSame(originalObject, poppedIntf as TObject, 'Popped interface should point to the same object instance.');
if Assigned(poppedIntf) then
begin
Assert.AreEqual(123, poppedIntf.Value, 'Popped interface has incorrect Value.');
end;
Assert.IsFalse(stack.TryPop(poppedIntf), 'Stack should be empty after popping the only item.');
end;
[Test]
procedure TMycTestStackTests.TestInterface_PushThree_PopThree_LIFO_OrderAndValues;
var
stack: TMycAtomicStack<ITestInterface>;
i1, i2, i3: ITestInterface;
o1, o2, o3: TTestImplementingObject;
popped: ITestInterface;
begin
o1 := TTestImplementingObject.Create(10); i1 := o1;
o2 := TTestImplementingObject.Create(20); i2 := o2;
o3 := TTestImplementingObject.Create(30); i3 := o3;
stack.Push(i1);
stack.Push(i2);
stack.Push(i3);
popped := stack.Pop;
Assert.IsNotNull(popped, '1st popped interface should not be nil.');
Assert.AreSame(o3, popped as TObject, '1st pop should be o3.');
if Assigned(popped) then Assert.AreEqual(30, popped.Value);
popped := stack.Pop;
Assert.IsNotNull(popped, '2nd popped interface should not be nil.');
Assert.AreSame(o2, popped as TObject, '2nd pop should be o2.');
if Assigned(popped) then Assert.AreEqual(20, popped.Value);
popped := stack.Pop;
Assert.IsNotNull(popped, '3rd popped interface should not be nil.');
Assert.AreSame(o1, popped as TObject, '3rd pop should be o1.');
if Assigned(popped) then Assert.AreEqual(10, popped.Value);
Assert.IsNull(stack.Pop, 'Stack should be empty and Pop return nil.');
end;
[Test]
procedure TMycTestStackTests.TestInterface_PushNilInterface_PopNil;
var
stack: TMycAtomicStack<ITestInterface>;
nilIntf: ITestInterface; // This is already nil by default
nonNilIntf: ITestInterface;
begin
nilIntf := nil; // Explicitly nil
nonNilIntf := TTestImplementingObject.Create(999);
stack.Push(nonNilIntf);
stack.Push(nilIntf); // Push a nil interface
stack.Push(TTestImplementingObject.Create(777));
Assert.AreEqual(777, stack.Pop.Value, 'Pop 777.');
Assert.IsNull(stack.Pop, 'Pop nil interface.'); // Pop the nil interface
Assert.AreEqual(999, stack.Pop.Value, 'Pop 999.');
Assert.IsNull(stack.Pop, 'Stack should be empty and Pop return nil.');
end;
[Test]
procedure TMycTestStackTests.TestInterface_ReferenceCountingImplicitCheck;
var
stack: TMycAtomicStack<ITestInterface>;
intf1: ITestInterface;
objRawPtr: TObject; // To observe, not for direct management
initialRefCount, afterPushRefCount, afterPopRefCount, afterClearRefCount: Integer;
begin
// This test is more conceptual as direct ref count assertion is tricky
// and an implementation detail. Correct working of other tests implies
// ref counting is likely correct due to ARC.
// We rely on ARC and TInterfacedObject.
intf1 := TTestImplementingObject.Create(505);
objRawPtr := intf1 as TObject;
initialRefCount := TInterfacedObject(objRawPtr).RefCount; // Should be 1
stack.Push(intf1);
afterPushRefCount := TInterfacedObject(objRawPtr).RefCount; // Should be 2 (intf1 + stack's copy)
Assert.AreEqual(initialRefCount + 1, afterPushRefCount, 'Ref count should increment after push.');
intf1 := nil; // Release local variable's reference
afterClearRefCount := TInterfacedObject(objRawPtr).RefCount; // Should be 1 (only stack's copy)
Assert.AreEqual(initialRefCount, afterClearRefCount, 'Ref count should decrement after local var nilled.');
intf1 := stack.Pop; // Retrieve from stack
afterPopRefCount := TInterfacedObject(objRawPtr).RefCount; // Should be 1 (only intf1's copy, stack's copy released)
Assert.AreEqual(initialRefCount, afterPopRefCount, 'Ref count should be back to initial after pop and stack release.');
// When intf1 goes out of scope, object should be freed.
// The stack itself is a managed record and its Finalize will clear any remaining
// interface references, decrementing their ref counts.
Assert.IsFalse(stack.TryPop(intf1), 'Stack should be empty.');
// Note: Direct RefCount checking can be fragile and version-dependent.
// The main check is that objects are released and no AVs occur.
// The above Asserts on RefCount are illustrative.
end;
initialization
TDUnitX.RegisterTestFixture(TMycTestStackTests);
end.