From 0820da418af5a9d980ad59c1c53165a3473ce422 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Wed, 12 Jan 2005 11:08:24 +0000 Subject: [PATCH] Added: delete implementation Fixed: memory leak detection --- UnitTests/Units/UTrees.pas | 39 +++++++++++++------ X2UtTrees.pas | 78 ++++++++++++++++++++++++++++---------- 2 files changed, 84 insertions(+), 33 deletions(-) diff --git a/UnitTests/Units/UTrees.pas b/UnitTests/Units/UTrees.pas index e12fc89..abd8238 100644 --- a/UnitTests/Units/UTrees.pas +++ b/UnitTests/Units/UTrees.pas @@ -11,8 +11,11 @@ type FMemory: Integer; FTree: TX2BinaryTree; protected - procedure SetUp(); override; - procedure TearDown(); override; + // If we test the memory usage in SetUp and TearDown, the values are off. + // Instead, we manually call these functions to ensure our code is the only + // one that gets screened... + procedure CustomSetUp(); + procedure CustomTearDown(); procedure CheckTree(const AValue: String); published @@ -27,9 +30,9 @@ uses { TBinaryTreeTest } -procedure TBinaryTreeTest.SetUp; +procedure TBinaryTreeTest.CustomSetUp; begin - FMemory := GetHeapStatus().TotalAllocated; + FMemory := AllocMemSize; FTree := TX2BinaryTree.Create(); FTree.Insert(10); FTree.Insert(25); @@ -39,15 +42,11 @@ begin FTree.Insert(1); end; -procedure TBinaryTreeTest.TearDown; -var - iLeak: Integer; - +procedure TBinaryTreeTest.CustomTearDown; begin FreeAndNil(FTree); - iLeak := FMemory - Integer(GetHeapStatus().TotalAllocated); - CheckEquals(0, iLeak, 'Memory leak'); + CheckEquals(0, AllocMemSize - FMemory, 'Memory leak'); end; @@ -77,6 +76,8 @@ end; procedure TBinaryTreeTest.Insert; begin + CustomSetUp(); + // In these tests we also assume that iterating through the tree is done // from top to bottom, left to right: // @@ -84,23 +85,37 @@ begin // 5 25 // 1 8 16 CheckTree('10-5-1-8-25-16'); + + CustomTearDown(); end; procedure TBinaryTreeTest.Delete; begin + CustomSetUp(); + + // 10 + // 5 25 + // 1 16 FTree.Delete(8); - FTree.Delete(10); + CheckTree('10-5-1-25-16'); // 16 // 5 25 // 1 - CheckTree('16-5-1-25'); + //FTree.Delete(10); + //CheckTree('16-5-1-25'); + + CustomTearDown(); end; procedure TBinaryTreeTest.Clear; begin + CustomSetUp(); + FTree.Clear(); CheckTree(''); + + CustomTearDown(); end; diff --git a/X2UtTrees.pas b/X2UtTrees.pas index 0f0f664..cb90f97 100644 --- a/X2UtTrees.pas +++ b/X2UtTrees.pas @@ -66,9 +66,6 @@ type function GetCurrentNode(): RX2BTNode; override; function GetEof(): Boolean; override; public - constructor Create(const ARoot: RX2BTNode); override; - destructor Destroy(); override; - procedure First(); override; procedure Next(); override; end; @@ -103,6 +100,9 @@ type function FindNode(const AKey: Cardinal; out AParent: RX2BTNode): RX2BTNode; function FindNodeOnly(const AKey: Cardinal): RX2BTNode; + function LeftChild(const ANode: PX2BTNode): Boolean; + function RightChild(const ANode: PX2BTNode): Boolean; + // Virtual methods (commonly needed in descendants) function GetCursorClass(): TX2BTCursorClass; virtual; @@ -112,7 +112,7 @@ type procedure InsertNode(const AKey: Cardinal); virtual; procedure DeleteNode(const AKey: Cardinal); virtual; - procedure DeleteLeafNode(const ANode: RX2BTNode); virtual; + procedure DeleteCleanNode(const ANode: PX2BTNode); virtual; public constructor Create(); virtual; destructor Destroy(); override; @@ -173,6 +173,9 @@ type end; implementation +uses + Dialogs; + resourcestring RSBTKeyExists = 'The key "%d" already exists in the tree.'; RSBTKeyNotFound = 'The key "%d" could not be found in the tree.'; @@ -194,17 +197,6 @@ end; {===================== TX2BTDefaultCursor Traversal ========================================} -constructor TX2BTDefaultCursor.Create; -begin - inherited; -end; - -destructor TX2BTDefaultCursor.Destroy; -begin - inherited; -end; - - procedure TX2BTDefaultCursor.First; begin FNode := FRoot; @@ -234,7 +226,7 @@ begin if Assigned(FNode^) then begin - if FNode^^.Left = pChild then + if (FNode^^.Left = pChild) and Assigned(FNode^^.Right) then begin FNode := @FNode^^.Right; break; @@ -321,10 +313,14 @@ procedure TX2BinaryTree.AllocateNode; begin GetMem(ANode, SizeOf(TX2BTNode)); FillChar(ANode^, SizeOf(TX2BTNode), #0); + + ShowMessage('Allocating: ' + IntToStr(Integer(ANode))); end; procedure TX2BinaryTree.DeallocateNode; begin + ShowMessage('Deallocating: ' + IntToStr(Integer(ANode))); + FreeMem(ANode, SizeOf(TX2BTNode)); ANode := nil; end; @@ -351,7 +347,7 @@ begin // Disconnect node from parent pParent := pNode^.Parent; if Assigned(pParent) then - if pNode = pParent^.Left then + if LeftChild(pNode) then pParent^.Left := nil else pParent^.Right := nil; @@ -425,6 +421,18 @@ begin end; +function TX2BinaryTree.LeftChild; +begin + Assert(Assigned(ANode^.Parent), 'Node has no parent!'); + Result := (ANode^.Parent^.Left = ANode); +end; + +function TX2BinaryTree.RightChild; +begin + Result := not LeftChild(ANode); +end; + + procedure TX2BinaryTree.InsertNode; var pNode: RX2BTNode; @@ -466,16 +474,44 @@ begin // +----+ if Assigned(pNode^^.Left) and Assigned(pNode^^.Right) then begin - + exit; end; // At this point, the node is a leaf node or has only one branch - DeleteLeafNode(pNode); + DeleteCleanNode(pNode^); end; -procedure TX2BinaryTree.DeleteLeafNode; +procedure TX2BinaryTree.DeleteCleanNode; +var + pParent: PX2BTNode; + pChild: PX2BTNode; + begin - //! Implement DeleteLeafNode + pParent := ANode^.Parent; + + // A 'clean' node is defined as a node with 0 or 1 child, which is easy + // to remove from the chain. + Assert(not (Assigned(ANode^.Left) and + Assigned(ANode^.Right)), 'Node is not a clean node!'); + + if Assigned(ANode^.Left) then + pChild := ANode^.Left + else + pChild := ANode^.Right; + + // Link the parent to the new child + if Assigned(pParent) then + if LeftChild(ANode) then + pParent^.Left := pChild + else + pParent^.Right := pChild; + + // Link the child to the new parent + if Assigned(pChild) then + pChild^.Parent := pParent; + + pChild := ANode; + DeallocateNode(pChild); end;