From 46264ea041b6c60d905646f16e07a4aa34723ee7 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sat, 24 May 2025 16:08:11 +0200 Subject: [PATCH] refactoring --- Src/Myc.Core.Atomic.pas | 30 ++-- Test/TestStack.pas | 301 ++++++++++++++++++++++++++++++---------- 2 files changed, 245 insertions(+), 86 deletions(-) diff --git a/Src/Myc.Core.Atomic.pas b/Src/Myc.Core.Atomic.pas index d2f8255..9b3e894 100644 --- a/Src/Myc.Core.Atomic.pas +++ b/Src/Myc.Core.Atomic.pas @@ -148,7 +148,7 @@ procedure TSList.Free; var tempSelf: Pointer; begin - tempSelf := Pointer(@Self); + tempSelf := Pointer(@Self); // @Self is valid here as Free is an instance method of a record FreeMemAligned(tempSelf); end; @@ -178,25 +178,32 @@ end; class operator TMycAtomicStack.Initialize(out Dest: TMycAtomicStack); begin - FSList := TSList.Create; + // Use Dest to access fields of the record instance being initialized + Dest.FSList := TSList.Create; end; class operator TMycAtomicStack.Finalize(var Dest: TMycAtomicStack); var item: PItem; begin - item := PopPtr; + // Use Dest to access fields and call instance methods + // on the record instance being finalized + item := Dest.PopPtr; // Call instance method PopPtr via Dest while item <> nil do begin item.Data := Default(T); - FreeMemAligned(item); - item := PopPtr; + FreeMemAligned(item); // Global procedure + item := Dest.PopPtr; // Call instance method PopPtr via Dest + end; + if Dest.FSList <> nil then // Check if FSList was initialized + begin + Dest.FSList.Free; // Call instance method Free on FSList via Dest end; - FSList.Free; end; function TMycAtomicStack.Alloc: PItem; begin + // This is an instance method, FSList is accessed directly (implicitly Self.FSList) GetMemAligned(Pointer(Result), SizeOf(TItem)); FillChar(Result^, SizeOf(TItem), 0); Result.Data := Default(T); @@ -204,6 +211,7 @@ end; function TMycAtomicStack.Pop: T; begin + // Instance method if not TryPop(Result) then begin Result := Default(T); @@ -212,6 +220,7 @@ end; function TMycAtomicStack.PopPtr: PItem; begin + // Instance method, FSList is Self.FSList Result := PItem(FSList.Pop); end; @@ -219,13 +228,15 @@ procedure TMycAtomicStack.Push(const Data: T); var item: PItem; begin - item := Alloc; + // Instance method + item := Alloc; // Calls Self.Alloc item.Data := Data; - PushPtr(item); + PushPtr(item); // Calls Self.PushPtr end; procedure TMycAtomicStack.PushPtr(Item: PItem); begin + // Instance method, FSList is Self.FSList FSList.Push(PSListEntry(Item)); end; @@ -233,7 +244,8 @@ function TMycAtomicStack.TryPop(out Item: T): Boolean; var currentPItem: PItem; begin - currentPItem := PopPtr; + // Instance method + currentPItem := PopPtr; // Calls Self.PopPtr Result := currentPItem <> nil; if Result then begin diff --git a/Test/TestStack.pas b/Test/TestStack.pas index b618a35..e9eba90 100644 --- a/Test/TestStack.pas +++ b/Test/TestStack.pas @@ -3,22 +3,37 @@ unit TestStack; interface uses - DUnitX.TestFramework; + DUnitX.TestFramework, + System.SysUtils; // For GUIDToString if used in messages, and other utils type - // Helper record type for testing generic capabilities + // Helper record type for testing generic capabilities (as before) TTestRecord = record ID: Integer; Name: string; Value: Double; end; - [TestFixture] - TMycTestStackTests = class(TObject) // Changed class name for clarity + // --- 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 and TearDown are often not strictly necessary for tests - // involving managed records as local variables, as their - // Initialize/Finalize are handled automatically. [Setup] procedure Setup; [TearDown] @@ -62,14 +77,45 @@ type [Test] procedure TestRecord_PushThree_PopThree_LIFO_Order; + // --- Tests for TMycAtomicStack --- + [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 - System.SysUtils, // For Default() if not implicitly available via DUnitX/Generics 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. @@ -80,8 +126,7 @@ begin // No specific teardown needed per test. end; -// --- Helper Methods --- - +// --- 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); @@ -92,18 +137,15 @@ begin Result := Format('ID: %d, Name: "%s", Value: %f', [Rec.ID, Rec.Name, Rec.Value]); end; -// --- Tests for TMycAtomicStack --- - +// --- Tests for TMycAtomicStack (implementations as before, omitted for brevity) --- [Test] procedure TMycTestStackTests.TestInteger_PopOnEmpty_ReturnsDefault; var stack: TMycAtomicStack; value: Integer; begin - // Initialize is called automatically for managed record 'stack' value := stack.Pop; Assert.AreEqual(Default(Integer), value, 'Pop on empty integer stack should return Default(Integer).'); - // Finalize is called automatically when 'stack' goes out of scope end; [Test] @@ -113,7 +155,7 @@ var value: Integer; success: Boolean; begin - value := 123; // Non-default initial value to check if TryPop modifies it + 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).'); @@ -129,11 +171,8 @@ var begin pushedValue := 100; stack.Push(pushedValue); - poppedValue := stack.Pop; Assert.AreEqual(pushedValue, poppedValue, 'Popped value does not match pushed value.'); - - // Stack should be empty now success := stack.TryPop(poppedValue); Assert.IsFalse(success, 'Stack should be empty after popping the only item.'); end; @@ -144,18 +183,11 @@ var stack: TMycAtomicStack; val1, val2, val3: Integer; begin - val1 := 1; - val2 := 2; - val3 := 3; - - stack.Push(val1); - stack.Push(val2); - stack.Push(val3); - + 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; @@ -169,11 +201,9 @@ var 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; @@ -184,15 +214,13 @@ var stack: TMycAtomicStack; value: Integer; begin - stack.Push(10); - stack.Push(20); - Assert.AreEqual(20, stack.Pop, 'Pop 20'); // Stack: 10 - stack.Push(30); // Stack: 10, 30 - Assert.AreEqual(30, stack.Pop, 'Pop 30'); // Stack: 10 - stack.Push(40); // Stack: 10, 40 - Assert.AreEqual(40, stack.Pop, 'Pop 40'); // Stack: 10 - Assert.AreEqual(10, stack.Pop, 'Pop 10'); // Stack: empty - + 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; @@ -204,22 +232,15 @@ var count: Integer; begin count := 10000; - for i := 1 to count do - begin - stack.Push(i); - end; - + 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 --- - +// --- Tests for TMycAtomicStack (implementations as before, omitted for brevity) --- [Test] procedure TMycTestStackTests.TestString_PopOnEmpty_ReturnsDefault; var @@ -252,7 +273,6 @@ var 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.'); @@ -264,14 +284,8 @@ var stack: TMycAtomicStack; s1, s2, s3: string; begin - s1 := 'first'; - s2 := 'second'; - s3 := 'third'; - - stack.Push(s1); - stack.Push(s2); - stack.Push(s3); - + 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.'); @@ -284,18 +298,16 @@ var stack: TMycAtomicStack; poppedValue: string; begin - stack.Push(''); // Empty string - stack.Push(Default(string)); // Nil string + 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 --- - +// --- Tests for TMycAtomicStack (implementations as before, omitted for brevity) --- [Test] procedure TMycTestStackTests.TestRecord_PopOnEmpty_ReturnsDefault; var @@ -314,7 +326,7 @@ var value: TTestRecord; success: Boolean; begin - value.ID := -1; // Non-default + value.ID := -1; success := stack.TryPop(value); Assert.IsFalse(success, 'TryPop on empty record stack should return False.'); Assert.IsTrue(AreRecordsEqual(Default(TTestRecord), value), @@ -328,11 +340,8 @@ var pushedValue: TTestRecord; poppedValue: TTestRecord; begin - pushedValue.ID := 1; - pushedValue.Name := 'Test Record 1'; - pushedValue.Value := 3.14; + 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)])); @@ -349,20 +358,158 @@ 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)])); + 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 --- + +[Test] +procedure TMycTestStackTests.TestInterface_PopOnEmpty_ReturnsNil; +var + stack: TMycAtomicStack; + 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; + 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; + 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; + 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; + nilIntf: ITestInterface; // This is already nil by default + nonNilIntf: ITestInterface; + popped: 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; + 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.