utils/Tests/uGenericsTests.pas

unit uGenericsTests;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpcunit, testregistry,
  uutlGenerics;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TTestObject = class
  private
    fData: Integer;
    fOnDestroy: TNotifyEvent;
  public
    property Data: Integer read fData;
    constructor Create(const aData: Integer; const aOnDestroy: TNotifyEvent);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlListTest = class(TTestCase)
  private type
    TTestList = specialize TutlList<TTestObject>;
  private
    fList: TTestList;
    fTestObjs: array[0..9] of TTestObject;
    procedure TestObjectDestroy(aSender: TObject);
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure GetItem;
    procedure SetItem;

    procedure Add;
    procedure Insert;
    procedure IndexOf;

    procedure Exchange;
    procedure Move;

    procedure Delete;
    procedure Extract;
    procedure Remove;
    procedure Clear;

    procedure First;
    procedure PushFirst;
    procedure PopFirst;

    procedure Last;
    procedure PushLast;
    procedure PopLast;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlHashSetTest = class(TTestCase)
  private type
    TTestObjComparer = specialize TutlEventComparer<TTestObject>;
    TTestHashSet = specialize TutlCustomHashSet<TTestObject>;
  private
    fHashSet: TTestHashSet;
    fTestObjs: array[0..9] of TTestObject;
    procedure TestObjectDestroy(aSender: TObject);
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  public
    function CompareTestObjects(const i1, i2: TTestObject): Integer;
  published
    procedure Add;
    procedure Contains;
    procedure IndexOf;
    procedure Remove;
    procedure Delete;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlMapTest = class(TTestCase)
  private type
    TTestMap = specialize TutlMap<Integer, TTestObject>;
  private
    fMap: TTestMap;
    fTestObjs: array[0..9] of TTestObject;
    fLastRemovedIndex: Integer;
    procedure TestObjectDestroy(aSender: TObject);
    function Key(const aIndex: Integer): Integer;
    function CreateObj: TTestObject;
  protected
    procedure SetUp; override;
    procedure TearDown; override;

    procedure AddExistingKey;
  published
    procedure GetValue;
    procedure SetValue;
    procedure GetValueAt;
    procedure SetValueAt;
    procedure GetKey;
    procedure Add;
    procedure IndexOf;
    procedure Delete;
  end;


implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TTestObject///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TTestObject.Create(const aData: Integer; const aOnDestroy: TNotifyEvent);
begin
  inherited Create;
  fData      := aData;
  fOnDestroy := aOnDestroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TTestObject.Destroy;
begin
  if Assigned(fOnDestroy) then
    fOnDestroy(self);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlListTest//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.TestObjectDestroy(aSender: TObject);
var
  i: Integer;
begin
  for i := Low(fTestObjs) to High(fTestObjs) do
    if (fTestObjs[i] = aSender) then
      fTestObjs[i] := nil;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.SetUp;
var
  i: Integer;
begin
  inherited SetUp;
  fList := TTestList.Create(true);
  for i := Low(fTestObjs) to High(fTestObjs) do begin
    fTestObjs[i] := TTestObject.Create(i, @TestObjectDestroy);
    fList.Add(fTestObjs[i]);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.TearDown;
begin
  FreeAndNil(fList);
  inherited TearDown;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.GetItem;
var
  i: Integer;
begin
  for i := Low(fTestObjs) to High(fTestObjs) do
    AssertTrue(fTestObjs[i] = fList[i - Low(fTestObjs)]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.SetItem;
var
  o1, o2: TTestObject;
begin
  o1 := fList[3];
  o2 := fList[6];
  fList[3] := o2;
  fList[6] := o1;
  AssertTrue(fList[6] = o1);
  AssertTrue(fList[3] = o2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Add;
var
  t: TTestObject;
  c: Integer;
begin
  t := TTestObject.Create(123456, @TestObjectDestroy);
  c := fList.Count;
  fList.Add(t);
  AssertEquals(c+1, fList.Count);
  AssertTrue(fList[c]   = t);
  AssertTrue(fList.Last = t);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Insert;
var
  t: TTestObject;
  c: Integer;
begin
  t := TTestObject.Create(123456, @TestObjectDestroy);
  c := fList.Count;
  fList.Insert(3, t);
  AssertEquals(c+1, fList.Count);
  AssertTrue(fList[3] = t);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.IndexOf;
var
  i: Integer;
begin
  for i := Low(fTestObjs) to High(fTestObjs) do
    AssertEquals(i - Low(fTestObjs), fList.IndexOf(fTestObjs[i]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Exchange;
var
  o1, o2: TTestObject;
begin
  o1 := fList[3];
  o2 := fList[7];
  fList.Exchange(3, 7);
  AssertTrue(fList[3] = o2);
  AssertTrue(fList[7] = o1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Move;
begin
  fList.Move(3, 6);
  AssertTrue(fList[3] = fTestObjs[4]);
  AssertTrue(fList[4] = fTestObjs[5]);
  AssertTrue(fList[5] = fTestObjs[6]);
  AssertTrue(fList[6] = fTestObjs[3]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Delete;
begin
  fList.Delete(3);
  AssertTrue(fTestObjs[3] = nil);
  AssertEquals(Length(fTestObjs)-1, fList.Count);

  fList.OwnsObjects := false;
  fList.Delete(4);
  AssertTrue(fTestObjs[5] <> nil);
  AssertEquals(Length(fTestObjs)-2, fList.Count);
  AssertTrue(fList[4] = fTestObjs[6]);
  FreeAndNil(fTestObjs[5]);
  fList.OwnsObjects := true;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Extract;
var
  o1, o2, o3: TTestObject;
begin
  o1 := fList[1];
  o2 := TTestObject.Create(1234, @TestObjectDestroy);
  o3 := fList.Extract(o1, o2);
  try
    AssertTrue(o1 = o3);
    AssertEquals(Length(fTestObjs)-1, fList.Count);
    AssertTrue(fTestObjs[1] <> nil);
  finally
    FreeAndNil(o1);
    FreeAndNil(o2);
  end;

  o1 := fList[1];
  o2 := TTestObject.Create(1234, @TestObjectDestroy);
  o3 := fList.Extract(o2, o1);
  try
    AssertTrue(o1 = o3);
    AssertEquals(Length(fTestObjs)-1, fList.Count);
  finally
    FreeAndNil(o2);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Remove;
var
  o1: TTestObject;
  i: Integer;
begin
  o1 := fList[3];
  i := fList.Remove(o1);
  AssertEquals(3, i);
  AssertEquals(Length(fTestObjs)-1, fList.Count);
  AssertTrue(fTestObjs[3] = nil);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Clear;
var
  o: TTestObject;
begin
  fList.Clear;
  AssertEquals(0, fList.Count);
  for o in fTestObjs do
    AssertTrue(o = nil);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.First;
begin
  AssertTrue(fTestObjs[Low(fTestObjs)] = fList.First);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.PushFirst;
var
  o1: TTestObject;
begin
  o1 := TTestObject.Create(1234, @TestObjectDestroy);
  fList.PushFirst(o1);
  AssertEquals(Length(fTestObjs)+1, fList.Count);
  AssertTrue(fList.First = o1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.PopFirst;
var
  o1: TTestObject;
begin
  o1 := fList.PopFirst;
  AssertEquals(Length(fTestObjs)-1, fList.Count);
  AssertTrue(o1 = fTestObjs[0]);
  FreeAndNil(o1);

  o1 := fList.PopFirst(true);
  AssertEquals(Length(fTestObjs)-2, fList.Count);
  AssertTrue(o1 = nil);
  AssertTrue(fTestObjs[1] = nil);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Last;
begin
  AssertTrue(fTestObjs[High(fTestObjs)] = fList.Last);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.PushLast;
var
  o1: TTestObject;
begin
  o1 := TTestObject.Create(1234, @TestObjectDestroy);
  fList.PushLast(o1);
  AssertEquals(Length(fTestObjs)+1, fList.Count);
  AssertTrue(fList.Last = o1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.PopLast;
var
  o1: TTestObject;
begin
  o1 := fList.PopLast;
  AssertEquals(Length(fTestObjs)-1, fList.Count);
  AssertTrue(o1 = fTestObjs[High(fTestObjs)]);
  FreeAndNil(o1);

  o1 := fList.PopLast(true);
  AssertEquals(Length(fTestObjs)-2, fList.Count);
  AssertTrue(o1 = nil);
  AssertTrue(fTestObjs[High(fTestObjs)-1] = nil);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlHashSetTest///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHashSetTest.TestObjectDestroy(aSender: TObject);
var
  i: Integer;
begin
  for i := Low(fTestObjs) to High(fTestObjs) do
    if (fTestObjs[i] = aSender) then
      fTestObjs[i] := nil;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHashSetTest.SetUp;
var
  i: Integer;
begin
  inherited SetUp;
  fHashSet := TTestHashSet.Create(TTestObjComparer.Create(@CompareTestObjects), true);
  for i := Low(fTestObjs) to High(fTestObjs) do begin
    fTestObjs[i] := TTestObject.Create(i, @TestObjectDestroy);
    fHashSet.Add(fTestObjs[i]);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHashSetTest.TearDown;
begin
  FreeAndNil(fHashSet);
  inherited TearDown;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlHashSetTest.CompareTestObjects(const i1, i2: TTestObject): Integer;
begin
  if (i1.Data < i2.Data) then
    result := -1
  else if (i1.Data > i2.Data) then
    result := 1
  else
    result := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHashSetTest.Add;
var
  o1: TTestObject;
  b: Boolean;
begin
  o1 := TTestObject.Create(1234, @TestObjectDestroy);
  b := fHashSet.Add(o1);
  AssertTrue(b);
  AssertEquals(Length(fTestObjs)+1, fHashSet.Count);

  b := fHashSet.Add(o1);
  AssertFalse(b);
  AssertEquals(Length(fTestObjs)+1, fHashSet.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHashSetTest.Contains;
var
  o1: TTestObject;
  b: Boolean;
begin
  o1 := TTestObject.Create(1234, @TestObjectDestroy);
  try
    b := fHashSet.Contains(fTestObjs[0]);
    AssertTrue(b);

    b := fHashSet.Contains(o1);
    AssertFalse(b);
  finally
    FreeAndNil(o1);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHashSetTest.IndexOf;
var
  o1: TTestObject;
  i: Integer;
begin
  o1 := TTestObject.Create(1234, @TestObjectDestroy);
  try
    i := fHashSet.IndexOf(fTestObjs[4]);
    AssertEquals(4, i);

    i := fHashSet.IndexOf(o1);
    AssertEquals(-1, i);
  finally
    FreeAndNil(o1);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHashSetTest.Remove;
var
  b: Boolean;
begin
  b := fHashSet.Remove(fTestObjs[5]);
  AssertTrue(fTestObjs[5] = nil);
  AssertTrue(b);
  AssertEquals(Length(fTestObjs)-1, fHashSet.Count);

  fHashSet.OwnsObjects := false;
  try
    b := fHashSet.Remove(fTestObjs[0]);
    AssertTrue(fTestObjs[0] <> nil);
    AssertEquals(Length(fTestObjs)-2, fHashSet.Count);
    AssertTrue(b);

    b := fHashSet.Remove(fTestObjs[0]);
    AssertFalse(b);
    AssertEquals(Length(fTestObjs)-2, fHashSet.Count);
  finally
    FreeAndNil(fTestObjs[0]);
    fHashSet.OwnsObjects := true;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHashSetTest.Delete;
begin
  fHashSet.Delete(0);
  AssertEquals(Length(fTestObjs)-1, fHashSet.Count);
  AssertTrue(fTestObjs[0] = nil);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMapTest///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.TestObjectDestroy(aSender: TObject);
var
  i: Integer;
begin
  for i := Low(fTestObjs) to High(fTestObjs) do
    if (fTestObjs[i] = aSender) then begin
      fLastRemovedIndex := i;
      fTestObjs[i] := nil;
      exit;
    end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapTest.Key(const aIndex: Integer): Integer;
begin
  result := fTestObjs[aIndex].Data;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMapTest.CreateObj: TTestObject;
var
  k: Integer;
begin
  repeat
    k := random(10000);
  until not fMap.Contains(k);
  result := TTestObject.Create(k, @TestObjectDestroy);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.SetUp;
var
  i: Integer;
  o: TTestObject;
begin
  inherited SetUp;
  fMap := TTestMap.Create(true);
  Randomize;
  for i := Low(fTestObjs) to High(fTestObjs) do begin
    o := CreateObj;
    fTestObjs[i] := o;
    fMap.Add(o.Data, o);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.TearDown;
begin
  FreeAndNil(fMap);
  inherited TearDown;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.AddExistingKey;
var
  o1: TTestObject;
begin
  o1 := TTestObject.Create(fTestObjs[0].Data, @TestObjectDestroy);
  try
    fMap.Add(o1.Data, o1);
  finally
    FreeAndNil(o1);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.GetValue;
var
  i: Integer;
begin
  for i := Low(fTestObjs) to High(fTestObjs) do
    AssertTrue(fMap[Key(i)] = fTestObjs[i]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.SetValue;
var
  o1, o2: TTestObject;
begin
  o1 := fMap[Key(2)];
  o2 := CreateObj;
  fMap[Key(2)] := o2;
  try
    AssertTrue(fMap[Key(2)] = o2);
  finally
    FreeAndNil(o1);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.GetValueAt;
type
  TIntList = specialize TutlList<Integer>;
  TIntComparer = specialize TutlComparer<Integer>;
var
  o: TTestObject;
  l: TIntList;
  i: Integer;
begin
  l := TIntList.Create;
  try
    for o in fTestObjs do
      l.Add(o.Data);
    l.Sort(TIntComparer.Create);

    for i := 0 to l.Count-1 do
      AssertEquals(l[i], fMap.ValueAt[i].Data);
  finally
    FreeAndNil(l);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.SetValueAt;
var
  o1, o2: TTestObject;
begin
  o1 := fMap.ValueAt[4];
  o2 := TTestObject.Create(o1.Data, @TestObjectDestroy);
  fMap.ValueAt[4] := o2;
  try
    AssertTrue(fMap.ValueAt[4] = o2);
  finally
    FreeAndNil(o1);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.GetKey;
type
  TIntList = specialize TutlList<Integer>;
  TIntComparer = specialize TutlComparer<Integer>;
var
  o: TTestObject;
  l: TIntList;
  i: Integer;
begin
  l := TIntList.Create;
  try
    for o in fTestObjs do
      l.Add(o.Data);
    l.Sort(TIntComparer.Create);

    for i := 0 to l.Count-1 do
      AssertEquals(l[i], fMap.Keys[i]);
  finally
    FreeAndNil(l);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.Add;
var
  o1: TTestObject;
begin
  o1 := CreateObj;
  fMap.Add(o1.Data, o1);
  AssertEquals(Length(fTestObjs)+1, fMap.Count);

  AssertException(EutlMap, @AddExistingKey);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.IndexOf;
type
  TIntList = specialize TutlList<Integer>;
  TIntComparer = specialize TutlComparer<Integer>;
var
  o: TTestObject;
  l: TIntList;
begin
  l := TIntList.Create;
  try
    for o in fTestObjs do
      l.Add(o.Data);
    l.Sort(TIntComparer.Create);

    for o in fTestObjs do
      AssertEquals(l.IndexOf(o.Data), fMap.IndexOf(o.Data));
  finally
    FreeAndNil(l);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTest.Delete;
var
  i: Integer;
begin
  for i := Low(fTestObjs) to High(fTestObjs) do begin
    fMap.Delete(Key(i));
    AssertNull(fTestObjs[i]);
    AssertEquals('Count', Length(fTestObjs)-i-1, fMap.Count);
    AssertEquals('Index', fLastRemovedIndex, i);
  end;
end;

initialization
  RegisterTest(TutlListTest);
  RegisterTest(TutlHashSetTest);
  RegisterTest(TutlMapTest);

end.