Added: unit tests for hashes

Added: Clear method
Fixed: bug in key storage and comparison

UnitTests/Units/BitsTest.pas

@@ -1,4 +1,4 @@
-unit UBits;
+unit BitsTest;
 
 interface
 uses
@@ -20,7 +20,7 @@ uses
   X2UtBits;
 
 const
-  BitsTest    = [bit1, bit2, bit4, bit7];
+  Bits        = [bit1, bit2, bit4, bit7];
   BitsValue   = 150;
   BitsString  = '10010110';
 
@@ -33,7 +33,7 @@ var
 
 begin
   bValue  := BitsValue;
-  Check(eBits = BitsTest, 'Bits do not match the value!');
+  Check(eBits = Bits, 'Bits do not match the value!');
 end;
 
 procedure TBitsTest.testSet;
@@ -42,7 +42,7 @@ var
   eBits:          T8Bits absolute bValue;
 
 begin
-  eBits   := BitsTest;
+  eBits   := Bits;
   Check(bValue = BitsValue, 'Value does not match the bits!');
 end;
 
@@ -67,7 +67,7 @@ var
   sValue:         String;
 
 begin
-  eBits   := BitsTest;
+  eBits   := Bits;
   sValue  := BitsToString(eBits, bs8);
 
   Check(sValue = BitsString, 'Bits do not match the string!');
@@ -82,7 +82,7 @@ begin
   sValue  := BitsString;
   eBits   := StringToBits(sValue);
 
-  Check(eBits = BitsTest, 'String does not match the bits!');
+  Check(eBits = Bits, 'String does not match the bits!');
 end;
 
 

UnitTests/Units/HashesTest.pas

@@ -0,0 +1,217 @@
+unit HashesTest;
+
+interface
+uses
+  TestFramework,
+  X2UtHashes;
+
+type
+  THashesTest = class(TTestCase)
+  private
+    FHash:        TX2CustomHash;
+  protected
+    procedure TearDown(); override;
+    procedure FillTestItems(); virtual; abstract;
+  published
+    procedure testSet(); virtual; abstract;
+    procedure testGet(); virtual; abstract;
+    procedure testClear();
+    procedure testDelete(); virtual; abstract;
+    procedure testIterate(); virtual; abstract;
+  end;
+
+  // Two test cases involving all value managers.
+  // This should be sufficient for a realistic scenario.
+  THashesSITest = class(THashesTest)
+  private
+    function GetHash(): TX2SIHash;
+
+    property Hash:      TX2SIHash read GetHash;
+  protected
+    procedure SetUp(); override;
+    procedure FillTestItems(); override;
+  published
+    procedure testSet(); override;
+    procedure testGet(); override;
+    procedure testDelete(); override;
+    procedure testIterate(); override;
+  end;
+
+  THashesPOTest = class(THashesTest)
+  private
+    function GetHash(): TX2POHash;
+
+    property Hash:      TX2POHash read GetHash;
+  protected
+    procedure SetUp(); override;
+    procedure FillTestItems(); override;
+  published
+    procedure testSet(); override;
+    procedure testGet(); override;
+    procedure testDelete(); override;
+    procedure testIterate(); override;
+  end;
+
+implementation
+uses
+  SysUtils;
+
+type
+  TObject0  = class(TObject);
+  TObject1  = class(TObject);
+  TObject2  = class(TObject);
+
+
+{ THashesTest }
+procedure THashesTest.TearDown;
+begin
+  FreeAndNil(FHash);
+
+  inherited;
+end;
+
+
+procedure THashesTest.testClear;
+begin
+  FillTestItems();
+  FHash.Clear();
+  CheckEquals(0, FHash.Count);
+end;
+
+
+{ THashesSITest }
+procedure THashesSITest.SetUp;
+begin
+  inherited;
+
+  FHash := TX2SIHash.Create();
+end;
+
+procedure THashesSITest.FillTestItems;
+begin
+  Hash['Key1']  := 1;
+  Hash['Key2']  := 2;
+  Hash['Key3']  := 3;
+end;
+
+procedure THashesSITest.testSet;
+begin
+  FillTestItems();
+  CheckEquals(3, Hash.Count);
+end;
+
+procedure THashesSITest.testGet;
+begin
+  FillTestItems();
+  CheckEquals(1, Hash['Key1']);
+  CheckEquals(2, Hash['Key2']);
+  CheckEquals(3, Hash['Key3']);
+end;
+
+procedure THashesSITest.testDelete;
+begin
+  FillTestItems();
+  Hash.Delete('Key2');
+
+  CheckEquals(2, Hash.Count);
+  CheckTrue(Hash.Exists('Key1'), 'Key1 does not exist!');
+  CheckFalse(Hash.Exists('Key2'), 'Key2 still exists!');
+  CheckTrue(Hash.Exists('Key3'), 'Key3 does not exist!');
+end;
+
+procedure THashesSITest.testIterate;
+var
+  aPresent:     array[1..3] of Boolean;
+
+begin
+  FillTestItems();
+  FillChar(aPresent, SizeOf(aPresent), #0);
+  Hash.First();
+  while Hash.Next() do
+    if ((Hash.CurrentKey = 'Key1') and (Hash.CurrentValue = 1)) or
+       ((Hash.CurrentKey = 'Key2') and (Hash.CurrentValue = 2)) or
+       ((Hash.CurrentKey = 'Key3') and (Hash.CurrentValue = 3)) then
+      aPresent[Hash.CurrentValue] := True;
+
+  CheckTrue(aPresent[1], 'Key1 was not in the iteration!');
+  CheckTrue(aPresent[2], 'Key2 was not in the iteration!');
+  CheckTrue(aPresent[3], 'Key3 was not in the iteration!');
+end;
+
+
+function THashesSITest.GetHash(): TX2SIHash;
+begin
+  Result  := TX2SIHash(FHash);
+end;
+
+
+{ THashesPOTest }
+procedure THashesPOTest.SetUp;
+begin
+  inherited;
+
+  FHash := TX2POHash.Create(True);
+end;
+
+procedure THashesPOTest.FillTestItems;
+begin
+  Hash[Pointer(0)]  := TObject0.Create();
+  Hash[Pointer(1)]  := TObject1.Create();
+  Hash[Pointer(2)]  := TObject2.Create();
+end;
+
+procedure THashesPOTest.testSet;
+begin
+  FillTestItems();
+  CheckEquals(3, Hash.Count);
+end;
+
+procedure THashesPOTest.testGet;
+begin
+  FillTestItems();
+  CheckTrue(Hash[Pointer(0)] is TObject0);
+  CheckTrue(Hash[Pointer(1)] is TObject1);
+  CheckTrue(Hash[Pointer(2)] is TObject2);
+end;
+
+procedure THashesPOTest.testDelete;
+begin
+  FillTestItems();
+  Hash.Delete(Pointer(1));
+
+  CheckEquals(2, Hash.Count);
+  CheckTrue(Hash.Exists(Pointer(0)), 'Key1 does not exist!');
+  CheckFalse(Hash.Exists(Pointer(1)), 'Key2 still exists!');
+  CheckTrue(Hash.Exists(Pointer(2)), 'Key3 does not exist!');
+end;
+
+procedure THashesPOTest.testIterate;
+var
+  aPresent:     array[0..2] of Boolean;
+
+begin
+  FillTestItems();
+  FillChar(aPresent, SizeOf(aPresent), #0);
+  Hash.First();
+  while Hash.Next() do
+    if ((Hash.CurrentKey = Pointer(0)) and (Hash.CurrentValue is TObject0)) or
+       ((Hash.CurrentKey = Pointer(1)) and (Hash.CurrentValue is TObject1)) or
+       ((Hash.CurrentKey = Pointer(2)) and (Hash.CurrentValue is TObject2)) then
+      aPresent[Integer(Hash.CurrentKey)]  := True;
+
+  CheckTrue(aPresent[0], 'Key1 was not in the iteration!');
+  CheckTrue(aPresent[1], 'Key2 was not in the iteration!');
+  CheckTrue(aPresent[2], 'Key3 was not in the iteration!');
+end;
+
+
+function THashesPOTest.GetHash(): TX2POHash;
+begin
+  Result  := TX2POHash(FHash);
+end;
+
+initialization
+  RegisterTest('Hashes', THashesSITest.Suite);
+  RegisterTest('Hashes', THashesPOTest.Suite);
+
+end.

UnitTests/X2UtUnitTests.dof

@@ -105,10 +105,6 @@ HostApplication=
 Launcher=
 UseLauncher=0
 DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
 [Version Info]
 IncludeVerInfo=0
 AutoIncBuild=0

UnitTests/X2UtUnitTests.dpr

@@ -1,12 +1,14 @@
 program X2UtUnitTests;
 
 uses
+  MemCheck,
   TestFramework,
   GUITestRunner,
-  UBits in 'Units\UBits.pas',
-  UTrees in 'Units\UTrees.pas';
+  BitsTest in 'Units\BitsTest.pas',
+  HashesTest in 'Units\HashesTest.pas';
 
 begin
+  MemChk();
   RunRegisteredTests();
 end.
  

X2UtHashes.pas

@@ -194,6 +194,8 @@ type
     constructor Create(); virtual;
     destructor Destroy(); override;
 
+    procedure Clear();
+
     procedure First();
     function Next(): Boolean;
 
@@ -713,7 +715,7 @@ end;
 function TX2CustomHashManager.ToPointer(const AValue: Pointer;
                                         const ASize: Cardinal): Pointer;
 begin
-  Result  := Pointer(AValue);
+  Result  := Pointer(AValue^);
 end;
 
 function TX2CustomHashManager.ToValue(const AData: Pointer;
@@ -726,7 +728,7 @@ end;
 function TX2CustomHashManager.Compare(const AData: Pointer; const AValue: Pointer;
                                       const ASize: Cardinal): Boolean;
 begin
-  Result  := (Pointer(AValue) = AData);
+  Result  := (Pointer(AValue^) = AData);
 end;
 
 
@@ -735,7 +737,7 @@ end;
 ========================================}
 function TX2HashPointerManager.ToPointer(const AValue: Pointer): Pointer;
 begin
-  Result  := ToPointer(AValue, SizeOf(Pointer));
+  Result  := ToPointer(@AValue, SizeOf(Pointer));
 end;
 
 function TX2HashPointerManager.ToValue(const AData: Pointer): Pointer;
@@ -749,7 +751,7 @@ end;
 ========================================}
 function TX2HashIntegerManager.ToPointer(const AValue: Integer): Pointer;
 begin
-  Result  := ToPointer(Pointer(AValue), SizeOf(Integer));
+  Result  := ToPointer(@AValue, SizeOf(Integer));
 end;
 
 function TX2HashIntegerManager.ToValue(const AData: Pointer): Integer;
@@ -771,7 +773,7 @@ end;
 
 function TX2HashObjectManager.ToPointer(const AValue: TObject): Pointer;
 begin
-  Result  := ToPointer(Pointer(AValue), SizeOf(Integer));
+  Result  := ToPointer(@AValue, SizeOf(Integer));
 end;
 
 function TX2HashObjectManager.ToValue(const AData: Pointer): TObject;
@@ -871,42 +873,8 @@ begin
 end;
 
 destructor TX2CustomHash.Destroy();
-  procedure DestroyBucket(const ABucket: PX2HashBucket);
-  var
-    iItem:        Integer;
-    pNext:        PX2HashValue;
-    pValue:       PX2HashValue;
-
 begin
-    for iItem := Pred(LeafSize) downto 0 do
-      if ABucket^.Items[iItem] <> nil then
-        case ABucket^.Items[iItem].ID of
-          HIDBucket:
-            DestroyBucket(PX2HashBucket(ABucket^.Items[iItem]));
-          HIDValue:
-            begin
-              pValue  := PX2HashValue(ABucket^.Items[iItem]);
-              repeat
-                FKeyManager.Finalize(pValue^.Key);
-                FValueManager.Finalize(pValue^.Value);
-
-                pNext   := pValue^.Next;
-                FreeMem(pValue, SizeOf(TX2HashValue));
-                pValue  := pNext;
-              until pValue = nil;
-            end;
-        end;
-
-    FreeMem(ABucket, SizeOf(TX2HashBucket));
-  end;
-
-begin
-  if Assigned(FRoot) then
-  begin
-    DestroyBucket(FRoot);
-    FRoot := nil;
-  end;
-
+  Clear();
   FreeAndNil(FValueManager);
   FreeAndNil(FKeyManager);
   FreeAndNil(FCursor);
@@ -1134,6 +1102,47 @@ begin
                           AAllowCreate);
 end;
 
+
+procedure TX2CustomHash.Clear();
+  procedure DestroyBucket(const ABucket: PX2HashBucket);
+  var
+    iItem:        Integer;
+    pNext:        PX2HashValue;
+    pValue:       PX2HashValue;
+
+  begin
+    for iItem := Pred(LeafSize) downto 0 do
+      if ABucket^.Items[iItem] <> nil then
+        case ABucket^.Items[iItem].ID of
+          HIDBucket:
+            DestroyBucket(PX2HashBucket(ABucket^.Items[iItem]));
+          HIDValue:
+            begin
+              pValue  := PX2HashValue(ABucket^.Items[iItem]);
+              repeat
+                FKeyManager.Finalize(pValue^.Key);
+                FValueManager.Finalize(pValue^.Value);
+
+                pNext   := pValue^.Next;
+                FreeMem(pValue, SizeOf(TX2HashValue));
+                pValue  := pNext;
+              until pValue = nil;
+            end;
+        end;
+
+    FreeMem(ABucket, SizeOf(TX2HashBucket));
+  end;
+
+begin
+  if FRoot <> nil then
+  begin
+    DestroyBucket(FRoot);
+    FCount  := 0;
+    FRoot   := nil;
+  end;
+end;
+
+
 function TX2CustomHash.Exists(const AKey: Pointer;
                               const ASize: Cardinal): Boolean;
 begin