freepascal.compiler/packages/fcl-base/tests/utcfpobjecthashtable.pp

unit utcFPObjectHashTable;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, contnrs, punit;

procedure RegisterTests;

implementation

type
  TMyObject = class(TObject)
    IsFreed: ^Boolean;
    destructor Destroy; override;
  end;

destructor TMyObject.Destroy;
begin
  if Assigned(IsFreed) then
    IsFreed^ := True;
  inherited Destroy;
end;

Function TFPObjectHashTable_TestCreate : TTestString;
var
  HT: TFPObjectHashTable;
begin
  Result:='';
  HT := TFPObjectHashTable.Create;
  try
    AssertNotNull('Hash table should be created', HT);
    AssertEquals('Count should be 0 on creation', 0, HT.Count);
    AssertTrue('IsEmpty should be true on creation', HT.IsEmpty);
    AssertTrue('OwnsObjects should be true by default', HT.OwnsObjects);
  finally
    HT.Free;
  end;
end;

Function TFPObjectHashTable_TestAdd : TTestString;
var
  HT: TFPObjectHashTable;
  O1, O2: TObject;
begin
  Result:='';
  HT := TFPObjectHashTable.Create(False);
  try
    O1 := TObject.Create;
    O2 := TObject.Create;
    HT.Add('Key1', O1);
    AssertEquals('Count should be 1 after adding one item', 1, HT.Count);
    AssertFalse('IsEmpty should be false after adding an item', HT.IsEmpty);
    AssertSame('Items property should return correct value', O1, HT.Items['Key1']);

    HT.Add('Key2', O2);
    AssertEquals('Count should be 2 after adding a second item', 2, HT.Count);
    AssertSame('Items property should return correct value for second item', O2, HT.Items['Key2']);
  finally
    HT.Free;
    O1.Free;
    O2.Free;
  end;
end;

Function TFPObjectHashTable_TestDelete : TTestString;
var
  HT: TFPObjectHashTable;
  O1, O2: TObject;
begin
  Result:='';
  HT := TFPObjectHashTable.Create(False);
  try
    O1 := TObject.Create;
    O2 := TObject.Create;
    HT.Add('Key1', O1);
    HT.Add('Key2', O2);
    HT.Delete('Key1');
    AssertEquals('Count should be 1 after deleting an item', 1, HT.Count);
    AssertNull('Accessing deleted key should return nil', HT.Items['Key1']);
    AssertSame('Other item should still exist', O2, HT.Items['Key2']);
  finally
    HT.Free;
    O1.Free;
    O2.Free;
  end;
end;

Function TFPObjectHashTable_TestClear : TTestString;
var
  HT: TFPObjectHashTable;
  O1, O2: TObject;
begin
  Result:='';
  HT := TFPObjectHashTable.Create(False);
  try
    O1 := TObject.Create;
    O2 := TObject.Create;
    HT.Add('Key1', O1);
    HT.Add('Key2', O2);
    HT.Clear;
    AssertEquals('Count should be 0 after clearing', 0, HT.Count);
    AssertTrue('IsEmpty should be true after clearing', HT.IsEmpty);
  finally
    HT.Free;
    O1.Free;
    O2.Free;
  end;
end;

Function TFPObjectHashTable_TestItemsProperty : TTestString;
var
  HT: TFPObjectHashTable;
  O1, O2: TObject;
begin
  Result:='';
  HT := TFPObjectHashTable.Create(False);
  try
    O1 := TObject.Create;
    O2 := TObject.Create;
    HT.Items['Key1'] := O1;
    AssertEquals('Count should be 1 after setting item', 1, HT.Count);
    AssertSame('Items property should return correct value', O1, HT.Items['Key1']);
    HT.Items['Key1'] := O2;
    AssertEquals('Count should still be 1 after updating item', 1, HT.Count);
    AssertSame('Items property should return updated value', O2, HT.Items['Key1']);
  finally
    HT.Free;
    O1.Free;
    O2.Free;
  end;
end;

Function TFPObjectHashTable_TestFind : TTestString;
var
  HT: TFPObjectHashTable;
  O1: TObject;
  Node: THTCustomNode;
begin
  Result:='';
  HT := TFPObjectHashTable.Create(False);
  try
    O1 := TObject.Create;
    HT.Add('Key1', O1);
    Node := HT.Find('Key1');
    AssertNotNull('Find should return a node for an existing key', Node);
    if Node <> nil then
    begin
      AssertEquals('Node should have the correct key', 'Key1', Node.Key);
      AssertSame('Node data should be correct', O1, THTObjectNode(Node).Data);
    end;

    Node := HT.Find('NonExistentKey');
    AssertNull('Find should return nil for a non-existent key', Node);
  finally
    HT.Free;
    O1.Free;
  end;
end;

Function TFPObjectHashTable_TestOwnsObjects : TTestString;
var
  HT: TFPObjectHashTable;
  O1: TMyObject;
  Freed: Boolean;
begin
  Result:='';
  HT := TFPObjectHashTable.Create(True);
  Freed := False;
  O1 := TMyObject.Create;
  O1.IsFreed := @Freed;
  HT.Add('Key1', O1);
  HT.Free; // This should free O1 as well
  AssertTrue('Object should be freed when OwnsObjects is true and hash table is freed', Freed);
end;

procedure RegisterTests;
begin
  AddSuite('TFPObjectHashTableTests');
  AddTest('TestCreate', @TFPObjectHashTable_TestCreate, 'TFPObjectHashTableTests');
  AddTest('TestAdd', @TFPObjectHashTable_TestAdd, 'TFPObjectHashTableTests');
  AddTest('TestDelete', @TFPObjectHashTable_TestDelete, 'TFPObjectHashTableTests');
  AddTest('TestClear', @TFPObjectHashTable_TestClear, 'TFPObjectHashTableTests');
  AddTest('TestItemsProperty', @TFPObjectHashTable_TestItemsProperty, 'TFPObjectHashTableTests');
  AddTest('TestFind', @TFPObjectHashTable_TestFind, 'TFPObjectHashTableTests');
  AddTest('TestOwnsObjects', @TFPObjectHashTable_TestOwnsObjects, 'TFPObjectHashTableTests');
end;

end.