diff --git a/.gitignore b/.gitignore
index 9b19d45..f49a21d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,9 +1,5 @@
-*.dbg
+lib/
*.exe
+*.ini
*.log
-*.profraw
-*.heaptrc
-*lib/
-*/cache*
-*.o
-*.ppu
\ No newline at end of file
+*.dbg
\ No newline at end of file
diff --git a/tests/tests.ico b/tests/tests.ico
new file mode 100644
index 0000000..0341321
Binary files /dev/null and b/tests/tests.ico differ
diff --git a/tests/tests.lpi b/tests/tests.lpi
new file mode 100644
index 0000000..c85aaa2
--- /dev/null
+++ b/tests/tests.lpi
@@ -0,0 +1,107 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/tests.lpr b/tests/tests.lpr
new file mode 100644
index 0000000..9fa5f8d
--- /dev/null
+++ b/tests/tests.lpr
@@ -0,0 +1,14 @@
+program tests;
+
+{$mode objfpc}{$H+}
+
+uses
+ Interfaces, Forms, GUITestRunner, uutlQueueTests, uutlStackTests, uutlListTest, uutlAlgorithm, uutlLinkedListTests;
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ RunRegisteredTests;
+end.
+
diff --git a/tests/tests.lps b/tests/tests.lps
new file mode 100644
index 0000000..af8eec2
--- /dev/null
+++ b/tests/tests.lps
@@ -0,0 +1,216 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/tests.res b/tests/tests.res
new file mode 100644
index 0000000..877868c
Binary files /dev/null and b/tests/tests.res differ
diff --git a/tests/uTestHelper.pas b/tests/uTestHelper.pas
new file mode 100644
index 0000000..b556f7c
--- /dev/null
+++ b/tests/uTestHelper.pas
@@ -0,0 +1,90 @@
+unit uTestHelper;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, TestFramework;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TIntfObjOwner = class(TTestCase)
+ private
+ fIntfObjCounter: Integer;
+
+ protected
+ procedure SetUp; override;
+
+ public
+ property IntfObjCounter: Integer read fIntfObjCounter;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TIntfObj = class(TObject, IUnknown)
+ private
+ fOwner: TIntfObjOwner;
+
+ private { IUnknown }
+ fRefCount : longint;
+ function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+ function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+ function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+
+ public
+ constructor Create(const aOwner: TIntfObjOwner);
+ destructor Destroy; override;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TIntfObjOwner/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TIntfObjOwner.SetUp;
+begin
+ inherited SetUp;
+ fIntfObjCounter := 0;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TIntfObj//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TIntfObj.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+ if getinterface(iid,obj)
+ then result := S_OK
+ else result := longint(E_NOINTERFACE);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TIntfObj._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+ _addref := InterLockedIncrement(fRefCount);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TIntfObj._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+ _Release := InterLockedDecrement(fRefCount);
+ if (_Release = 0) then
+ Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TIntfObj.Create(const aOwner: TIntfObjOwner);
+begin
+ inherited Create;
+ fOwner := aOwner;
+ inc(fOwner.fIntfObjCounter);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TIntfObj.Destroy;
+begin
+ dec(fOwner.fIntfObjCounter);
+ inherited Destroy;
+end;
+
+end.
+
diff --git a/tests/uutlLinkedListTests.pas b/tests/uutlLinkedListTests.pas
new file mode 100644
index 0000000..069ae59
--- /dev/null
+++ b/tests/uutlLinkedListTests.pas
@@ -0,0 +1,280 @@
+unit uutlLinkedListTests;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, TestFramework,
+ uTestHelper, uutlGenerics, uutlExceptions;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TIntList = specialize TutlLinkedList;
+ TutlLinkedListTests = class(TTestCase)
+ private
+ fIntList: TIntList;
+
+ procedure AccessPropFirst;
+ procedure AccessPropLast;
+
+ protected
+ procedure SetUp; override;
+ procedure TearDown; override;
+
+ published
+ procedure Prop_Count;
+ procedure Prop_IsEmpty;
+ procedure Prop_First;
+ procedure Prop_Last;
+
+ procedure Meth_PushFirst_PopFirst;
+ procedure Meth_PushLast_PopLast;
+ procedure Meth_InsertBefore;
+ procedure Meth_InsertAfter;
+ procedure Meth_Remove;
+ procedure Meth_Clear;
+
+ procedure Iterator;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlLinkedListTests///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.AccessPropFirst;
+begin
+ fIntList.First;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.AccessPropLast;
+begin
+ fIntList.Last;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.SetUp;
+begin
+ inherited SetUp;
+ fIntList := TIntList.Create(true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.TearDown;
+begin
+ FreeAndNil(fIntList);
+ inherited TearDown;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.Prop_Count;
+begin
+ AssertEquals(0, fIntList.Count);
+ fIntList.PushFirst(123);
+ AssertEquals(1, fIntList.Count);
+ fIntList.PushFirst(234);
+ AssertEquals(2, fIntList.Count);
+ fIntList.PopFirst(true);
+ AssertEquals(1, fIntList.Count);
+ fIntList.PopFirst(true);
+ AssertEquals(0, fIntList.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.Prop_IsEmpty;
+begin
+ AssertEquals(true, fIntList.IsEmpty);
+ fIntList.PushFirst(123);
+ AssertEquals(false, fIntList.IsEmpty);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.Prop_First;
+var
+ i: TIntList.Iterator;
+begin
+ AssertException('empty list does not raise exception when accessing First property', EutlInvalidOperation, @AccessPropFirst);
+ fIntList.PushLast(123);
+ fIntList.PushLast(234);
+ i := fIntList.First;
+ AssertEquals(123, i.Value);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.Prop_Last;
+var
+ i: TIntList.Iterator;
+begin
+ AssertException('empty list does not raise exception when accessing First property', EutlInvalidOperation, @AccessPropLast);
+ fIntList.PushLast(123);
+ fIntList.PushLast(234);
+ i := fIntList.Last;
+ AssertEquals(234, i.Value);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.Meth_PushFirst_PopFirst;
+begin
+ fIntList.PushFirst(123);
+ AssertEquals(123, fIntList.First.Value);
+ fIntList.PushFirst(234);
+ AssertEquals(234, fIntList.First.Value);
+ fIntList.PushFirst(345);
+ AssertEquals(345, fIntList.First.Value);
+ fIntList.PushFirst(456);
+ AssertEquals(456, fIntList.First.Value);
+
+ AssertEquals(456, fIntList.PopFirst(false));
+ AssertEquals(345, fIntList.First.Value);
+ AssertEquals( 0, fIntList.PopFirst(true));
+ AssertEquals(234, fIntList.First.Value);
+ AssertEquals(234, fIntList.PopFirst(false));
+ AssertEquals(123, fIntList.First.Value);
+ AssertEquals( 0, fIntList.PopFirst(true));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.Meth_PushLast_PopLast;
+begin
+ fIntList.PushLast(123);
+ AssertEquals(123, fIntList.Last.Value);
+ fIntList.PushLast(234);
+ AssertEquals(234, fIntList.Last.Value);
+ fIntList.PushLast(345);
+ AssertEquals(345, fIntList.Last.Value);
+ fIntList.PushLast(456);
+ AssertEquals(456, fIntList.Last.Value);
+
+ AssertEquals(456, fIntList.PopLast(false));
+ AssertEquals(345, fIntList.Last.Value);
+ AssertEquals( 0, fIntList.PopLast(true));
+ AssertEquals(234, fIntList.Last.Value);
+ AssertEquals(234, fIntList.PopLast(false));
+ AssertEquals(123, fIntList.Last.Value);
+ AssertEquals( 0, fIntList.PopLast(true));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.Meth_InsertBefore;
+var
+ it: TIntList.Iterator;
+begin
+ fIntList.PushLast(123);
+ fIntList.PushLast(234);
+ fIntList.PushLast(345);
+ fIntList.PushLast(456);
+
+ it := fIntList.First;
+ fIntList.InsertBefore(it, 999);
+ AssertTrue(it.MovePrev);
+ AssertEquals(999, it.Value);
+ AssertEquals(5, fIntList.Count);
+
+ it := fIntList.Last;
+ fIntList.InsertBefore(it, 888);
+ AssertTrue(it.MovePrev);
+ AssertEquals(888, it.Value);
+ AssertEquals(6, fIntList.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.Meth_InsertAfter;
+var
+ it: TIntList.Iterator;
+begin
+ fIntList.PushLast(123);
+ fIntList.PushLast(234);
+ fIntList.PushLast(345);
+ fIntList.PushLast(456);
+
+ it := fIntList.First;
+ fIntList.InsertAfter(it, 999);
+ AssertTrue(it.MoveNext);
+ AssertEquals(999, it.Value);
+ AssertEquals(5, fIntList.Count);
+
+ it := fIntList.Last;
+ fIntList.InsertAfter(it, 888);
+ AssertTrue(it.MoveNext);
+ AssertEquals(888, it.Value);
+ AssertEquals(6, fIntList.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.Meth_Remove;
+var
+ it: TIntList.Iterator;
+begin
+ fIntList.PushLast(123);
+ fIntList.PushLast(234);
+ fIntList.PushLast(345);
+ fIntList.PushLast(456);
+
+ it := fIntList.First;
+ it.MoveNext;
+ fIntList.Remove(it);
+
+ AssertEquals(3, fIntList.Count);
+ AssertEquals(123, fIntList.First.Value);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.Meth_Clear;
+begin
+ fIntList.PushLast(123);
+ fIntList.PushLast(234);
+ fIntList.PushLast(345);
+ fIntList.PushLast(456);
+
+ AssertEquals(4, fIntList.Count);
+ fIntList.Clear;
+
+ AssertEquals(0, fIntList.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.Iterator;
+var
+ it1: TIntList.Iterator;
+begin
+ fIntList.PushLast(123);
+ fIntList.PushLast(234);
+ fIntList.PushLast(345);
+ fIntList.PushLast(456);
+
+ it1 := fIntList.First;
+ AssertEquals(123, it1.Value);
+ AssertTrue (it1.IsValid);
+ AssertTrue (it1.Equals(fIntList.First));
+ AssertTrue (it1.MoveNext);
+ AssertEquals(234, it1.Value);
+ AssertTrue (it1.MoveNext);
+ AssertEquals(345, it1.Value);
+ AssertTrue (it1.MoveNext);
+ AssertEquals(456, it1.Value);
+ AssertTrue (it1.Equals(fIntList.Last));
+ AssertFalse (it1.MoveNext);
+ fIntList.PopLast;
+ AssertFalse (it1.IsValid);
+
+ it1 := fIntList.Last;
+ AssertEquals(345, it1.Value);
+ AssertTrue (it1.IsValid);
+ AssertTrue (it1.Equals(fIntList.Last));
+ AssertTrue (it1.MovePrev);
+ AssertEquals(234, it1.Value);
+ AssertTrue (it1.MovePrev);
+ AssertEquals(123, it1.Value);
+ AssertTrue (it1.Equals(fIntList.First));
+ AssertFalse (it1.MovePrev);
+ fIntList.PopFirst;
+ AssertFalse (it1.IsValid);
+end;
+
+initialization
+ RegisterTest(TutlLinkedListTests.Suite);
+
+end.
+
diff --git a/tests/uutlListTest.pas b/tests/uutlListTest.pas
new file mode 100644
index 0000000..1f168d2
--- /dev/null
+++ b/tests/uutlListTest.pas
@@ -0,0 +1,430 @@
+unit uutlListTest;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, TestFramework, contnrs,
+ uTestHelper, uutlGenerics;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TIntList = specialize TutlList;
+ TIntfList = specialize TutlList;
+ TObjList = specialize TutlList;
+
+ TutlListTest = class(TIntfObjOwner)
+ private
+ fIntList: TIntList;
+ fIntfList: TIntfList;
+ fObjList: TObjList;
+
+ protected
+ procedure SetUp; override;
+ procedure TearDown; override;
+
+ published
+ procedure Prop_Count;
+ procedure Prop_First;
+ procedure Prop_last;
+ procedure Prop_Items;
+
+ procedure Meth_Add;
+ procedure Meth_Insert;
+ procedure Meth_Exchange;
+ procedure Meth_Move;
+ procedure Meth_Delete;
+ procedure Meth_Extract;
+ procedure Meth_PushFirst;
+ procedure Meth_PopFirst;
+ procedure Meth_PushLast;
+ procedure Meth_PopLast;
+ procedure Dtor_FreesAllItems;
+ procedure Meth_IndexOf;
+ procedure Meth_Extract_WithDefault;
+ procedure Meth_Remove;
+
+ procedure AddRemoveInterfaces;
+ procedure AddRemoveObject_OwnedByList;
+ procedure AddRemoveObject_NotOwnedByList;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlListTest//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.SetUp;
+begin
+ inherited SetUp;
+ fIntList := TIntList.Create(true);
+ fIntfList := TIntfList.Create(true);
+ fObjList := TObjList.Create(true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.TearDown;
+begin
+ FreeAndNil(fIntList);
+ FreeAndNil(fIntfList);
+ FreeAndNil(fObjList);
+ inherited TearDown;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Prop_Count;
+begin
+ AssertEquals(0, fIntList.Count);
+ fIntList.Add(123);
+ AssertEquals(1, fIntList.Count);
+ fIntList.Add(234);
+ AssertEquals(2, fIntList.Count);
+ fIntList.Add(345);
+ AssertEquals(3, fIntList.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Prop_First;
+begin
+ fIntList.Add(123);
+ AssertEquals(123, fIntList.First);
+ fIntList.Add(456);
+ AssertEquals(123, fIntList.First);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Prop_last;
+begin
+ fIntList.Add(123);
+ AssertEquals(123, fIntList.Last);
+ fIntList.Add(456);
+ AssertEquals(456, fIntList.Last);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Prop_Items;
+begin
+ fIntList.Add(123);
+ fIntList.Add(234);
+ fIntList.Add(345);
+ fIntList.Add(456);
+ AssertEquals(123, fIntList[0]);
+ AssertEquals(234, fIntList[1]);
+ AssertEquals(345, fIntList[2]);
+ AssertEquals(456, fIntList[3]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_Add;
+begin
+ fIntList.Add(123);
+ AssertEquals(fIntList.Count, 1);
+ AssertEquals(123, fIntList[0]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_Insert;
+begin
+ fIntList.Insert(0, 123);
+ fIntList.Insert(0, 456);
+ AssertEquals(fIntList.Count, 2);
+ AssertEquals(123, fIntList[1]);
+ AssertEquals(456, fIntList[0]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_Exchange;
+begin
+ fIntList.Add(123);
+ fIntList.Add(234);
+ fIntList.Add(345);
+ fIntList.Add(456);
+ fIntList.Add(567);
+ fIntList.Exchange(1, 3);
+ AssertEquals(123, fIntList[0]);
+ AssertEquals(456, fIntList[1]);
+ AssertEquals(345, fIntList[2]);
+ AssertEquals(234, fIntList[3]);
+ AssertEquals(567, fIntList[4]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_Move;
+begin
+ fIntList.Add(123);
+ fIntList.Add(234);
+ fIntList.Add(345);
+ fIntList.Add(456);
+ fIntList.Add(567);
+ fIntList.Move(1, 3);
+ AssertEquals(123, fIntList[0]);
+ AssertEquals(345, fIntList[1]);
+ AssertEquals(456, fIntList[2]);
+ AssertEquals(234, fIntList[3]);
+ AssertEquals(567, fIntList[4]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_Delete;
+begin
+ fIntList.Add(123);
+ fIntList.Add(234);
+ fIntList.Add(345);
+ fIntList.Add(456);
+ fIntList.Add(567);
+ fIntList.Delete(2);
+ AssertEquals(4, fIntList.Count);
+ AssertEquals(456, fIntList[2]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_Extract;
+begin
+ fIntList.Add(123);
+ fIntList.Add(234);
+ fIntList.Add(345);
+ fIntList.Add(456);
+ fIntList.Add(567);
+ AssertEquals(234, fIntList.Extract(1));
+ AssertEquals(4, fIntList.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_PushFirst;
+begin
+ fIntList.PushFirst(123);
+ fIntList.PushFirst(234);
+ AssertEquals(2, fIntList.Count);
+ AssertEquals(123, fIntList[1]);
+ AssertEquals(234, fIntList[0]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_PopFirst;
+begin
+ fIntList.Add(123);
+ fIntList.Add(234);
+ fIntList.Add(345);
+ fIntList.Add(456);
+ fIntList.Add(567);
+ AssertEquals(123, fIntList.PopFirst(false));
+ AssertEquals(234, fIntList.PopFirst(false));
+ AssertEquals(3, fIntList.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_PushLast;
+begin
+ fIntList.PushLast(123);
+ fIntList.PushLast(234);
+ fIntList.PushLast(345);
+ AssertEquals(3, fIntList.Count);
+ AssertEquals(123, fIntList[0]);
+ AssertEquals(234, fIntList[1]);
+ AssertEquals(345, fIntList[2]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_PopLast;
+begin
+ fIntList.Add(123);
+ fIntList.Add(234);
+ fIntList.Add(345);
+ fIntList.Add(456);
+ fIntList.Add(567);
+ AssertEquals(567, fIntList.PopLast(false));
+ AssertEquals(456, fIntList.PopLast(false));
+ AssertEquals(3, fIntList.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Dtor_FreesAllItems;
+begin
+ fObjList.Add(TIntfObj.Create(self));
+ fObjList.Add(TIntfObj.Create(self));
+ FreeAndNil(fObjList);
+ AssertEquals(0, IntfObjCounter);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_IndexOf;
+begin
+ fIntList.Add(123);
+ fIntList.Add(234);
+ fIntList.Add(345);
+ fIntList.Add(456);
+ fIntList.Add(567);
+ AssertEquals( 1, fIntList.IndexOf(234));
+ AssertEquals( 3, fIntList.IndexOf(456));
+ AssertEquals(-1, fIntList.IndexOf(999));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_Extract_WithDefault;
+begin
+ fIntList.Add(123);
+ fIntList.Add(234);
+ fIntList.Add(345);
+ fIntList.Add(456);
+ fIntList.Add(567);
+ AssertEquals(234, fIntList.Extract(234, 999));
+ AssertEquals(999, fIntList.Extract(234, 999));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.Meth_Remove;
+begin
+ fIntList.Add(123);
+ fIntList.Add(234);
+ fIntList.Add(345);
+ fIntList.Add(456);
+ fIntList.Add(567);
+ fIntList.Remove(234);
+ AssertEquals(4, fIntList.Count);
+ AssertEquals(345, fIntList[1]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.AddRemoveInterfaces;
+var
+ i1: IUnknown;
+begin
+ fIntfList.Add(TIntfObj.Create(self));
+ fIntfList.Add(TIntfObj.Create(self));
+ fIntfList.Add(TIntfObj.Create(self));
+ fIntfList.Exchange(0, 2);
+ fIntfList.Move(0, 2);
+ fIntfList.Delete(0);
+ fIntfList.Extract(0);
+ fIntfList.Clear;
+
+ fIntfList.Insert(0, TIntfObj.Create(self));
+ fIntfList.PopLast(true);
+
+ fIntfList.Insert(0, TIntfObj.Create(self));
+ fIntfList.PopLast(false);
+
+ fIntfList.Insert(0, TIntfObj.Create(self));
+ fIntfList.PopFirst(true);
+
+ fIntfList.Insert(0, TIntfObj.Create(self));
+ fIntfList.PopFirst(false);
+
+ i1 := TIntfObj.Create(self);
+ fIntfList.Insert(0, i1);
+ fIntfList.Extract(i1, nil);
+ i1 := nil;
+
+ i1 := TIntfObj.Create(self);
+ fIntfList.Insert(0, i1);
+ fIntfList.Remove(i1);
+ i1 := nil;
+
+ fIntfList.Add(TIntfObj.Create(self));
+ fIntfList[0] := TIntfObj.Create(self);
+ fIntfList.Clear;
+
+ AssertEquals(0, IntfObjCounter);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.AddRemoveObject_OwnedByList;
+
+ function CreateObj: TObject;
+ begin
+ result := TIntfObj.Create(self);
+ end;
+
+begin
+ fObjList.Add(CreateObj);
+ fObjList.Add(CreateObj);
+ fObjList.Add(CreateObj);
+ fObjList.Exchange(0, 2);
+ fObjList.Move(0, 2);
+ fObjList.Delete(0);
+ fObjList.Extract(0).Free;
+ fObjList.Clear;
+
+ fObjList.Add(CreateObj);
+ fObjList.PopLast(true);
+
+ fObjList.Add(CreateObj);
+ fObjList.PopLast(false).Free;
+
+ fObjList.Add(CreateObj);
+ fObjList.PopFirst(true);
+
+ fObjList.Add(CreateObj);
+ fObjList.PopFirst(false).Free;
+
+ fObjList.Add(CreateObj);
+ fObjList.Extract(fObjList[0], nil).Free;
+
+ fObjList.Add(CreateObj);
+ fObjList.Remove(fObjList[0]);
+
+ fObjList.Add(CreateObj);
+ fObjList[0] := CreateObj;
+ fObjList.Clear;
+
+ AssertEquals(0, IntfObjCounter);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlListTest.AddRemoveObject_NotOwnedByList;
+var
+ lst: TObjectList;
+
+ function CreateObj: TObject;
+ begin
+ result := TIntfObj.Create(self);
+ lst.Add(result);
+ end;
+
+begin
+ lst := TObjectList.Create(true);
+ try
+ fObjList.OwnsItems := false;
+
+ fObjList.Add(CreateObj);
+ fObjList.Add(CreateObj);
+ fObjList.Add(CreateObj);
+ fObjList.Exchange(0, 2);
+ fObjList.Move(0, 2);
+ fObjList.Delete(0);
+ fObjList.Extract(0);
+ fObjList.Clear;
+
+ fObjList.Add(CreateObj);
+ fObjList.PopLast(true);
+
+ fObjList.Add(CreateObj);
+ fObjList.PopLast(false);
+
+ fObjList.Add(CreateObj);
+ fObjList.PopFirst(true);
+
+ fObjList.Add(CreateObj);
+ fObjList.PopFirst(false);
+
+ fObjList.Add(CreateObj);
+ fObjList.Extract(fObjList[0], nil);
+
+ fObjList.Add(CreateObj);
+ fObjList.Remove(fObjList[0]);
+
+ fObjList.Add(CreateObj);
+ fObjList[0] := CreateObj;
+ fObjList.Clear;
+ finally
+ FreeAndNil(lst);
+ end;
+ AssertEquals(0, IntfObjCounter);
+end;
+
+initialization
+ RegisterTest(TutlListTest.Suite);
+
+end.
+
diff --git a/tests/uutlQueueTests.pas b/tests/uutlQueueTests.pas
new file mode 100644
index 0000000..32021d6
--- /dev/null
+++ b/tests/uutlQueueTests.pas
@@ -0,0 +1,264 @@
+unit uutlQueueTests;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, TestFramework, contnrs, uTestHelper,
+ uutlGenerics;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TIntQueue = specialize TutlQueue;
+ TIntfQueue = specialize TutlQueue;
+ TObjQueue = specialize TutlQueue;
+ TutlQueueTests = class(TIntfObjOwner)
+ private
+ fIntQueue: TIntQueue;
+ fIntfQueue: TIntfQueue;
+ fObjQueue: TObjQueue;
+
+ protected
+ procedure SetUp; override;
+ procedure TearDown; override;
+
+ published
+ procedure Prop_Count;
+ procedure Prop_Empty;
+ procedure Meth_Peek;
+ procedure Meth_EnqueueDequeue1000Times;
+ procedure Meth_EnqueueDequeue1000Items;
+ procedure Meth_EnqueueDequeue1000Items1000Times;
+ procedure Meth_EnqueueDequeue100Interfaces;
+ procedure Meth_EnqueueDequeue100_ObjectOwned_WithFree;
+ procedure Meth_EnqueueDequeue100_ObjectOwned_WithoutFree;
+ procedure Meth_EnqueueDequeue100_ObjectNotOwned_WithFree;
+ procedure Meth_EnqueueDequeue100_ObjectNotOwned_WithoutFree;
+ procedure Dtor_FreesAllItems;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlQueueTests////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.SetUp;
+begin
+ inherited SetUp;
+ fIntQueue := TIntQueue.Create(true);
+ fIntfQueue := TIntfQueue.Create(true);
+ fObjQueue := TObjQueue.Create(true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.TearDown;
+begin
+ FreeAndNil(fIntQueue);
+ FreeAndNil(fIntfQueue);
+ FreeAndNil(fObjQueue);
+ inherited TearDown;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Prop_Count;
+begin
+ AssertEquals(0, fIntQueue.Count);
+ fIntQueue.Enqueue(123);
+ AssertEquals(1, fIntQueue.Count);
+ fIntQueue.Enqueue(234);
+ AssertEquals(2, fIntQueue.Count);
+ fIntQueue.Enqueue(345);
+ AssertEquals(3, fIntQueue.Count);
+ fIntQueue.Dequeue;
+ AssertEquals(2, fIntQueue.Count);
+ fIntQueue.Dequeue;
+ AssertEquals(1, fIntQueue.Count);
+ fIntQueue.Dequeue;
+ AssertEquals(0, fIntQueue.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Prop_Empty;
+begin
+ AssertEquals(true, fIntQueue.IsEmpty);
+ fIntQueue.Enqueue(345);
+ AssertEquals(false, fIntQueue.IsEmpty);
+ fIntQueue.Dequeue;
+ AssertEquals(true, fIntQueue.IsEmpty);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Meth_Peek;
+begin
+ fIntQueue.Enqueue(123);
+ AssertEquals(123, fIntQueue.Peek);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Meth_EnqueueDequeue1000Times;
+var
+ i, tmp: Integer;
+begin
+ for i := 0 to 1000 do begin
+ fIntQueue.Enqueue(i);
+ tmp := fIntQueue.Dequeue;
+ AssertEquals(i, tmp);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Meth_EnqueueDequeue1000Items;
+var
+ i, tmp: Integer;
+begin
+ for i := 0 to 1000 do
+ fIntQueue.Enqueue(i);
+ for i := 0 to 1000 do begin
+ tmp := fIntQueue.Dequeue;
+ AssertEquals(i, tmp);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Meth_EnqueueDequeue1000Items1000Times;
+var
+ i, j, tmp: Integer;
+begin
+ for j := 0 to 1000 do begin
+ for i := 0 to 1000 do
+ fIntQueue.Enqueue(i);
+ for i := 0 to 1000 do begin
+ tmp := fIntQueue.Dequeue;
+ AssertEquals(i, tmp);
+ end;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Meth_EnqueueDequeue100Interfaces;
+var
+ i: Integer;
+begin
+ for i := 0 to 100 do begin
+ fIntfQueue.Enqueue(TIntfObj.Create(self));
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ for i := 0 to 100 do begin
+ fIntfQueue.Dequeue;
+ AssertEquals(100 - i, IntfObjCounter);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Meth_EnqueueDequeue100_ObjectOwned_WithFree;
+var
+ i: Integer;
+begin
+ for i := 0 to 100 do begin
+ fObjQueue.Enqueue(TIntfObj.Create(self));
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ for i := 0 to 100 do begin
+ AssertNull('dequeue returned non-zero item', fObjQueue.Dequeue(true));
+ AssertEquals(100 - i, IntfObjCounter);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Meth_EnqueueDequeue100_ObjectOwned_WithoutFree;
+var
+ i: Integer;
+ lst: TObjectList;
+ obj: TObject;
+begin
+ for i := 0 to 100 do begin
+ fObjQueue.Enqueue(TIntfObj.Create(self));
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ for i := 0 to 100 do begin
+ fObjQueue.Dequeue(true);
+ AssertEquals(100 - i, IntfObjCounter);
+ end;
+
+ // free on dequeue
+ for i := 0 to 100 do begin
+ fObjQueue.Enqueue(TIntfObj.Create(self));
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ lst := TObjectList.Create(true);
+ try
+ for i := 0 to 100 do begin
+ obj := fObjQueue.Dequeue(false);
+ AssertNotNull('dequeue returned zero item', obj);
+ lst.Add(obj);
+ AssertEquals(101, IntfObjCounter);
+ end;
+ finally
+ FreeAndNil(lst);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Meth_EnqueueDequeue100_ObjectNotOwned_WithFree;
+var
+ lst: TObjectList;
+ obj: TObject;
+ i: Integer;
+begin
+ lst := TObjectList.Create(true);
+ try
+ for i := 0 to 100 do begin
+ obj := TIntfObj.Create(self);
+ lst.Add(obj);
+ fObjQueue.Enqueue(obj);
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ fObjQueue.OwnsItems := false;
+ for i := 0 to 100 do begin
+ AssertNull('dequeue returned non-zero item', fObjQueue.Dequeue(true));
+ AssertEquals(101, IntfObjCounter);
+ end;
+ finally
+ FreeAndNil(lst);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Meth_EnqueueDequeue100_ObjectNotOwned_WithoutFree;
+var
+ lst: TObjectList;
+ obj: TObject;
+ i: Integer;
+begin
+ lst := TObjectList.Create(true);
+ try
+ for i := 0 to 100 do begin
+ obj := TIntfObj.Create(self);
+ lst.Add(obj);
+ fObjQueue.Enqueue(obj);
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ fObjQueue.OwnsItems := false;
+ for i := 0 to 100 do begin
+ AssertNotNull('dequeue returned zero item', fObjQueue.Dequeue(false));
+ AssertEquals(101, IntfObjCounter);
+ end;
+ finally
+ FreeAndNil(lst);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlQueueTests.Dtor_FreesAllItems;
+begin
+ fObjQueue.Enqueue(TIntfObj.Create(self));
+ FreeAndNil(fObjQueue);
+ AssertEquals(0, IntfObjCounter);
+end;
+
+initialization
+ RegisterTest(TutlQueueTests.Suite);
+
+end.
+
diff --git a/tests/uutlStackTests.pas b/tests/uutlStackTests.pas
new file mode 100644
index 0000000..04188d0
--- /dev/null
+++ b/tests/uutlStackTests.pas
@@ -0,0 +1,264 @@
+unit uutlStackTests;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, TestFramework, Contnrs,
+ uTestHelper, uutlGenerics;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TIntStack = specialize TutlStack;
+ TIntfStack = specialize TutlStack;
+ TObjStack = specialize TutlStack;
+ TutlStackTests = class(TIntfObjOwner)
+ private
+ fIntStack: TIntStack;
+ fIntfStack: TIntfStack;
+ fObjStack: TObjStack;
+
+ protected
+ procedure SetUp; override;
+ procedure TearDown; override;
+
+ published
+ procedure Prop_Count;
+ procedure Prop_Empty;
+ procedure Meth_Peek;
+ procedure Meth_PushPop1000Times;
+ procedure Meth_PushPop1000Items;
+ procedure Meth_PushPop1000Items1000Times;
+ procedure Meth_PushPop100Interfaces;
+ procedure Meth_PushPop100_ObjectOwned_WithFree;
+ procedure Meth_PushPop100_ObjectOwnedByStack_WithoutFree;
+ procedure Meth_PushPop100_ObjectNotOwned_WithFree;
+ procedure Meth_PushPop100_ObjectNotOwned_WithoutFree;
+ procedure Dtor_FreesAllItems;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlStackTests////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.SetUp;
+begin
+ inherited SetUp;
+ fIntStack := TIntStack.Create(true);
+ fIntfStack := TIntfStack.Create(true);
+ fObjStack := TObjStack.Create(true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.TearDown;
+begin
+ FreeAndNil(fIntStack);
+ FreeAndNil(fIntfStack);
+ FreeAndNil(fObjStack);
+ inherited TearDown;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Prop_Count;
+begin
+ AssertEquals(0, fIntStack.Count);
+ fIntStack.Push(123);
+ AssertEquals(1, fIntStack.Count);
+ fIntStack.Push(234);
+ AssertEquals(2, fIntStack.Count);
+ fIntStack.Push(345);
+ AssertEquals(3, fIntStack.Count);
+ fIntStack.Pop;
+ AssertEquals(2, fIntStack.Count);
+ fIntStack.Pop;
+ AssertEquals(1, fIntStack.Count);
+ fIntStack.Pop;
+ AssertEquals(0, fIntStack.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Prop_Empty;
+begin
+ AssertEquals(true, fIntStack.IsEmpty);
+ fIntStack.Push(345);
+ AssertEquals(false, fIntStack.IsEmpty);
+ fIntStack.Pop;
+ AssertEquals(true, fIntStack.IsEmpty);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Meth_Peek;
+begin
+ fIntStack.Push(123);
+ AssertEquals(123, fIntStack.Peek);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Meth_PushPop1000Times;
+var
+ i, tmp: Integer;
+begin
+ for i := 0 to 1000 do begin
+ fIntStack.Push(i);
+ tmp := fIntStack.Pop;
+ AssertEquals(i, tmp);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Meth_PushPop1000Items;
+var
+ i, tmp: Integer;
+begin
+ for i := 0 to 1000 do
+ fIntStack.Push(i);
+ for i := 0 to 1000 do begin
+ tmp := fIntStack.Pop;
+ AssertEquals(1000-i, tmp);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Meth_PushPop1000Items1000Times;
+var
+ i, j, tmp: Integer;
+begin
+ for j := 0 to 1000 do begin
+ for i := 0 to 1000 do
+ fIntStack.Push(i);
+ for i := 0 to 1000 do begin
+ tmp := fIntStack.Pop;
+ AssertEquals(1000-i, tmp);
+ end;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Meth_PushPop100Interfaces;
+var
+ i: Integer;
+begin
+ for i := 0 to 100 do begin
+ fIntfStack.Push(TIntfObj.Create(self));
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ for i := 0 to 100 do begin
+ fIntfStack.Pop;
+ AssertEquals(100 - i, IntfObjCounter);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Meth_PushPop100_ObjectOwned_WithFree;
+var
+ i: Integer;
+begin
+ for i := 0 to 100 do begin
+ fObjStack.Push(TIntfObj.Create(self));
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ for i := 0 to 100 do begin
+ AssertNull('Pop returned non-zero item', fObjStack.Pop(true));
+ AssertEquals(100 - i, IntfObjCounter);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Meth_PushPop100_ObjectOwnedByStack_WithoutFree;
+var
+ i: Integer;
+ lst: TObjectList;
+ obj: TObject;
+begin
+ for i := 0 to 100 do begin
+ fObjStack.Push(TIntfObj.Create(self));
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ for i := 0 to 100 do begin
+ fObjStack.Pop(true);
+ AssertEquals(100 - i, IntfObjCounter);
+ end;
+
+ // free on Pop
+ for i := 0 to 100 do begin
+ fObjStack.Push(TIntfObj.Create(self));
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ lst := TObjectList.Create(true);
+ try
+ for i := 0 to 100 do begin
+ obj := fObjStack.Pop(false);
+ AssertNotNull('Pop returned zero item', obj);
+ lst.Add(obj);
+ AssertEquals(101, IntfObjCounter);
+ end;
+ finally
+ FreeAndNil(lst);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Meth_PushPop100_ObjectNotOwned_WithFree;
+var
+ lst: TObjectList;
+ obj: TObject;
+ i: Integer;
+begin
+ lst := TObjectList.Create(true);
+ try
+ for i := 0 to 100 do begin
+ obj := TIntfObj.Create(self);
+ lst.Add(obj);
+ fObjStack.Push(obj);
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ fObjStack.OwnsItems := false;
+ for i := 0 to 100 do begin
+ AssertNull('Pop returned non-zero item', fObjStack.Pop(true));
+ AssertEquals(101, IntfObjCounter);
+ end;
+ finally
+ FreeAndNil(lst);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Meth_PushPop100_ObjectNotOwned_WithoutFree;
+var
+ lst: TObjectList;
+ obj: TObject;
+ i: Integer;
+begin
+ lst := TObjectList.Create(true);
+ try
+ for i := 0 to 100 do begin
+ obj := TIntfObj.Create(self);
+ lst.Add(obj);
+ fObjStack.Push(obj);
+ AssertEquals(i+1, IntfObjCounter);
+ end;
+ fObjStack.OwnsItems := false;
+ for i := 0 to 100 do begin
+ AssertNotNull('Pop returned zero item', fObjStack.Pop(false));
+ AssertEquals(101, IntfObjCounter);
+ end;
+ finally
+ FreeAndNil(lst);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlStackTests.Dtor_FreesAllItems;
+begin
+ fObjStack.Push(TIntfObj.Create(self));
+ FreeAndNil(fObjStack);
+ AssertEquals(0, IntfObjCounter);
+end;
+
+initialization
+ RegisterTest(TutlStackTests.Suite);
+
+end.
+
diff --git a/uutlAlgorithm.pas b/uutlAlgorithm.pas
index ea3cbd5..9432499 100644
--- a/uutlAlgorithm.pas
+++ b/uutlAlgorithm.pas
@@ -5,127 +5,22 @@ unit uutlAlgorithm;
interface
uses
- Classes, SysUtils,
- uutlInterfaces;
+ Classes, SysUtils;
-type
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlQuickSort = class(TObject)
- public type
- IList = specialize IutlList;
- IComparer = specialize IutlComparer;
-
- private
- class procedure DoSort(
- aList: IList;
- aComparer: IComparer;
- aLow: Integer;
- aHigh: Integer);
-
- public
- class procedure Sort(
- aList: IList;
- aComparer: IComparer);
- end;
-
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlBinarySearch = class(TObject)
- public type
- IList = specialize IutlReadOnlyList;
- IComparer = specialize IutlComparer;
-
- private
- class function DoSearch(
- aList: IList;
- aComparer: IComparer;
- const aMin: Integer;
- const aMax: Integer;
- constref aItem: T;
- out aIndex: Integer): Boolean;
-
- public
- class function Search(
- aList: IList;
- aComparer: IComparer;
- constref aItem: T;
- out aIndex: Integer): Boolean;
- end;
+function Supports(const aInstance: TObject; const aClass: TClass; out aObj): Boolean; overload;
implementation
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlQuickSort//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class procedure TutlQuickSort.DoSort(aList: IList; aComparer: IComparer; aLow: Integer; aHigh: Integer);
-var
- lo, hi: Integer;
- p, tmp: T;
-begin
- repeat
- lo := aLow;
- hi := aHigh;
- p := aList.GetItem((aLow + aHigh) div 2);
- repeat
- while (aComparer.Compare(p, aList.GetItem(lo)) > 0) do
- lo := lo + 1;
- while (aComparer.Compare(p, aList.GetItem(hi)) < 0) do
- hi := hi - 1;
- if (lo <= hi) then begin
- tmp := aList.GetItem(lo);
- aList.SetItem(lo, aList.GetItem(hi));
- aList.SetItem(hi, tmp);
- lo := lo + 1;
- hi := hi - 1;
- end;
- until (lo > hi);
-
- if (hi - aLow < aHigh - lo) then begin
- if (aLow < hi) then
- DoSort(aList, aComparer, aLow, hi);
- aLow := lo;
- end else begin
- if (lo < aHigh) then
- DoSort(aList, aComparer, lo, aHigh);
- aHigh := hi;
- end;
- until (aLow >= aHigh);
-end;
-
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class procedure TutlQuickSort.Sort(aList: IList; aComparer: IComparer);
-begin
- DoSort(aList, aComparer, 0, aList.GetCount-1);
-end;
-
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlBinarySearch///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class function TutlBinarySearch.DoSearch(aList: IList; aComparer: IComparer; const aMin: Integer; const aMax: Integer;
- constref aItem: T; out aIndex: Integer): Boolean;
-var
- i, cmp: Integer;
-begin
- if (aMin <= aMax) then begin
- i := aMin + Trunc((aMax - aMin) / 2);
- cmp := aComparer.Compare(aItem, aList.GetItem(i));
- if (cmp = 0) then begin
- result := true;
- aIndex := i;
- end else if (cmp < 0) then
- result := DoSearch(aList, aComparer, aMin, i-1, aItem, aIndex)
- else if (cmp > 0) then
- result := DoSearch(aList, aComparer, i+1, aMax, aItem, aIndex);
- end else begin
- result := false;
- aIndex := aMin;
- end;
-end;
-
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class function TutlBinarySearch.Search(aList: IList; aComparer: IComparer; constref aItem: T;
- out aIndex: Integer): Boolean;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function Supports(const aInstance: TObject; const aClass: TClass; out aObj): Boolean;
begin
- result := DoSearch(aList, aComparer, 0, aList.GetCount-1, aItem, aIndex);
+ result := Assigned(aInstance) and aInstance.InheritsFrom(aClass);
+ if result then
+ TObject(aObj) := aInstance
+ else
+ TObject(aObj) := nil;
end;
end.
diff --git a/uutlExceptions.pas b/uutlExceptions.pas
index 6f92263..2c11a78 100644
--- a/uutlExceptions.pas
+++ b/uutlExceptions.pas
@@ -1,103 +1,107 @@
unit uutlExceptions;
-{ Package: Utils
- Prefix: utl - UTiLs
- Beschreibung: diese Unit enthält Definitionen für verschiedene Exceptions }
-
{$mode objfpc}{$H+}
interface
uses
- Classes, SysUtils, syncobjs;
+ Classes, SysUtils;
type
- EOutOfRange = class(Exception)
- constructor Create(const aIndex, aMin, aMax: Integer);
- end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EutlException = class(Exception);
- EUnknownType = class(Exception)
- public
- constructor Create(const aObj: TObject);
- end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EutlInvalidOperation = class(Exception);
- EArgumentNil = class(Exception)
- public
- constructor Create(const aArgName: String);
- end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EutlOutOfRange = class(EutlException)
+ private
+ fMin: Integer;
+ fMax: Integer;
+ fIndex: Integer;
- EArgument = class(Exception)
public
- constructor Create(const aArg, aMsg: String);
- constructor Create(const aMsg: String);
- end;
- EParameter = EArgument;
+ property Min: Integer read fMin;
+ property Max: Integer read fMax;
+ property Index: Integer read fIndex;
- EFileDoesntExists = class(Exception)
- public
- constructor Create(const aFilename: string);
+ constructor Create(const aIndex, aMin, aMax: Integer);
+ constructor Create(const aMsg: String; const aIndex, aMin, aMax: Integer);
end;
- EFileNotFound = EFileDoesntExists;
- EInvalidFile = class(Exception);
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EutlArgument = class(EutlException)
+ private
+ fArgument: String;
- EInvalidOperation = class(Exception);
+ public
+ property Argument: String read fArgument;
- ENotSupported = class(Exception);
+ constructor Create(const aArgument: String);
+ constructor Create(const aMsg, aArgument: string);
+ end;
- EWait = class(Exception)
- private
- fWaitResult: TWaitResult;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EutlArgumentNil = class(EutlArgument)
public
- property WaitResult: TWaitResult read fWaitResult;
- constructor Create(const msg: string; const aWaitResult: TWaitResult);
+ constructor Create(const aArgument: String);
+ constructor Create(const aMsg, aArgument: string);
end;
implementation
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EOutOfRange.Create(const aIndex, aMin, aMax: Integer);
-begin
- inherited Create(format('index (%d) out of range (%d:%d)', [aIndex, aMin, aMax]));
-end;
-
+//EutlOutOfRange////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EUnknownType.Create(const aObj: TObject);
+constructor EutlOutOfRange.Create(const aIndex, aMin, aMax: Integer);
begin
- inherited Create(format('unknown type: %s', [aObj.ClassName]));
+ Create('', aIndex, aMin, aMax);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EArgumentNil.Create(const aArgName: String);
+constructor EutlOutOfRange.Create(const aMsg: String; const aIndex, aMin, aMax: Integer);
+var
+ s: String;
begin
- inherited Create(format('argument ''%s'' can not be nil!', [aArgName]));
+ fIndex := aIndex;
+ fMin := aMin;
+ fMax := aMax;
+ s := Format('index (%d) out of range (%d:%d)', [fIndex, fMin, fMax]);
+ if (aMsg <> '') then
+ s := s + ': ' + aMsg;
+ inherited Create(s);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EArgument.Create(const aArg, aMsg: String);
+//EutlArgument//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor EutlArgument.Create(const aArgument: String);
begin
- inherited Create(format('invalid argument "%s" - %s', [aArg, aMsg]))
+ inherited Create(aArgument + ' is not valid');
+ fArgument := aArgument;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EArgument.Create(const aMsg: String);
+constructor EutlArgument.Create(const aMsg, aArgument: string);
begin
inherited Create(aMsg);
+ fArgument := aArgument;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EFileDoesntExists.Create(const aFilename: string);
+//EutlArgumentNil///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor EutlArgumentNil.Create(const aArgument: String);
begin
- inherited Create('file doesn''t exists: ' + aFilename);
+ inherited Create('argument nil: ' + aArgument, aArgument);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EWait.Create(const msg: string; const aWaitResult: TWaitResult);
+constructor EutlArgumentNil.Create(const aMsg, aArgument: string);
begin
- inherited Create(msg);
- fWaitResult := aWaitResult;
+ inherited Create(aMsg, aArgument);
end;
-
end.
diff --git a/uutlGenerics.pas b/uutlGenerics.pas
index f6f35d0..6147900 100644
--- a/uutlGenerics.pas
+++ b/uutlGenerics.pas
@@ -1,2092 +1,1491 @@
unit uutlGenerics;
-{ Package: Utils
- Prefix: utl - UTiLs
- Beschreibung: diese Unit implementiert allgemein nützliche ausschließlich-generische Klassen }
-
{$mode objfpc}{$H+}
{$modeswitch nestedprocvars}
interface
uses
- Classes, SysUtils, typinfo,
- uutlSyncObjs, uutlInterfaces;
+ Classes, SysUtils, TypInfo,
+ uutlExceptions;
type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlListBase = class(TObject)
- private type
- TListItem = packed record
- data: T;
- end;
- PListItem = ^TListItem;
-
- public type
- TItemEvent = procedure(aSender: TObject; const aIndex: Integer; const aItem: T) of object;
- TEnumerator = class(TObject)
- private
- fReverse: Boolean;
- fList: TFPList;
- fPosition: Integer;
- function GetCurrent: T;
- public
- property Current: T read GetCurrent;
- function GetEnumerator: TEnumerator;
- function MoveNext: Boolean;
- constructor Create(const aList: TFPList; const aReverse: Boolean = false);
- end;
-
- private
- fList: TFPList;
- fOwnsObjects: Boolean;
-
- protected
- property List: TFPList read fList;
-
- function GetCount: Integer;
- function GetItem(const aIndex: Integer): T;
- procedure SetCount(const aValue: Integer);
- procedure SetItem(const aIndex: Integer; const aItem: T);
+//Comparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlEqualityComparer = interface(IUnknown)
+ ['{C0FB90CC-D071-490F-BFEE-BAA5C94D1A5B}']
+ function EqualityCompare(constref i1, i2: T): Boolean;
+ end;
- function CreateItem: PListItem; virtual;
- procedure DestroyItem(const aItem: PListItem; const aFreeItem: Boolean = true); virtual;
- procedure InsertIntern(const aIndex: Integer; const aItem: T); virtual;
- procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); virtual;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlComparer = interface(specialize IutlEqualityComparer)
+ ['{7D2EC014-2878-4F60-9E43-4CFB54268995}']
+ function Compare(constref i1, i2: T): Integer;
+ end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic TutlEqualityComparer = class(TInterfacedObject, specialize IutlEqualityComparer)
public
- property OwnsObjects: Boolean read fOwnsObjects write fOwnsObjects;
-
- function GetEnumerator: TEnumerator;
- function GetReverseEnumerator: TEnumerator;
- procedure ForEach(const aEvent: TItemEvent);
- procedure Clear;
-
- constructor Create(const aOwnsObjects: Boolean = true);
- destructor Destroy; override;
+ function EqualityCompare(constref i1, i2: T): Boolean;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- { a simple list without the ability to compare objects (e.g. for IndexOf, Remove, Extract) }
- generic TutlSimpleList = class(specialize TutlListBase)
- public type
- IComparer = specialize IutlComparer;
- TSortDirection = (sdAscending, sdDescending);
- private
- function Split(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer): Integer;
- procedure QuickSort(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer);
- public
- property Items[const aIndex: Integer]: T read GetItem write SetItem; default;
- property Count: Integer read GetCount write SetCount;
+ generic TutlEqualityCompareEvent = function(constref i1, i2: T): Boolean;
+ generic TutlEqualityCompareEventO = function(constref i1, i2: T): Boolean of object;
+ generic TutlEqualityCompareEventN = function(constref i1, i2: T): Boolean is nested;
- function Add(const aItem: T): Integer;
- procedure Insert(const aIndex: Integer; const aItem: T);
+ generic TutlCalbackEqualityComparer = class(TInterfacedObject, specialize IutlEqualityComparer)
+ private type
+ TEqualityCompareEventType = (eetNormal, eetObject, eetNested);
- procedure Exchange(const aIndex1, aIndex2: Integer);
- procedure Move(const aCurIndex, aNewIndex: Integer);
- procedure Sort(aComparer: IComparer; const aDirection: TSortDirection = sdAscending);
+ public type
+ TCompareEvent = specialize TutlEqualityCompareEvent;
+ TCompareEventO = specialize TutlEqualityCompareEventO;
+ TCompareEventN = specialize TutlEqualityCompareEventN;
- procedure Delete(const aIndex: Integer);
+ strict private
+ fType: TEqualityCompareEventType;
+ fEvent: TCompareEvent;
+ fEventO: TCompareEventO;
+ fEventN: TCompareEventN;
- function First: T;
- procedure PushFirst(const aItem: T);
- function PopFirst(const aFreeItem: Boolean = false): T;
+ public
+ function EqualityCompare(constref i1, i2: T): Boolean;
- function Last: T;
- procedure PushLast(const aItem: T);
- function PopLast(const aFreeItem: Boolean = false): T;
+ { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks }
+ constructor Create(const aEvent: TCompareEvent);
+ constructor Create(const aEvent: TCompareEventO);
+ constructor Create(const aEvent: TCompareEventN);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlCustomList = class(specialize TutlSimpleList)
- public type
- IEqualityComparer = specialize IutlEqualityComparer;
- private
- fEqualityComparer: IEqualityComparer;
+ generic TutlComparer = class(specialize TutlEqualityComparer, specialize IutlComparer)
public
- function IndexOf(const aItem: T): Integer;
- function Extract(const aItem: T; const aDefault: T): T;
- function Remove(const aItem: T): Integer;
-
- constructor Create(aEqualityComparer: IEqualityComparer; const aOwnsObjects: Boolean = true);
- destructor Destroy; override;
+ function Compare(constref i1, i2: T): Integer;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlList = class(specialize TutlCustomList)
+ generic TutlCompareEvent = function(constref i1, i2: T): Integer;
+ generic TutlCompareEventO = function(constref i1, i2: T): Integer of object;
+ generic TutlCompareEventN = function(constref i1, i2: T): Integer is nested;
+
+ generic TutlCallbackComparer = class(TInterfacedObject, specialize IutlComparer)
+ private type
+ TCompareEventType = (cetNormal, cetObject, cetNested);
+
public type
- TEqualityComparer = specialize TutlEqualityComparer;
+ TCompareEvent = specialize TutlCompareEvent;
+ TCompareEventO = specialize TutlCompareEventO;
+ TCompareEventN = specialize TutlCompareEventN;
+
+ strict private
+ fType: TCompareEventType;
+ fEvent: TCompareEvent;
+ fEventO: TCompareEventO;
+ fEventN: TCompareEventN;
+
public
- constructor Create(const aOwnsObjects: Boolean = true);
+ function Compare(constref i1, i2: T): Integer;
+ function EqualityCompare(constref i1, i2: T): Boolean;
+
+ { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks }
+ constructor Create(const aEvent: TCompareEvent);
+ constructor Create(const aEvent: TCompareEventO);
+ constructor Create(const aEvent: TCompareEventN);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlHashSetBase = class(specialize TutlListBase)
- public type
- THashItemEvent = procedure(aSender: TObject; const aItem: T) of object;
- IComparer = specialize IutlComparer;
- private
- fComparer: IComparer;
- protected
- function SearchItem(const aMin, aMax: Integer; const aItem: T; out aIndex: Integer): Integer;
- public
- procedure ForEach(const aEvent: THashItemEvent);
+//Iterators/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ IutlIterator = interface(IUnknown)
+ ['{327E7628-C9D8-4C47-9630-E979D9C3293D}']
+ function MoveNext: Boolean;
+ function Clone: IutlIterator;
+ function Equals(const aOther: IutlIterator): Boolean;
+ function GetIsValid: Boolean;
- constructor Create(aComparer: IComparer; const aOwnsObjects: Boolean = true);
- destructor Destroy; override;
+ property IsValid: Boolean read GetIsValid;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlCustomHashSet = class(specialize TutlHashSetBase)
- public
- property Items[const aIndex: Integer]: T read GetItem; default;
- property Count: Integer read GetCount;
-
- function Add(const aItem: T): Boolean;
- function Contains(const aItem: T): Boolean;
- function IndexOf(const aItem: T): Integer;
- function Remove(const aItem: T): Boolean;
- procedure Delete(const aIndex: Integer);
+ IutlBidirectionalIterator = interface(IutlIterator)
+ ['{31D1E828-52CC-467F-8254-2C1384B28DEE}']
+ function MovePrev: Boolean;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlHashSet = class(specialize TutlCustomHashSet)
- public type
- TComparer = specialize TutlComparer;
- public
- constructor Create(const aOwnsObjects: Boolean = true);
+ IutlRandomAccessIterator = interface(IutlBidirectionalIterator)
+ ['{AE06BAB6-BB17-4E46-AE88-583EB853233E}']
+ function Increment(const aCount: Integer): Boolean;
+ function Decrement(const aCount: Integer): Boolean;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- EutlMap = class(Exception);
- EutlMapKeyNotFound = class(EutlMap)
- public
- constructor Create;
+ generic IutlInputIterator = interface(IutlIterator)
+ ['{BD4ED39B-2BBA-41F7-BDC7-E1B45F41AA84}']
+ function GetItem: T;
+ property Item: T read GetItem;
end;
- EutlMapKeyAlreadyExists = class(EutlMap)
- public
- constructor Create;
- end;
-
- generic TutlMapBase = class(TObject)
- public type
- TKeyValuePairEvent = procedure(aSender: TObject; const aKey: TKey; const aValue: TValue) of object;
-
- IComparer = specialize IutlComparer;
- TKeyValuePair = packed record
- Key: TKey;
- Value: TValue;
- end;
-
- THashSet = class(specialize TutlCustomHashSet)
- protected
- procedure DestroyItem(const aItem: PListItem; const aFreeItem: Boolean = true); override;
- public
- property Items[const aIndex: Integer]: TKeyValuePair read GetItem write SetItem; default;
- end;
-
- TKeyValuePairComparer = class(TInterfacedObject, THashSet.IComparer)
- private
- fComparer: IComparer;
- public
- function Compare(const i1, i2: TKeyValuePair): Integer;
- constructor Create(aComparer: IComparer);
- destructor Destroy; override;
- end;
-
- TEnumeratorProxy = class(TObject)
- fEnumerator: THashSet.TEnumerator;
- function MoveNext: Boolean;
- constructor Create(const aEnumerator: THashSet.TEnumerator);
- destructor Destroy; override;
- end;
-
- TValueEnumerator = class(TEnumeratorProxy)
- function GetCurrent: TValue;
- property Current: TValue read GetCurrent;
- function GetEnumerator: TValueEnumerator;
- end;
-
- TKeyEnumerator = class(TEnumeratorProxy)
- function GetCurrent: TKey;
- property Current: TKey read GetCurrent;
- function GetEnumerator: TKeyEnumerator;
- end;
-
- TKeyWrapper = class(TObject)
- private
- fHashSet: THashSet;
- function GetItem(const aIndex: Integer): TKey;
- function GetCount: Integer;
- public
- property Items[const aIndex: Integer]: TKey read GetItem; default;
- property Count: Integer read GetCount;
- function GetEnumerator: TKeyEnumerator;
- function GetReverseEnumerator: TKeyEnumerator;
- constructor Create(const aHashSet: THashSet);
- end;
- TKeyValuePairWrapper = class(TObject)
- private
- fHashSet: THashSet;
- function GetItem(const aIndex: Integer): TKeyValuePair;
- function GetCount: Integer;
- public
- property Items[const aIndex: Integer]: TKeyValuePair read GetItem; default;
- property Count: Integer read GetCount;
- function GetEnumerator: THashSet.TEnumerator;
- function GetReverseEnumerator: THashSet.TEnumerator;
- constructor Create(const aHashSet: THashSet);
- end;
-
- private
- fAutoCreate: Boolean;
- fHashSetRef: THashSet;
- fKeyWrapper: TKeyWrapper;
- fKeyValuePairWrapper: TKeyValuePairWrapper;
-
- function GetValues(const aKey: TKey): TValue;
- function GetValueAt(const aIndex: Integer): TValue;
- function GetCount: Integer;
-
- procedure SetValueAt(const aIndex: Integer; aValue: TValue);
- procedure SetValues(const aKey: TKey; aValue: TValue);
- public
- property Values [const aKey: TKey]: TValue read GetValues write SetValues; default;
- property ValueAt[const aIndex: Integer]: TValue read GetValueAt write SetValueAt;
- property Keys: TKeyWrapper read fKeyWrapper;
- property KeyValuePairs: TKeyValuePairWrapper read fKeyValuePairWrapper;
- property Count: Integer read GetCount;
- property AutoCreate: Boolean read fAutoCreate write fAutoCreate;
-
- procedure Add(const aKey: TKey; const aValue: TValue);
- function IndexOf(const aKey: TKey): Integer;
- function Contains(const aKey: TKey): Boolean;
- procedure Delete(const aKey: TKey);
- procedure DeleteAt(const aIndex: Integer);
- procedure Clear;
-
- procedure ForEach(const aEvent: TKeyValuePairEvent);
- function GetEnumerator: TValueEnumerator;
- function GetReverseEnumerator: TValueEnumerator;
-
- constructor Create(const aHashSet: THashSet);
- destructor Destroy; override;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlOutputIterator = interface(IutlIterator)
+ ['{132642C1-5235-4450-8956-2092D3F2F83D}']
+ procedure SetItem(const aValue: T);
+ property Item: T write SetItem;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlCustomMap = class(specialize TutlMapBase)
- private
- fHashSetImpl: THashSet;
- public
- constructor Create(const aComparer: IComparer; const aOwnsObjects: Boolean = true);
- destructor Destroy; override;
+ generic IutlInputOutputIterator = interface(IutlIterator)
+ ['{5367DA1F-F98C-4EE7-A454-E8978E2A9B46}']
+ function GetItem: T;
+ procedure SetItem(const aValue: T);
+ property Item: T read GetItem write SetItem;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlMap = class(specialize TutlCustomMap)
- public type
- TComparer = specialize TutlComparer;
- public
- constructor Create(const aOwnsObjects: Boolean = true);
+ generic IutlBidirectionalInputIterator = interface(IutlBidirectionalIterator)
+ ['{B2423828-F187-4620-8DA2-9C4EF68B81E3}']
+ function GetItem: T;
+ property Item: T read GetItem;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlQueue = class(TObject)
- public type
- PListItem = ^TListItem;
- TListItem = packed record
- data: T;
- next: PListItem;
- end;
- private
- function GetCount: Integer;
- protected
- fFirst: PListItem;
- fLast: PListItem;
- fCount: Integer;
- fOwnsObjects: Boolean;
- public
- property Count: Integer read GetCount;
-
- procedure Push(const aItem: T); virtual;
- function Pop(out aItem: T): Boolean; virtual;
- function Pop: Boolean;
- procedure Clear;
-
- constructor Create(const aOwnsObjects: Boolean = true);
- destructor Destroy; override;
+ generic IutlBidirectionalOutputIterator = interface(IutlBidirectionalIterator)
+ ['{1A13E581-200B-41E7-BC7D-9AD5192DEF0F}']
+ procedure SetItem(const aValue: T);
+ property Item: T write SetItem;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlSyncQueue = class(specialize TutlQueue)
- private
- fPushLock: TutlSpinLock;
- fPopLock: TutlSpinLock;
- public
- procedure Push(const aItem: T); override;
- function Pop(out aItem: T): Boolean; override;
-
- constructor Create(const aOwnsObjects: Boolean = true);
- destructor Destroy; override;
+ generic IutlBidirectionalInputOutputIterator = interface(IutlBidirectionalIterator)
+ ['{BD8A6D08-7980-45D1-86A6-838402F5CBA6}']
+ function GetValue: T;
+ procedure SetValue(const aValue: T);
+ property Value: T read GetValue write SetValue;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlInterfaceList = class(TInterfaceList)
- private type
- TInterfaceEnumerator = class(TObject)
- private
- fList: TInterfaceList;
- fPos: Integer;
- function GetCurrent: T;
- public
- property Current: T read GetCurrent;
- function MoveNext: Boolean;
- constructor Create(const aList: TInterfaceList);
- end;
-
- private
- function Get(i : Integer): T;
- procedure Put(i : Integer; aItem : T);
- public
- property Items[Index : Integer]: T read Get write Put; default;
-
- function First: T;
- function IndexOf(aItem : T): Integer;
- function Add(aItem : IUnknown): Integer;
- procedure Insert(i : Integer; aItem : T);
- function Last : T;
- function Remove(aItem : T): Integer;
-
- function GetEnumerator: TInterfaceEnumerator;
+ generic IutlRandomAccessInputIterator = interface(IutlRandomAccessIterator)
+ ['{47880DCC-49D4-45C7-90CB-D8E915B7CB0D}']
+ function GetItem: T;
+ property Item: T read GetItem;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- EutlEnumConvert = class(EConvertError)
- public
- constructor Create(const aValue, aExpectedType: String);
- end;
- generic TutlEnumHelper = class(TObject)
- private type
- TValueArray = array of T;
- private class var
- FTypeInfo: PTypeInfo;
- FValues: TValueArray;
- public
- class constructor Initialize;
- class function ToString(aValue: T): String; reintroduce;
- class function TryToEnum(aStr: String; out aValue: T): Boolean;
- class function ToEnum(aStr: String): T; overload;
- class function ToEnum(aStr: String; const aDefault: T): T; overload;
- class function Values: TValueArray;
- class function TypeInfo: PTypeInfo;
+ generic IutlRandomAccessOutputIterator = interface(IutlRandomAccessIterator)
+ ['{E768DA58-E666-47F1-B7D8-61EB6C33C379}']
+ procedure SetItem(const aValue: T);
+ property Item: T write SetItem;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlRingBuffer = class
- private
- fAborted: boolean;
- fData: packed array of T;
- fDataLen: Integer;
- fDataSize: integer;
- fFillState: integer;
- fWritePtr, fReadPtr: integer;
- fWrittenEvent,
- fReadEvent: TutlAutoResetEvent;
- public
- constructor Create(const Elements: Integer);
- destructor Destroy; override;
- function Read(Buf: Pointer; Items: integer; BlockUntilAvail: boolean): integer;
- function Write(Buf: Pointer; Items: integer; BlockUntilDone: boolean): integer;
- procedure BreakPipe;
- property FillState: Integer read fFillState;
- property Size: integer read fDataLen;
+ generic IutlRandomAccessInputOutputIterator = interface(IutlRandomAccessIterator)
+ ['{3A8D3C5D-1085-4073-B1D4-DF1886827B6A}']
+ function GetItem: T;
+ procedure SetItem(const aValue: T);
+ property Item: T read GetItem write SetItem;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlPagedDataFiFo = class
- private type
- PPage = ^TPage;
- TPage = packed record
- Next: PPage;
- Data: array of TData;
- ReadPos: Integer;
- WritePos: Integer;
- end;
- public type
- PData = ^TData;
-
- IDataProvider = interface(IUnknown)
- function Give(const aBuffer: PData; aCount: Integer): Integer;
- end;
-
- IDataConsumer = interface(IUnknown)
- function Take(const aBuffer: PData; aCount: Integer): Integer;
- end;
-
- // read from buffer, write to fifo
- TDataProvider = class(TInterfacedObject, IDataProvider)
- private
- fData: PData;
- fPos: Integer;
- fCount: Integer;
- public
- function Give(const aBuffer: PData; aCount: Integer): Integer;
- constructor Create(const aData: PData; const aCount: Integer);
- end;
-
- // read from fifo, write to buffer
- TDataConsumer = class(TInterfacedObject, IDataConsumer)
- private
- fData: PData;
- fPos: Integer;
- fCount: Integer;
- public
- function Take(const aBuffer: PData; aCount: Integer): Integer;
- constructor Create(const aData: PData; const aCount: Integer);
- end;
-
- // read from nested callback, write to fifo
- TDataCallback = function(const aBuffer: PData; aCount: Integer): Integer is nested;
- TNestedDataProvider = class(TInterfacedObject, IDataProvider)
- private
- fCallback: TDataCallback;
- public
- function Give(const aBuffer: PData; aCount: Integer): Integer;
- constructor Create(const aCallback: TDataCallback);
- end;
+//Container/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic TutlArrayContainer = class(TObject)
+ protected type
+ PT = ^T;
- // read from fifo, write to nested callback
- TNestedDataConsumer = class(TInterfacedObject, IDataConsumer)
- private
- fCallback: TDataCallback;
- public
- function Take(const aBuffer: PData; aCount: Integer): Integer;
- constructor Create(const aCallback: TDataCallback);
- end;
+ strict private
+ fList: PT;
- // read from stream, write to fifo
- TStreamDataProvider = class(TInterfacedObject, IDataProvider)
- private
- fStream: TStream;
- public
- function Give(const aBuffer: PData; aCount: Integer): Integer;
- constructor Create(const aStream: TStream);
- end;
+ function GetIsEmpty: Boolean;
- // read from fifo, write to stream
- TStreamDataConsumer = class(TInterfacedObject, IDataConsumer)
- private
- fStream: TStream;
- public
- function Take(const aBuffer: PData; aCount: Integer): Integer;
- constructor Create(const aStream: TStream);
- end;
+ protected
+ fCapacity: Integer;
+ fOwnsItems: Boolean;
+ fCanShrink: Boolean;
+ fCanExpand: Boolean;
- private
- fPageSize: Integer;
- fReadPage: PPage;
- fWritePage: PPage;
- fSize: Integer;
protected
- function WriteIntern(const aProvider: IDataProvider; aCount: Integer): Integer; virtual;
- function ReadIntern(const aConsumer: IDataConsumer; aCount: Integer; const aMoveReadPos: Boolean): Integer; virtual;
- public
- property Size: Integer read fSize;
- property PageSize: Integer read fPageSize;
+ function GetCount: Integer; virtual; abstract;
+ function GetInternalItem (const aIndex: Integer): PT;
- function Write(const aProvider: IDataProvider; const aCount: Integer): Integer; overload;
- function Write(const aData: PData; const aCount: Integer): Integer; overload;
+ procedure SetCapacity (const aValue: integer); virtual;
- function Read(const aConsumer: IDataConsumer; const aCount: Integer): Integer; overload;
- function Read(const aData: PData; const aCount: Integer): Integer; overload;
+ procedure Release (var aItem: T; const aFreeItem: Boolean); virtual;
- function Peek(const aConsumer: IDataConsumer; const aCount: Integer): Integer; overload;
- function Peek(const aData: PData; const aCount: Integer): Integer; overload;
+ procedure Shrink (const aExactFit: Boolean);
+ procedure Expand;
- function Discard(const aCount: Integer): Integer;
- procedure Clear;
+ protected
+ property Count: Integer read GetCount;
+ property IsEmpty: Boolean read GetIsEmpty;
+ property Capacity: Integer read fCapacity write SetCapacity;
+ property CanShrink: Boolean read fCanShrink write fCanShrink;
+ property CanExpand: Boolean read fCanExpand write fCanExpand;
+ property OwnsItems: Boolean read fOwnsItems write fOwnsItems;
- constructor Create(const aPageSize: Integer = 2048);
+ public
+ constructor Create(const aOwnsItems: Boolean);
destructor Destroy; override;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlSyncPagedDataFiFo = class(specialize TutlPagedDataFiFo)
- private
- fLock: TutlSpinLock;
+ generic TutlQueue = class(specialize TutlArrayContainer)
+ strict private
+ fCount: Integer;
+ fReadPos: Integer;
+ fWritePos: Integer;
+
protected
- function WriteIntern(const aProvider: IDataProvider; aCount: Integer): Integer; override;
- function ReadIntern(const aConsumer: IDataConsumer; aCount: Integer; const aMoveReadPos: Boolean): Integer; override;
+ function GetCount: Integer; override;
+ procedure SetCapacity(const aValue: integer); override;
+
public
- constructor Create(const aPageSize: Integer = 2048);
+ property Count;
+ property IsEmpty;
+ property Capacity;
+ property CanExpand;
+ property CanShrink;
+ property OwnsItems;
+
+ procedure Enqueue(constref aItem: T);
+ function Dequeue: T;
+ function Dequeue(const aFreeItem: Boolean): T;
+ function Peek: T;
+ procedure ShrinkToFit;
+ procedure Clear;
+
+ constructor Create(const aOwnsItems: Boolean);
destructor Destroy; override;
end;
- function utlFreeOrFinalize(var obj; const aTypeInfo: PTypeInfo; const aFreeObj: Boolean = true): Boolean;
-
-implementation
-
-uses
- uutlExceptions, syncobjs;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function utlFreeOrFinalize(var obj; const aTypeInfo: PTypeInfo; const aFreeObj: Boolean = true): Boolean;
-var
- o: TObject;
-begin
- result := true;
- case aTypeInfo^.Kind of
- tkClass: begin
- if (aFreeObj) then begin
- o := TObject(obj);
- Pointer(obj) := nil;
- o.Free;
- end;
- end;
-
- tkInterface: begin
- IUnknown(obj) := nil;
- end;
+ generic TutlStack = class(specialize TutlArrayContainer)
+ strict private
+ fCount: Integer;
- tkAString: begin
- AnsiString(Obj) := '';
- end;
+ protected
+ function GetCount: Integer; override;
- tkUString: begin
- UnicodeString(Obj) := '';
- end;
+ public
+ property Count;
+ property IsEmpty;
+ property Capacity;
+ property CanExpand;
+ property CanShrink;
+ property OwnsItems;
+
+ procedure Push(constref aItem: T);
+ function Pop: T;
+ function Pop(const aFreeItem: Boolean): T;
+ function Peek: T;
+ procedure ShrinkToFit;
+ procedure Clear;
- tkString: begin
- String(Obj) := '';
- end;
- else
- result := false;
+ constructor Create(const aOwnsItems: Boolean);
+ destructor Destroy; override;
end;
-end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCustomMap.Create(const aComparer: IComparer; const aOwnsObjects: Boolean);
-begin
- fHashSetImpl := THashSet.Create(TKeyValuePairComparer.Create(aComparer), aOwnsObjects);
- inherited Create(fHashSetImpl);
-end;
+ generic TutlSimpleList = class(specialize TutlArrayContainer)
+ strict private
+ fCount: Integer;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlCustomMap.Destroy;
-begin
- inherited Destroy;
- FreeAndNil(fHashSetImpl);
-end;
+ function GetFirst: T;
+ function GetLast: T;
+ function GetItem (const aIndex: Integer): T;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//EutlEnumConvert///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EutlEnumConvert.Create(const aValue, aExpectedType: String);
-begin
- inherited Create(Format('%s is not a %s', [aValue, aExpectedType]));
-end;
+ procedure SetItem (const aIndex: Integer; aValue: T);
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//EutlMapKeyNotFound////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EutlMapKeyNotFound.Create;
-begin
- inherited Create('key not found');
-end;
+ protected
+ function GetCount: Integer; override;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//EutlMapKeyAlreadyExists///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EutlMapKeyAlreadyExists.Create;
-begin
- inherited Create('key already exists');
-end;
+ procedure InsertIntern(const aIndex: Integer; constref aValue: T);
+ procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlListBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlListBase.TEnumerator.GetCurrent: T;
-begin
- result := PListItem(fList[fPosition])^.data;
-end;
+ public
+ property Count;
+ property Capacity;
+ property CanShrink;
+ property CanExpand;
+ property OwnsItems;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlListBase.TEnumerator.GetEnumerator: TEnumerator;
-begin
- result := self;
-end;
+ property First: T read GetFirst;
+ property Last: T read GetLast;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlListBase.TEnumerator.MoveNext: Boolean;
-begin
- if fReverse then begin
- dec(fPosition);
- result := (fPosition >= 0);
- end else begin
- inc(fPosition);
- result := (fPosition < fList.Count)
- end;
-end;
+ property Items[const aIndex: Integer]: T read GetItem write SetItem; default;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlListBase.TEnumerator.Create(const aList: TFPList; const aReverse: Boolean);
-begin
- inherited Create;
- fList := aList;
- fReverse := aReverse;
- if fReverse then
- fPosition := fList.Count
- else
- fPosition := -1;
-end;
+ function Add (constref aItem: T): Integer;
+ procedure Insert (const aIndex: Integer; constref aItem: T);
+ procedure Exchange (const aIndex1, aIndex2: Integer);
+ procedure Move (const aCurrentIndex, aNewIndex: Integer);
+ procedure Delete (const aIndex: Integer);
+ function Extract (const aIndex: Integer): T;
+ procedure ShrinkToFit;
+ procedure Clear;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlListBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlListBase.GetCount: Integer;
-begin
- result := fList.Count;
-end;
+ procedure PushFirst (constref aItem: T);
+ function PopFirst (const aFreeItem: Boolean): T;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlListBase.GetItem(const aIndex: Integer): T;
-begin
- if (aIndex >= 0) and (aIndex < fList.Count) then
- result := PListItem(fList[aIndex])^.data
- else
- raise EOutOfRange.Create(aIndex, 0, fList.Count-1);
-end;
+ procedure PushLast (constref aItem: T);
+ function PopLast (const aFreeItem: Boolean): T;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlListBase.SetCount(const aValue: Integer);
-var
- item: PListItem;
-begin
- if (aValue < 0) then
- raise EArgument.Create('new value for count must be positiv');
- while (aValue > fList.Count) do begin
- item := CreateItem;
- FillByte(item^, SizeOf(item^), 0);
- fList.Add(item);
+ destructor Destroy; override;
end;
- while (aValue < fList.Count) do
- DeleteIntern(fList.Count-1);
-end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlListBase.SetItem(const aIndex: Integer; const aItem: T);
-var
- item: PListItem;
-begin
- if (aIndex >= 0) and (aIndex < fList.Count) then begin
- item := PListItem(fList[aIndex]);
- utlFreeOrFinalize(item^, TypeInfo(item^), fOwnsObjects);
- item^.data := aItem;
- end else
- raise EOutOfRange.Create(aIndex, 0, fList.Count-1);
-end;
+ generic TutlCustomList = class(specialize TutlSimpleList)
+ public type
+ IEqualityComparer = specialize IutlEqualityComparer;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlListBase.CreateItem: PListItem;
-begin
- new(result);
-end;
+ strict private
+ fEqualityComparer: IEqualityComparer;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlListBase.DestroyItem(const aItem: PListItem; const aFreeItem: Boolean);
-begin
- utlFreeOrFinalize(aItem^.data, TypeInfo(aItem^.data), fOwnsObjects and aFreeItem);
- Dispose(aItem);
-end;
+ public
+ function IndexOf (const aItem: T): Integer;
+ function Extract (const aItem: T; const aDefault: T): T; overload;
+ function Remove (const aItem: T): Integer;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlListBase.InsertIntern(const aIndex: Integer; const aItem: T);
-var
- item: PListItem;
-begin
- item := CreateItem;
- try
- item^.data := aItem;
- fList.Insert(aIndex, item);
- except
- DestroyItem(item, false);
- raise;
+ constructor Create(const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
+ destructor Destroy; override;
end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
-var
- item: PListItem;
-begin
- if (aIndex >= 0) and (aIndex < fList.Count) then begin
- item := PListItem(fList[aIndex]);
- fList.Delete(aIndex);
- DestroyItem(item, aFreeItem);
- end else
- raise EOutOfRange.Create(aIndex, 0, fList.Count-1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlListBase.GetEnumerator: TEnumerator;
-begin
- result := TEnumerator.Create(fList, false);
-end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlListBase.GetReverseEnumerator: TEnumerator;
-begin
- result := TEnumerator.Create(fList, true);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlListBase.ForEach(const aEvent: TItemEvent);
-var i: Integer;
-begin
- if not Assigned(aEvent) then
- for i := 0 to fList.Count-1 do
- aEvent(self, i, PListItem(fList[i])^.data);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlListBase.Clear;
-begin
- while (fList.Count > 0) do
- DeleteIntern(fList.Count-1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlListBase.Create(const aOwnsObjects: Boolean);
-begin
- inherited Create;
- fOwnsObjects := aOwnsObjects;
- fList := TFPList.Create;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlListBase.Destroy;
-begin
- Clear;
- FreeAndNil(fList);
- inherited Destroy;
-end;
+ generic TutlList = class(specialize TutlCustomList)
+ public type
+ TEqualityComparer = specialize TutlEqualityComparer;
+ public
+ constructor Create(const aOwnsItems: Boolean);
+ end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlSimpleList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.Split(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer): Integer;
-var
- i, j: Integer;
- pivot: T;
-begin
- i := aLeft;
- j := aRight - 1;
- pivot := GetItem(aRight);
- repeat
- while ((aDirection = sdAscending) and (aComparer.Compare(GetItem(i), pivot) <= 0) or
- (aDirection = sdDescending) and (aComparer.Compare(GetItem(i), pivot) >= 0)) and
- (i < aRight) do inc(i);
-
- while ((aDirection = sdAscending) and (aComparer.Compare(GetItem(j), pivot) >= 0) or
- (aDirection = sdDescending) and (aComparer.Compare(GetItem(j), pivot) <= 0)) and
- (j > aLeft) do dec(j);
+ generic TutlLinkedList = class(TObject)
+ public type
+ Iterator = specialize IutlBidirectionalInputOutputIterator;
- if (i < j) then
- Exchange(i, j);
- until (i >= j);
+ private type
+ PElement = ^TElement;
+ TElement = packed record
+ prev: PElement;
+ next: PElement;
+ data: T;
+ end;
- if ((aDirection = sdAscending) and (aComparer.Compare(GetItem(i), pivot) > 0)) or
- ((aDirection = sdDescending) and (aComparer.Compare(GetItem(i), pivot) < 0)) then
- Exchange(i, aRight);
+ TIterator = class(TInterfacedObject,
+ Iterator,
+ IutlBidirectionalIterator,
+ IutlIterator)
+ strict private
+ fOwner: TutlLinkedList;
+ fElement: PElement;
- result := i;
-end;
+ private
+ procedure ReleaseElement(const aElement: PElement);
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.QuickSort(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer);
-var
- s: Integer;
-begin
- if (aLeft < aRight) then begin
- s := Split(aComparer, aDirection, aLeft, aRight);
- QuickSort(aComparer, aDirection, aLeft, s - 1);
- QuickSort(aComparer, aDirection, s + 1, aRight);
- end;
-end;
+ public { IutlIterator }
+ function MoveNext: Boolean;
+ function Clone: IutlIterator;
+ function Equals(const aOther: IutlIterator): Boolean;
+ function GetIsValid: Boolean;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.Add(const aItem: T): Integer;
-begin
- result := Count;
- InsertIntern(result, aItem);
-end;
+ property IsValid: Boolean read GetIsValid;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.Insert(const aIndex: Integer; const aItem: T);
-begin
- InsertIntern(aIndex, aItem);
-end;
+ public { IutlBidirectionalIterator }
+ function MovePrev: Boolean;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.Exchange(const aIndex1, aIndex2: Integer);
-begin
- if (aIndex1 < 0) or (aIndex1 >= Count) then
- raise EOutOfRange.Create(aIndex1, 0, Count-1);
- if (aIndex2 < 0) or (aIndex2 >= Count) then
- raise EOutOfRange.Create(aIndex2, 0, Count-1);
- fList.Exchange(aIndex1, aIndex2);
-end;
+ public { IutlBidirectionalInputOutputIterator }
+ function GetValue: T;
+ procedure SetValue(const aValue: T);
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.Move(const aCurIndex, aNewIndex: Integer);
-begin
- if (aCurIndex < 0) or (aCurIndex >= Count) then
- raise EOutOfRange.Create(aCurIndex, 0, Count-1);
- if (aNewIndex < 0) or (aNewIndex >= Count) then
- raise EOutOfRange.Create(aNewIndex, 0, Count-1);
- fList.Move(aCurIndex, aNewIndex);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.Sort(aComparer: IComparer; const aDirection: TSortDirection);
-begin
- QuickSort(aComparer, aDirection, 0, fList.Count-1);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.Delete(const aIndex: Integer);
-begin
- DeleteIntern(aIndex);
-end;
+ public
+ property Element: PElement read fElement;
+ property Owner: TutlLinkedList read fOwner;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.First: T;
-begin
- result := Items[0];
-end;
+ constructor Create(const aElement: PElement; const aOwner: TutlLinkedList);
+ destructor Destroy; override;
+ end;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.PushFirst(const aItem: T);
-begin
- InsertIntern(0, aItem);
-end;
+ strict private
+ fOwnsItems: Boolean;
+ fCount: Integer;
+ fFirst: PElement;
+ fLast: PElement;
+ fIterators: array of TIterator;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.PopFirst(const aFreeItem: Boolean): T;
-begin
- if aFreeItem then
- FillByte(result{%H-}, SizeOf(result), 0)
- else
- result := First;
- DeleteIntern(0, aFreeItem);
-end;
+ function GetFirst: Iterator;
+ function GetLast: Iterator;
+ function GetIsEmpty: Boolean;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.Last: T;
-begin
- result := Items[Count-1];
-end;
+ procedure LinkElement (const aElement: PElement);
+ procedure InsertBefore (const aElement: PElement; constref aItem: T);
+ procedure InsertAfter (const aElement: PElement; constref aItem: T);
+ function Remove (const aElement: PElement; const aFreeItem: Boolean): T;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.PushLast(const aItem: T);
-begin
- InsertIntern(Count, aItem);
-end;
+ function CreateIterator (const aElement: PElement): TIterator;
+ procedure DestroyIterator (const aIterator: TIterator);
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.PopLast(const aFreeItem: Boolean): T;
-begin
- if aFreeItem then
- FillByte(result{%H-}, SizeOf(result), 0)
- else
- result := Last;
- DeleteIntern(Count-1, aFreeItem);
-end;
+ protected
+ procedure Release (var aItem: T; const aFreeItem: Boolean); virtual;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlCustomList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCustomList.IndexOf(const aItem: T): Integer;
-var
- c: Integer;
-begin
- c := List.Count;
- result := 0;
- while (result < c) and
- not fEqualityComparer.EqualityCompare(PListItem(List[result])^.data, aItem) do
- inc(result);
- if (result >= c) then
- result := -1;
-end;
+ public
+ property Count: Integer read fCount;
+ property IsEmpty: Boolean read GetIsEmpty;
+ property First: Iterator read GetFirst;
+ property Last: Iterator read GetLast;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCustomList.Extract(const aItem: T; const aDefault: T): T;
-var
- i: Integer;
-begin
- i := IndexOf(aItem);
- if (i >= 0) then begin
- result := Items[i];
- DeleteIntern(i, false);
- end else
- result := aDefault;
-end;
+ procedure PushFirst (constref aItem: T);
+ function PopFirst (const aFreeItem: Boolean): T;
+ procedure PopFirst;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCustomList.Remove(const aItem: T): Integer;
-begin
- result := IndexOf(aItem);
- if (result >= 0) then
- DeleteIntern(result);
-end;
+ procedure PushLast (constref aItem: T);
+ function PopLast (const aFreeItem: Boolean): T;
+ procedure PopLast;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCustomList.Create(aEqualityComparer: IEqualityComparer; const aOwnsObjects: Boolean);
-begin
- inherited Create(aOwnsObjects);
- fEqualityComparer := aEqualityComparer;
-end;
+ procedure InsertBefore (const aIterator: IutlIterator; constref aItem: T);
+ procedure InsertAfter (const aIterator: IutlIterator; constref aItem: T);
+ function Remove (const aIterator: IutlIterator; const aFreeItem: Boolean): T;
+ procedure Remove (const aIterator: IutlIterator);
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlCustomList.Destroy;
-begin
- fEqualityComparer := nil;
- inherited Destroy;
-end;
+ procedure Clear;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlList.Create(const aOwnsObjects: Boolean);
-begin
- inherited Create(TEqualityComparer.Create, aOwnsObjects);
-end;
+ constructor Create (const aOwnsItems: Boolean);
+ destructor Destroy; override;
+ end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlHashSetBase///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlHashSetBase.SearchItem(const aMin, aMax: Integer; const aItem: T; out aIndex: Integer): Integer;
-var
- i, cmp: Integer;
-begin
- if (aMin <= aMax) then begin
- i := aMin + Trunc((aMax - aMin) / 2);
- cmp := fComparer.Compare(aItem, GetItem(i));
- if (cmp = 0) then
- result := i
- else if (cmp < 0) then
- result := SearchItem(aMin, i-1, aItem, aIndex)
- else if (cmp > 0) then
- result := SearchItem(i+1, aMax, aItem, aIndex);
- end else begin
- result := -1;
- aIndex := aMin;
- end;
-end;
+function IncIt(aIterator: IutlIterator): Boolean; overload;
+function DecIt(aIterator: IutlBidirectionalIterator): Boolean; overload;
+function IncIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean; overload;
+function DecIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean; overload;
+operator +(aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator; overload;
+operator -(aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator; overload;
+
+procedure FinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlHashSetBase.ForEach(const aEvent: THashItemEvent);
-var item: T;
+function IncIt(aIterator: IutlIterator): Boolean;
begin
- if Assigned(aEvent) then
- for item in self do
- aEvent(self, item);
+ result := aIterator.MoveNext;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlHashSetBase.Create(aComparer: IComparer; const aOwnsObjects: Boolean);
+function DecIt(aIterator: IutlBidirectionalIterator): Boolean;
begin
- inherited Create(aOwnsObjects);
- fComparer := aComparer;
+ result := aIterator.MovePrev;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlHashSetBase.Destroy;
+function IncIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean;
begin
- fComparer := nil;
- inherited Destroy;
+ result := aIterator.Increment(a);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlCustomHashSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCustomHashSet.Add(const aItem: T): Boolean;
-var
- i: Integer;
+function DecIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean;
begin
- result := (SearchItem(0, List.Count-1, aItem, i) < 0);
- if result then
- InsertIntern(i, aItem);
+ result := aIterator.Decrement(a);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCustomHashSet.Contains(const aItem: T): Boolean;
-var
- tmp: Integer;
+operator + (aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator;
begin
- result := (SearchItem(0, List.Count-1, aItem, tmp) >= 0);
+ result := IutlRandomAccessIterator(aIterator.Clone);
+ result.Increment(a);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCustomHashSet.IndexOf(const aItem: T): Integer;
-var
- tmp: Integer;
+operator - (aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator;
begin
- result := SearchItem(0, List.Count-1, aItem, tmp);
+ result := IutlRandomAccessIterator(aIterator.Clone);
+ result.Decrement(a);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCustomHashSet.Remove(const aItem: T): Boolean;
+procedure FinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
var
- i, tmp: Integer;
+ o: TObject;
begin
- i := SearchItem(0, List.Count-1, aItem, tmp);
- result := (i >= 0);
- if result then
- DeleteIntern(i);
-end;
+ case aTypeInfo^.Kind of
+ tkClass: begin
+ if (aFreeObject) then begin
+ o := TObject(obj);
+ Pointer(obj) := nil;
+ if Assigned(o) then
+ o.Free;
+ end;
+ end;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlCustomHashSet.Delete(const aIndex: Integer);
-begin
- DeleteIntern(aIndex);
+ tkInterface: begin
+ IUnknown(obj) := nil;
+ end;
+
+ tkAString: begin
+ AnsiString(Obj) := '';
+ end;
+
+ tkUString: begin
+ UnicodeString(Obj) := '';
+ end;
+
+ tkString: begin
+ String(Obj) := '';
+ end;
+ end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlHashSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlEqualityComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlHashSet.Create(const aOwnsObjects: Boolean);
+function TutlEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
begin
- inherited Create(TComparer.Create, aOwnsObjects);
+ result := (i1 = i2);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlMapBase.THashSet//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlCalbackEqualityComparer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlMapBase.THashSet.DestroyItem(const aItem: PListItem; const aFreeItem: Boolean);
+function TutlCalbackEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
begin
- // never free objects used as keys, but do finalize strings, interfaces etc.
- utlFreeOrFinalize(aItem^.data.key, TypeInfo(aItem^.data.key), false);
- utlFreeOrFinalize(aItem^.data.value, TypeInfo(aItem^.data.value), aFreeItem and OwnsObjects);
- inherited DestroyItem(aItem, aFreeItem);
+ case fType of
+ eetNormal: result := fEvent (i1, i2);
+ eetObject: result := fEventO(i1, i2);
+ eetNested: result := fEventN(i1, i2);
+ end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlMapBase.TKeyValuePairComparer/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TKeyValuePairComparer.Compare(const i1, i2: TKeyValuePair): Integer;
+constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEvent);
begin
- result := fComparer.Compare(i1.Key, i2.Key);
+ inherited Create;
+ fType := eetNormal;
+ fEvent := aEvent;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlMapBase.TKeyValuePairComparer.Create(aComparer: IComparer);
+constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEventO);
begin
inherited Create;
- fComparer := aComparer;
+ fType := eetObject;
+ fEventO := aEvent;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlMapBase.TKeyValuePairComparer.Destroy;
+constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEventN);
begin
- fComparer := nil;
- inherited Destroy;
+ inherited Create;
+ fType := eetNested;
+ fEventN := aEvent;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlMapBase.TEnumeratorProxy//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TEnumeratorProxy.MoveNext: Boolean;
+function TutlComparer.Compare(constref i1, i2: T): Integer;
begin
- result := fEnumerator.MoveNext;
+ if (i1 < i2) then
+ result := -1
+ else if (i1 > i2) then
+ result := 1
+ else
+ result := 0;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlMapBase.TEnumeratorProxy.Create(const aEnumerator: THashSet.TEnumerator);
-begin
- inherited Create;
- fEnumerator := aEnumerator;
-end;
-
+//TutlCallbackComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlMapBase.TEnumeratorProxy.Destroy;
+function TutlCallbackComparer.Compare(constref i1, i2: T): Integer;
begin
- FreeAndNil(fEnumerator);
- inherited Destroy;
+ case fType of
+ cetNormal: result := fEvent (i1, i2);
+ cetObject: result := fEventO(i1, i2);
+ cetNested: result := fEventN(i1, i2);
+ end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlMapBase.TValueEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TValueEnumerator.GetCurrent: TValue;
+function TutlCallbackComparer.EqualityCompare(constref i1, i2: T): Boolean;
begin
- result := fEnumerator.GetCurrent.Value;
+ result := (Compare(i1, i2) = 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TValueEnumerator.GetEnumerator: TValueEnumerator;
+constructor TutlCallbackComparer.Create(const aEvent: TCompareEvent);
begin
- result := self;
+ inherited Create;
+ fType := cetNormal;
+ fEvent := aEvent;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlMapBase.TKeyEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TKeyEnumerator.GetCurrent: TKey;
+constructor TutlCallbackComparer.Create(const aEvent: TCompareEventO);
begin
- result := fEnumerator.GetCurrent.Key;
+ inherited Create;
+ fType := cetObject;
+ fEventO := aEvent;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TKeyEnumerator.GetEnumerator: TKeyEnumerator;
+constructor TutlCallbackComparer.Create(const aEvent: TCompareEventN);
begin
- result := self;
+ inherited Create;
+ fType := cetNested;
+ fEventN := aEvent;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlMapBase.TKeyWrapper///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlArrayContainer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TKeyWrapper.GetItem(const aIndex: Integer): TKey;
+function TutlArrayContainer.GetIsEmpty: Boolean;
begin
- result := fHashSet[aIndex].Key;
+ result := (Count = 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TKeyWrapper.GetCount: Integer;
+function TutlArrayContainer.GetInternalItem(const aIndex: Integer): PT;
begin
- result := fHashSet.Count;
+ if (aIndex < 0) or (aIndex >= fCapacity) then
+ raise EutlOutOfRange.Create('capacity out of range', aIndex, 0, fCapacity-1);
+ result := fList + aIndex;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TKeyWrapper.GetEnumerator: TKeyEnumerator;
+procedure TutlArrayContainer.SetCapacity(const aValue: integer);
begin
- result := TKeyEnumerator.Create(fHashSet.GetEnumerator);
+ if (fCapacity = aValue) then
+ exit;
+ if (aValue < Count) then
+ raise EutlArgument.Create('can not reduce capacity below count', 'Capacity');
+ ReAllocMem(fList, aValue * SizeOf(T));
+ FillByte((fList + fCapacity)^, (aValue - fCapacity) * SizeOf(T), 0);
+ fCapacity := aValue;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TKeyWrapper.GetReverseEnumerator: TKeyEnumerator;
+procedure TutlArrayContainer.Release(var aItem: T; const aFreeItem: Boolean);
begin
- result := TKeyEnumerator.Create(fHashSet.GetReverseEnumerator);
+ FinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem);
+ FillByte(aItem, SizeOf(aItem), 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlMapBase.TKeyWrapper.Create(const aHashSet: THashSet);
+procedure TutlArrayContainer.Shrink(const aExactFit: Boolean);
begin
- inherited Create;
- fHashSet := aHashSet;
+ if not fCanShrink then
+ raise EutlInvalidOperation.Create('shrinking is not allowed');
+ if (aExactFit) then
+ SetCapacity(Count)
+ else if (fCapacity > 128) and (Count < fCapacity shr 2) then // less than 25% used
+ SetCapacity(fCapacity shr 1); // shrink to 50%
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlMapBase.TKeyValuePairWrapper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TKeyValuePairWrapper.GetItem(const aIndex: Integer): TKeyValuePair;
+procedure TutlArrayContainer.Expand;
begin
- result := fHashSet[aIndex];
+ if (Count < fCapacity) then
+ exit;
+ if not fCanExpand then
+ raise EutlInvalidOperation.Create('expanding is not allowed');
+ if (fCapacity <= 0) then
+ SetCapacity(4)
+ else if (fCapacity < 128) then
+ SetCapacity(fCapacity shl 1) // + 100%
+ else
+ SetCapacity(fCapacity + fCapacity shr 2); // + 25%
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TKeyValuePairWrapper.GetCount: Integer;
+constructor TutlArrayContainer.Create(const aOwnsItems: Boolean);
begin
- result := fHashSet.Count;
+ inherited Create;
+ fOwnsItems := aOwnsItems;
+ fList := nil;
+ fCapacity := 0;
+ fCanExpand := true;
+ fCanShrink := true;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TKeyValuePairWrapper.GetEnumerator: THashSet.TEnumerator;
+destructor TutlArrayContainer.Destroy;
begin
- result := fHashSet.GetEnumerator;
+ if Assigned(fList) then begin
+ FreeMem(fList);
+ fList := nil;
+ end;
+ inherited Destroy;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.TKeyValuePairWrapper.GetReverseEnumerator: THashSet.TEnumerator;
-begin
- result := fHashSet.GetReverseEnumerator;
-end;
-
+//TutlQueue/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlMapBase.TKeyValuePairWrapper.Create(const aHashSet: THashSet);
+function TutlQueue.GetCount: Integer;
begin
- inherited Create;
- fHashSet := aHashSet;
+ result := fCount;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlMapBase///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.GetValues(const aKey: TKey): TValue;
+procedure TutlQueue.SetCapacity(const aValue: integer);
var
- i: Integer;
- kvp: TKeyValuePair;
-begin
- kvp.Key := aKey;
- i := fHashSetRef.IndexOf(kvp);
- if (i < 0) then
- FillByte(result{%H-}, SizeOf(result), 0)
- else
- result := fHashSetRef[i].Value;
-end;
+ cnt: Integer;
+begin
+ if (aValue < Count) then
+ raise EutlArgument.Create('can not reduce capacity below count', 'Capacity');
+
+ if (aValue < Capacity) then begin // is shrinking
+ if (fReadPos <= fWritePos) then begin // ReadPos Before WritePos -> Move To Begin
+ System.Move(GetInternalItem(fReadPos)^, GetInternalItem(0)^, SizeOf(T) * Count);
+ fReadPos := 0;
+ fWritePos := Count;
+ end else if (fReadPos > fWritePos) then begin // ReadPos Behind WritePos
+ cnt := Capacity - aValue;
+ System.Move(GetInternalItem(fReadPos)^, GetInternalItem(fReadPos - cnt)^, SizeOf(T) * cnt);
+ dec(fReadPos, cnt);
+ end;
+ end;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.GetValueAt(const aIndex: Integer): TValue;
-begin
- result := fHashSetRef[aIndex].Value;
-end;
+ inherited SetCapacity(aValue);
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.GetCount: Integer;
-begin
- result := fHashSetRef.Count;
+ // ReadPos After WritePos and Expanding
+ if (fReadPos > fWritePos) and (aValue > Capacity) then begin
+ cnt := aValue - Capacity;
+ System.Move(GetInternalItem(fReadPos)^, GetInternalItem(fReadPos - cnt)^, SizeOf(T) * cnt);
+ inc(fReadPos, cnt);
+ end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlMapBase.SetValues(const aKey: TKey; aValue: TValue);
-var
- i: Integer;
- kvp: TKeyValuePair;
-begin
- kvp.Key := aKey;
- kvp.Value := aValue;
- i := fHashSetRef.IndexOf(kvp);
- if (i < 0) then begin
- if not fAutoCreate then
- raise EutlMap.Create('key not found');
- fHashSetRef.Add(kvp);
- end else
- fHashSetRef[i] := kvp;
+procedure TutlQueue.Enqueue(constref aItem: T);
+begin
+ if (Count = Capacity) then
+ Expand;
+ fWritePos := fWritePos mod Capacity;
+ GetInternalItem(fWritePos)^ := aItem;
+ inc(fCount);
+ inc(fWritePos);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlMapBase.SetValueAt(const aIndex: Integer; aValue: TValue);
-var
- kvp: TKeyValuePair;
+function TutlQueue.Dequeue: T;
begin
- kvp := fHashSetRef[aIndex];
- kvp.Value := aValue;
- fHashSetRef[aIndex] := kvp;
+ result := Dequeue(false);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlMapBase.Add(const aKey: TKey; const aValue: TValue);
+function TutlQueue.Dequeue(const aFreeItem: Boolean): T;
var
- kvp: TKeyValuePair;
+ p: PT;
begin
- kvp.Key := aKey;
- kvp.Value := aValue;
- if not fHashSetRef.Add(kvp) then
- raise EutlMapKeyAlreadyExists.Create();
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('queue is empty');
+ p := GetInternalItem(fReadPos);
+ if aFreeItem
+ then FillByte(result, SizeOf(result), 0)
+ else result := p^;
+ Release(p^, aFreeItem);
+ dec(fCount);
+ fReadPos := (fReadPos + 1) mod Capacity;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.IndexOf(const aKey: TKey): Integer;
-var
- kvp: TKeyValuePair;
+function TutlQueue.Peek: T;
begin
- kvp.Key := aKey;
- result := fHashSetRef.IndexOf(kvp);
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('queue is empty');
+ result := GetInternalItem(fReadPos)^;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.Contains(const aKey: TKey): Boolean;
-var
- kvp: TKeyValuePair;
+procedure TutlQueue.ShrinkToFit;
begin
- kvp.Key := aKey;
- result := (fHashSetRef.IndexOf(kvp) >= 0);
+ Shrink(true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlMapBase.Delete(const aKey: TKey);
-var
- kvp: TKeyValuePair;
+procedure TutlQueue.Clear;
begin
- kvp.Key := aKey;
- if not fHashSetRef.Remove(kvp) then
- raise EutlMapKeyNotFound.Create;
+ while (fReadPos <> fWritePos) do begin
+ Release(GetInternalItem(fReadPos)^, true);
+ fReadPos := (fReadPos + 1) mod Capacity;
+ end;
+ fCount := 0;
+ if CanShrink then
+ ShrinkToFit;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlMapBase.DeleteAt(const aIndex: Integer);
+constructor TutlQueue.Create(const aOwnsItems: Boolean);
begin
- fHashSetRef.Delete(aIndex);
+ inherited Create(aOwnsItems);
+ fCount := 0;
+ fReadPos := 0;
+ fWritePos := 0;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlMapBase.Clear;
+destructor TutlQueue.Destroy;
begin
- fHashSetRef.Clear;
+ Clear;
+ inherited Destroy;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlMapBase.ForEach(const aEvent: TKeyValuePairEvent);
-var kvp: TKeyValuePair;
+//TutlStack/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlStack.GetCount: Integer;
begin
- if Assigned(aEvent) then
- for kvp in fHashSetRef do
- aEvent(self, kvp.Key, kvp.Value);
+ result := fCount;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.GetEnumerator: TValueEnumerator;
+procedure TutlStack.Push(constref aItem: T);
begin
- result := TValueEnumerator.Create(fHashSetRef.GetEnumerator);
+ if (Count = Capacity) then
+ Expand;
+ GetInternalItem(fCount)^ := aItem;
+ inc(fCount);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMapBase.GetReverseEnumerator: TValueEnumerator;
+function TutlStack.Pop: T;
begin
- result := TValueEnumerator.Create(fHashSetRef.GetReverseEnumerator);
+ Pop(false);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlMapBase.Create(const aHashSet: THashSet);
+function TutlStack.Pop(const aFreeItem: Boolean): T;
+var
+ p: PT;
begin
- inherited Create;
- fAutoCreate := false;
- fHashSetRef := aHashSet;
- fKeyWrapper := TKeyWrapper.Create(fHashSetRef);
- fKeyValuePairWrapper := TKeyValuePairWrapper.Create(fHashSetRef);
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('stack is empty');
+ p := GetInternalItem(fCount-1);
+ if aFreeItem
+ then FillByte(result, SizeOf(result), 0)
+ else result := p^;
+ Release(p^, aFreeItem);
+ dec(fCount);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlMapBase.Destroy;
+function TutlStack.Peek: T;
begin
- FreeAndNil(fKeyValuePairWrapper);
- FreeAndNil(fKeyWrapper);
- fHashSetRef := nil;
- inherited Destroy;
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('stack is empty');
+ result := GetInternalItem(fCount-1)^;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlMap.Create(const aOwnsObjects: Boolean);
+procedure TutlStack.ShrinkToFit;
begin
- inherited Create(TComparer.Create, aOwnsObjects);
+ Shrink(true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlQueue/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlQueue.GetCount: Integer;
+procedure TutlStack.Clear;
begin
- InterLockedExchange(result{%H-}, fCount);
+ while (fCount > 0) do begin
+ dec(fCount);
+ Release(GetInternalItem(fCount)^, true);
+ end;
+ if CanShrink then
+ ShrinkToFit;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlQueue.Push(const aItem: T);
-var
- p: PListItem;
+constructor TutlStack.Create(const aOwnsItems: Boolean);
begin
- new(p);
- p^.data := aItem;
- p^.next := nil;
- fLast^.next := p;
- fLast := fLast^.next;
- InterLockedIncrement(fCount);
+ inherited Create(aOwnsItems);
+ fCount := 0
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlQueue.Pop(out aItem: T): Boolean;
-var
- old: PListItem;
+destructor TutlStack.Destroy;
begin
- result := false;
- FillByte(aItem{%H-}, SizeOf(aItem), 0);
- if (Count <= 0) then
- exit;
- result := true;
- old := fFirst;
- fFirst := fFirst^.next;
- aItem := fFirst^.data;
- InterLockedDecrement(fCount);
- Dispose(old);
+ Clear;
+ inherited Destroy;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlQueue.Pop: Boolean;
-var
- tmp: T;
+//TutlSimpleList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlSimpleList.GetFirst: T;
begin
- result := Pop(tmp);
- utlFreeOrFinalize(tmp, TypeInfo(tmp), fOwnsObjects);
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := GetInternalItem(0)^;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlQueue.Clear;
+function TutlSimpleList.GetLast: T;
begin
- while Pop do;
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := GetInternalItem(fCount-1)^;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlQueue.Create(const aOwnsObjects: Boolean);
+function TutlSimpleList.GetItem(const aIndex: Integer): T;
begin
- inherited Create;
- new(fFirst);
- FillByte(fFirst^, SizeOf(fFirst^), 0);
- fLast := fFirst;
- fCount := 0;
- fOwnsObjects := aOwnsObjects;
+ if (aIndex < 0) or (aIndex >= fCount) then
+ raise EutlOutOfRange.Create(aIndex, 0, fCount-1);
+ result := GetInternalItem(aIndex)^;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlQueue.Destroy;
+procedure TutlSimpleList.SetItem(const aIndex: Integer; aValue: T);
+var
+ p: PT;
begin
- Clear;
- if Assigned(fLast) then begin
- Dispose(fLast);
- fLast := nil;
- end;
- inherited Destroy;
+ if (aIndex < 0) or (aIndex >= fCount) then
+ raise EutlOutOfRange.Create(aIndex, 0, fCount-1);
+ p := GetInternalItem(aIndex);
+ Release(p^, true);
+ p^ := aValue;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlSyncQueue/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSyncQueue.Push(const aItem: T);
+function TutlSimpleList.GetCount: Integer;
begin
- fPushLock.Enter;
- try
- inherited Push(aItem);
- finally
- fPushLock.Leave;
- end;
+ result := fCount;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSyncQueue.Pop(out aItem: T): Boolean;
+procedure TutlSimpleList.InsertIntern(const aIndex: Integer; constref aValue: T);
+var
+ p: PT;
begin
- fPopLock.Enter;
- try
- result := inherited Pop(aItem);
- finally
- fPopLock.Leave;
- end;
+ if (aIndex < 0) or (aIndex > fCount) then
+ raise EutlOutOfRange.Create(aIndex, 0, fCount);
+ if (fCount = Capacity) then
+ Expand;
+ p := GetInternalItem(aIndex);
+ if (aIndex < fCount) then
+ System.Move(p^, (p+1)^, (fCount - aIndex) * SizeOf(T));
+ p^ := aValue;
+ inc(fCount);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlSyncQueue.Create(const aOwnsObjects: Boolean);
+procedure TutlSimpleList.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
+var
+ p: PT;
begin
- inherited Create(aOwnsObjects);
- fPushLock := TutlSpinLock.Create;
- fPopLock := TutlSpinLock.Create;
+ if (aIndex < 0) or (aIndex >= fCount) then
+ raise EutlOutOfRange.Create(aIndex, 0, fCount-1);
+ dec(fCount);
+ p := GetInternalItem(aIndex);
+ Release(p^, aFreeItem);
+ System.Move((p+1)^, p^, SizeOf(T) * (fCount - aIndex));
+ if CanShrink and (Capacity > 128) and (fCount < Capacity shr 2) then // only 25% used
+ SetCapacity(Capacity shr 1); // set to 50% Capacity
+ FillByte(GetInternalItem(fCount)^, (Capacity-fCount) * SizeOf(T), 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlSyncQueue.Destroy;
+function TutlSimpleList.Add(constref aItem: T): Integer;
begin
- inherited Destroy; //inherited will pop all remaining items, so do not destroy spinlock before!
- FreeAndNil(fPushLock);
- FreeAndNil(fPopLock);
+ result := fCount;
+ InsertIntern(result, aItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlInterfaceList.TInterfaceEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlInterfaceList.TInterfaceEnumerator.GetCurrent: T;
+procedure TutlSimpleList.Insert(const aIndex: Integer; constref aItem: T);
begin
- result := T(fList[fPos]);
+ InsertIntern(aIndex, aItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlInterfaceList.TInterfaceEnumerator.MoveNext: Boolean;
+procedure TutlSimpleList.Exchange(const aIndex1, aIndex2: Integer);
+var
+ tmp: T;
+ p1, p2: PT;
begin
- inc(fPos);
- result := (fPos < fList.Count);
+ if (aIndex1 < 0) or (aIndex1 >= fCount) then
+ raise EutlOutOfRange.Create(aIndex1, 0, fCount-1);
+ if (aIndex2 < 0) or (aIndex2 >= fCount) then
+ raise EutlOutOfRange.Create(aIndex2, 0, fCount-1);
+ p1 := GetInternalItem(aIndex1);
+ p2 := GetInternalItem(aIndex2);
+ System.Move(p1^, tmp, SizeOf(T));
+ System.Move(p2^, p1^, SizeOf(T));
+ System.Move(tmp, p2^, SizeOf(T));
+ FillByte(tmp, SizeOf(tmp), 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlInterfaceList.TInterfaceEnumerator.Create(const aList: TInterfaceList);
+procedure TutlSimpleList.Move(const aCurrentIndex, aNewIndex: Integer);
+var
+ tmp: T;
+ cur, new: PT;
begin
- inherited Create;
- fPos := -1;
- fList := aList;
+ if (aCurrentIndex < 0) or (aCurrentIndex >= fCount) then
+ raise EutlOutOfRange.Create(aCurrentIndex, 0, fCount-1);
+ if (aNewIndex < 0) or (aNewIndex >= fCount) then
+ raise EutlOutOfRange.Create(aNewIndex, 0, fCount-1);
+ if (aCurrentIndex = aNewIndex) then
+ exit;
+ cur := GetInternalItem(aCurrentIndex);
+ new := GetInternalItem(aNewIndex);
+ System.Move(cur^, tmp, SizeOf(T));
+ if (aNewIndex > aCurrentIndex) then begin
+ System.Move((cur+1)^, cur^, SizeOf(T) * (aNewIndex - aCurrentIndex));
+ end else begin
+ System.Move(new^, (new+1)^, SizeOf(T) * (aCurrentIndex - aNewIndex));
+ end;
+ System.Move(tmp, new^, SizeOf(T));
+ FillByte(tmp, SizeOf(tmp), 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlInterfaceList/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlInterfaceList.Get(i : Integer): T;
+procedure TutlSimpleList.Delete(const aIndex: Integer);
begin
- result := T(inherited Get(i));
+ DeleteIntern(aIndex, true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlInterfaceList.Put(i : Integer; aItem : T);
+function TutlSimpleList.Extract(const aIndex: Integer): T;
begin
- inherited Put(i, aItem);
+ result := GetItem(aIndex);
+ DeleteIntern(aIndex, false);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlInterfaceList.First: T;
+procedure TutlSimpleList.ShrinkToFit;
begin
- result := T(inherited First);
+ Shrink(true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlInterfaceList.IndexOf(aItem : T): Integer;
+procedure TutlSimpleList.Clear;
begin
- result := inherited IndexOf(aItem);
+ while (fCount > 0) do begin
+ dec(fCount);
+ Release(GetInternalItem(fCount)^, true);
+ end;
+ fCount := 0;
+ if CanShrink then
+ ShrinkToFit;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlInterfaceList.Add(aItem : IUnknown): Integer;
+procedure TutlSimpleList.PushFirst(constref aItem: T);
begin
- result := inherited Add(aItem);
+ InsertIntern(0, aItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlInterfaceList.Insert(i : Integer; aItem : T);
+function TutlSimpleList.PopFirst(const aFreeItem: Boolean): T;
begin
- inherited Insert(i, aItem);
+ if aFreeItem
+ then FillByte(result, SizeOf(result), 0)
+ else result := GetItem(0);
+ DeleteIntern(0, aFreeItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlInterfaceList.Last : T;
+procedure TutlSimpleList.PushLast(constref aItem: T);
begin
- result := T(inherited Last);
+ InsertIntern(fCount, aItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlInterfaceList.Remove(aItem : T): Integer;
+function TutlSimpleList.PopLast(const aFreeItem: Boolean): T;
begin
- result := inherited Remove(aItem);
+ if aFreeItem
+ then FillByte(result, SizeOf(result), 0)
+ else result := GetItem(fCount-1);
+ DeleteIntern(fCount-1, aFreeItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlInterfaceList.GetEnumerator: TInterfaceEnumerator;
+destructor TutlSimpleList.Destroy;
begin
- result := TInterfaceEnumerator.Create(self);
+ Clear;
+ inherited Destroy;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlEnumHelper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class constructor TutlEnumHelper.Initialize;
-var
- tiArray: PTypeInfo;
- tdArray, tdEnum: PTypeData;
- aName: PShortString;
- i: integer;
- en: T;
-begin
- {
- See FPC Bug http://bugs.freepascal.org/view.php?id=27622
- For Sparse Enums, the compiler won't give us TypeInfo, because it contains some wrong data. This is
- safe, but sadly we don't even get the *correct* fields (TypeName, NameList), even though they are
- generated in any case.
- Fortunately, arrays do know this type info segment as their Element Type (and we declared one anyway).
- }
- tiArray := System.TypeInfo(TValueArray);
- tdArray := GetTypeData(tiArray);
- FTypeInfo:= tdArray^.elType2;
-
- {
- Now that we have the TypeInfo, fill our values from it. This is safe because while the *values* in
- TypeData are wrong for Sparse Enums, the *names* are always correct.
- }
- tdEnum:= GetTypeData(FTypeInfo);
- aName:= @tdEnum^.NameList;
- SetLength(FValues, 0);
- i:= 0;
- While Length(aName^) > 0 do begin
- SetLength(FValues, i+1);
- {
- Memory layout for TTypeData has the declaring EnumUnitName after the last NameList entry.
- This can normally not be the same as a valid enum value, because it is in the same identifier
- namespace. However, with scoped enums we might have the same name for module and element, because
- the full identifier for the element would be TypeName.ElementName.
- In either case, the next PShortString will point to a zero-length string, and the loop is left
- with the last element being invalid (either empty or whatever value the unit-named element has).
- }
- if TryToEnum(aName^, en) then
- FValues[i]:= en;
- inc(i);
- inc(PByte(aName), Length(aName^) + 1);
- end;
- // remove the EnumUnitName item
- SetLength(FValues, Length(FValues) - 1);
-end;
-
+//TutlCustomList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class function TutlEnumHelper.ToString(aValue: T): String;
+function TutlCustomList.IndexOf(const aItem: T): Integer;
begin
- {$Push}
- {$IOChecks OFF}
- WriteStr(Result, aValue);
- if IOResult = 107 then
- Result:= '';
- {$Pop}
+ result := Count-1;
+ while (result >= 0)
+ and not fEqualityComparer.EqualityCompare(Items[result], aItem)
+ do
+ dec(result);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class function TutlEnumHelper.TryToEnum(aStr: String; out aValue: T): Boolean;
+function TutlCustomList.Extract(const aItem: T; const aDefault: T): T;
var
- a: T;
+ i: Integer;
begin
- a := T(0);
- Result := false;
- if Length(aStr) = 0 then
- exit;
-
- {$Push}
- {$IOChecks OFF}
- ReadStr(aStr, a);
- Result:= IOResult <> 106;
- {$Pop}
- if Result then
- aValue := a;
+ i := IndexOf(aItem);
+ if (i >= 0) then begin
+ result := Items[i];
+ DeleteIntern(i, false);
+ end else
+ result := aDefault;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class function TutlEnumHelper.ToEnum(aStr: String): T;
+function TutlCustomList.Remove(const aItem: T): Integer;
begin
- if not TryToEnum(aStr, result) then
- raise EutlEnumConvert.Create(aStr, TypeInfo^.Name);
+ result := IndexOf(aItem);
+ if (result >= 0) then
+ DeleteIntern(result, true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class function TutlEnumHelper.ToEnum(aStr: String; const aDefault: T): T;
+constructor TutlCustomList.Create(const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
begin
- if not TryToEnum(aStr, result) then
- result := aDefault;
+ if not Assigned(aEqualityComparer) then
+ raise EutlArgumentNil.Create('aEqualityComparer');
+ inherited Create(aOwnsItems);
+ fEqualityComparer := aEqualityComparer;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class function TutlEnumHelper.Values: TValueArray;
+destructor TutlCustomList.Destroy;
begin
- Result:= FValues;
+ fEqualityComparer := nil;
+ inherited Destroy;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class function TutlEnumHelper.TypeInfo: PTypeInfo;
+//TutlList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlList.Create(const aOwnsItems: Boolean);
begin
- Result:= FTypeInfo;
+ inherited Create(TEqualityComparer.Create, aOwnsItems);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlRingBuffer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlLinkedList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlRingBuffer.Create(const Elements: Integer);
+procedure TutlLinkedList.TIterator.ReleaseElement(const aElement: PElement);
begin
- inherited Create;
- fAborted:= false;
- fDataLen:= Elements;
- fDataSize:= SizeOf(T);
- SetLength(fData, fDataLen);
- fWritePtr:= 1;
- fReadPtr:= 0;
- fFillState:= 0;
- fReadEvent:= TutlAutoResetEvent.Create;
- fWrittenEvent:= TutlAutoResetEvent.Create;
+ if (aElement = fElement) then
+ fElement := nil;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlRingBuffer.Destroy;
+function TutlLinkedList.TIterator.MoveNext: Boolean;
begin
- BreakPipe;
- FreeAndNil(fReadEvent);
- FreeAndNil(fWrittenEvent);
- SetLength(fData, 0);
- inherited Destroy;
+ if not Assigned(fElement) then
+ raise EutlInvalidOperation.Create('this is the null iterator');
+ result := Assigned(fElement^.next);
+ if result then
+ fElement := fElement^.next;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlRingBuffer.Read(Buf: Pointer; Items: integer; BlockUntilAvail: boolean): integer;
-var
- wp, c, r: Integer;
+function TutlLinkedList.TIterator.Clone: IutlIterator;
begin
- Result:= 0;
- while Items > 0 do begin
- if fAborted then
- exit;
-
- InterLockedExchange(wp{%H-}, fWritePtr);
- r:= (fReadPtr + 1) mod fDataLen;
- if wp < r then
- wp:= fDataLen;
- c:= wp - r;
- if c > Items then
- c:= Items;
- if c > 0 then begin
- Move(fData[r], Buf^, c * fDataSize);
- Dec(Items, c);
- inc(Result, c);
- dec(fFillState, c);
- inc(PByte(Buf), c * fDataSize);
- InterLockedExchange(fReadPtr, (fReadPtr + c) mod fDataLen);
- fReadEvent.SetEvent;
- end else begin
- if not BlockUntilAvail then
- break;
- fWrittenEvent.WaitFor(INFINITE);
- end;
- end;
+ result := fOwner.CreateIterator(fElement);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlRingBuffer.Write(Buf: Pointer; Items: integer; BlockUntilDone: boolean): integer;
+function TutlLinkedList.TIterator.Equals(const aOther: IutlIterator): Boolean;
var
- rp, c: integer;
+ o: TIterator;
begin
- Result:= 0;
- while Items > 0 do begin
- if fAborted then
- exit;
-
- InterLockedExchange(rp{%H-}, fReadPtr);
- if rp < fWritePtr then
- rp:= fDataLen;
- c:= rp - fWritePtr;
- if c > Items then
- c:= Items;
- if c > 0 then begin
- Move(Buf^, fData[fWritePtr], c * fDataSize);
- dec(Items, c);
- inc(Result, c);
- inc(fFillState, c);
- inc(PByte(Buf), c * fDataSize);
- InterLockedExchange(fWritePtr, (fWritePtr + c) mod fDataLen);
- fWrittenEvent.SetEvent;
- end else begin
- if not BlockUntilDone then
- Break;
- fReadEvent.WaitFor(INFINITE);
- end;
- end;
+ result := Supports(aOther, TIterator, o)
+ and (fElement = o.fElement)
+ and (fOwner = o.fOwner);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlRingBuffer.BreakPipe;
+function TutlLinkedList.TIterator.GetIsValid: Boolean;
begin
- fAborted:= true;
- fWrittenEvent.SetEvent;
- fReadEvent.SetEvent;
+ result := Assigned(fElement);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlPagedDataFiFo.TDataProvider///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.TDataProvider.Give(const aBuffer: PData; aCount: Integer): Integer;
+function TutlLinkedList.TIterator.MovePrev: Boolean;
begin
- result := 0;
- if (aCount > fCount - fPos) then
- aCount := fCount - fPos;
- if (aCount <= 0) then
- exit;
- Move((fData + fPos)^, aBuffer^, aCount * SizeOf(TData));
- inc(fPos, aCount);
- result := aCount;
+ if not Assigned(fElement) then
+ raise EutlInvalidOperation.Create('this is the null iterator');
+ result := Assigned(fElement^.prev);
+ if result then
+ fElement := fElement^.prev;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlPagedDataFiFo.TDataProvider.Create(const aData: PData; const aCount: Integer);
+function TutlLinkedList.TIterator.GetValue: T;
begin
- inherited Create;
- fData := aData;
- fCount := aCount;
- fPos := 0;
+ if not Assigned(fElement) then
+ raise EutlInvalidOperation.Create('this is the null iterator');
+ result := fElement^.data;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlPagedDataFiFo.TDataConsumer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.TDataConsumer.Take(const aBuffer: PData; aCount: Integer): Integer;
+procedure TutlLinkedList.TIterator.SetValue(const aValue: T);
begin
- result := 0;
- if (aCount > fCount - fPos) then
- aCount := fCount - fPos;
- if (aCount <= 0) then
- exit;
- Move(aBuffer^, (fData + fPos)^, aCount * SizeOf(TData));
- inc(fPos, aCount);
- result := aCount;
+ if not Assigned(fElement) then
+ raise EutlInvalidOperation.Create('this is the null iterator');
+ fElement^.data := aValue;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlPagedDataFiFo.TDataConsumer.Create(const aData: PData; const aCount: Integer);
+constructor TutlLinkedList.TIterator.Create(const aElement: PElement; const aOwner: TutlLinkedList);
begin
inherited Create;
- fData := aData;
- fCount := aCount;
- fPos := 0;
+ fOwner := aOwner;
+ fElement := aElement;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlPagedDataFiFo.TNestedDataProvider/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.TNestedDataProvider.Give(const aBuffer: PData; aCount: Integer): Integer;
+destructor TutlLinkedList.TIterator.Destroy;
begin
- result := fCallback(aBuffer, aCount);
+ if Assigned(fOwner) then
+ fOwner.DestroyIterator(self);
+ inherited Destroy;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlPagedDataFiFo.TNestedDataProvider.Create(const aCallback: TDataCallback);
+//TutlLinkedList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlLinkedList.GetFirst: Iterator;
begin
- inherited Create;
- fCallback := aCallback;
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := CreateIterator(fFirst);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlPagedDataFiFo.TNestedDataConsumer/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.TNestedDataConsumer.Take(const aBuffer: PData; aCount: Integer): Integer;
+function TutlLinkedList.GetLast: Iterator;
begin
- result := fCallback(aBuffer, aCount);
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := CreateIterator(fLast);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlPagedDataFiFo.TNestedDataConsumer.Create(const aCallback: TDataCallback);
+function TutlLinkedList.GetIsEmpty: Boolean;
begin
- inherited Create;
- fCallback := aCallback;
+ result := (fCount = 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlPagedDataFiFo.TStreamDataProvider/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.TStreamDataProvider.Give(const aBuffer: PData; aCount: Integer): Integer;
+procedure TutlLinkedList.LinkElement(const aElement: PElement);
begin
- result := fStream.Read(aBuffer^, aCount);
+ if Assigned(aElement^.prev) then begin
+ aElement^.prev^.next := aElement;
+ if (aElement^.prev = fLast) then
+ fLast := aElement;
+ end;
+ if Assigned(aElement^.next) then begin
+ aElement^.next^.prev := aElement;
+ if (aElement^.next = fFirst) then
+ fFirst := aElement;
+ end;
+ if not Assigned(fFirst) then
+ fFirst := aElement;
+ if not Assigned(fLast) then
+ fLast := aElement;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlPagedDataFiFo.TStreamDataProvider.Create(const aStream: TStream);
+procedure TutlLinkedList.InsertBefore(const aElement: PElement; constref aItem: T);
+var
+ e: PElement;
begin
- inherited Create;
- fStream := aStream;
+ new(e);
+ e^.data := aItem;
+ if Assigned(aElement) then begin
+ e^.next := aElement;
+ e^.prev := aElement^.prev;
+ end else begin
+ e^.next := nil;
+ e^.prev := nil;
+ end;
+ inc(fCount);
+ LinkElement(e);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlPagedDataFiFo.TStreamDataConsumer/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.TStreamDataConsumer.Take(const aBuffer: PData; aCount: Integer): Integer;
+procedure TutlLinkedList.InsertAfter(const aElement: PElement; constref aItem: T);
+var
+ e: PElement;
begin
- result := fStream.Write(aBuffer^, aCount);
+ new(e);
+ e^.data := aItem;
+ if Assigned(aElement) then begin
+ e^.prev := aElement;
+ e^.next := aElement^.next;
+ end else begin
+ e^.next := nil;
+ e^.prev := nil;
+ end;
+ inc(fCount);
+ LinkElement(e);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlPagedDataFiFo.TStreamDataConsumer.Create(const aStream: TStream);
+function TutlLinkedList.Remove(const aElement: PElement; const aFreeItem: Boolean): T;
+var
+ i: Integer;
begin
- inherited Create;
- fStream := aStream;
+ if (aElement = fFirst) then
+ fFirst := aElement^.next;
+ if (aElement = fLast) then
+ fLast := aElement^.prev;
+ if Assigned(aElement^.prev) then
+ aElement^.prev^.next := aElement^.next;
+ if Assigned(aElement^.next) then
+ aElement^.next^.prev := aElement^.prev;
+ if aFreeItem
+ then FillByte(result, SizeOf(result), 0)
+ else result := aElement^.data;
+ Release(aElement^.data, aFreeItem);
+ for i := Low(fIterators) to High(fIterators) do
+ fIterators[i].ReleaseElement(aElement);
+ dec(fCount);
+ Dispose(aElement);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlPagedDataFiFo/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.WriteIntern(const aProvider: IDataProvider; aCount: Integer): Integer;
-var
- c, r: Integer;
- p: PPage;
-begin
- if not Assigned(aProvider) then
- raise EArgumentNil.Create('aProvider');
-
- result := 0;
- while (aCount > 0) do begin
- if not Assigned(fWritePage) or (fWritePage^.WritePos >= fPageSize) then begin
- new(p);
- p^.ReadPos := 0;
- p^.WritePos := 0;
- p^.Next := nil;
- SetLength(p^.Data, fPageSize);
- if Assigned(fWritePage) then
- fWritePage^.Next := p;
- fWritePage := p;
- if not Assigned(fReadPage) then
- fReadPage := fWritePage;
- end;
-
- c := fPageSize - fWritePage^.WritePos;
- if (c > aCount) then
- c := aCount;
-
- r := aProvider.Give(@fWritePage^.Data[fWritePage^.WritePos], c);
- if (r = 0) then
- exit;
-
- inc(result, r);
- inc(fWritePage^.WritePos, r);
- inc(fSize, r);
- dec(aCount, r);
- end;
+function TutlLinkedList.CreateIterator(const aElement: PElement): TIterator;
+begin
+ result := TIterator.Create(aElement, self);
+ SetLength(fIterators, Length(fIterators) + 1);
+ fIterators[High(fIterators)] := result;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.ReadIntern(const aConsumer: IDataConsumer; aCount: Integer; const aMoveReadPos: Boolean): Integer;
+procedure TutlLinkedList.DestroyIterator(const aIterator: TIterator);
var
- ReadPage: PPage;
- DummyPage: TPage;
- c, r: Integer;
-
+ i: Integer;
begin
- result := 0;
-
- if not Assigned(fReadPage) then
- exit;
-
- //init read page
- if not aMoveReadPos then begin
- DummyPage := fReadPage^; // copy page (data is not copied, because it's a dynamic array)
- ReadPage := @DummyPage;
- end else
- ReadPage := fReadPage;
-
- while (aCount > 0) do begin
- if (ReadPage^.ReadPos >= fPageSize) then begin
- if not Assigned(ReadPage^.Next) then
- exit;
- if aMoveReadPos then begin
- if (fReadPage = fWritePage) then // write finished with page end, so reset WritePage wenn disposing ReadPage
- fWritePage := nil;
- fReadPage := fReadPage^.Next;
- Dispose(ReadPage);
- ReadPage := fReadPage;
- end else
- ReadPage^ := ReadPage^.Next^;
- end;
-
- c := ReadPage^.WritePos - ReadPage^.ReadPos;
- if (c = 0) then
+ for i := Low(fIterators) to High(fIterators) do begin
+ if (fIterators[i] = aIterator) then begin
+ if (i < High(fIterators)) then
+ System.Move(fIterators[i+1], fIterators[i], (High(fIterators)-i) * SizeOf(TIterator));
+ SetLength(fIterators, High(fIterators));
exit;
- if (c > aCount) then
- c := aCount;
-
- if Assigned(aConsumer) then begin
-
- r := aConsumer.Take(@ReadPage^.Data[ReadPage^.ReadPos], c);
- if (r = 0) then
- exit;
- end else
- r := c;
-
- inc(result, r);
- inc(ReadPage^.ReadPos, r);
- dec(aCount, r);
- if aMoveReadPos then
- dec(fSize, r);
+ end;
end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.Write(const aProvider: IDataProvider; const aCount: Integer): Integer;
+procedure TutlLinkedList.Release(var aItem: T; const aFreeItem: Boolean);
begin
- result := WriteIntern(aProvider, aCount);
+ FinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem);
+ FillByte(aItem, SizeOf(aItem), 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.Write(const aData: PData; const aCount: Integer): Integer;
-var
- provider: IDataProvider;
+procedure TutlLinkedList.PushFirst(constref aItem: T);
begin
- provider := TDataProvider.Create(aData, aCount);
- result := WriteIntern(provider, aCount);
+ InsertBefore(fFirst, aItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.Read(const aConsumer: IDataConsumer; const aCount: Integer): Integer;
+function TutlLinkedList.PopFirst(const aFreeItem: Boolean): T;
begin
- result := ReadIntern(aConsumer, aCount, true);
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := Remove(fFirst, aFreeItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.Read(const aData: PData; const aCount: Integer): Integer;
-var
- consumer: IDataConsumer;
+procedure TutlLinkedList.PopFirst;
begin
- consumer := TDataConsumer.Create(aData, aCount);
- result := ReadIntern(consumer, aCount, true);
+ PopFirst(true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.Peek(const aConsumer: IDataConsumer; const aCount: Integer): Integer;
+procedure TutlLinkedList.PushLast(constref aItem: T);
begin
- result := ReadIntern(aConsumer, aCount, false);
+ InsertAfter(fLast, aItem)
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.Peek(const aData: PData; const aCount: Integer): Integer;
-var
- consumer: IDataConsumer;
+function TutlLinkedList.PopLast(const aFreeItem: Boolean): T;
begin
- consumer := TDataConsumer.Create(aData, aCount);
- result := ReadIntern(consumer, aCount, false);
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := Remove(fLast, aFreeItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlPagedDataFiFo.Discard(const aCount: Integer): Integer;
+procedure TutlLinkedList.PopLast;
begin
- result := ReadIntern(nil, aCount, true);
+ PopLast(true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlPagedDataFiFo.Clear;
+procedure TutlLinkedList.InsertBefore(const aIterator: IutlIterator; constref aItem: T);
var
- tmp: PPage;
+ i: TIterator;
begin
- while Assigned(fReadPage) do begin
- tmp := fReadPage;
- fReadPage := tmp^.Next;
- Dispose(tmp);
- end;
- fReadPage := nil;
- fWritePage := nil;
+ if not Supports(aIterator, TIterator, i) or (i.Owner <> self) then
+ raise EutlArgument.Create('iterator belongs not to this object', 'aIterator');
+ if not Assigned(i.Element) then
+ raise EutlInvalidOperation.Create('this is the null iterator');
+ InsertBefore(i.Element, aItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlPagedDataFiFo.Create(const aPageSize: Integer);
+procedure TutlLinkedList.InsertAfter(const aIterator: IutlIterator; constref aItem: T);
+var
+ i: TIterator;
begin
- inherited Create;
- fReadPage := nil;
- fWritePage := nil;
- fPageSize := aPageSize;
+ if not Supports(aIterator, TIterator, i) or (i.Owner <> self) then
+ raise EutlArgument.Create('iterator belongs not to this object', 'aIterator');
+ if not Assigned(i.Element) then
+ raise EutlInvalidOperation.Create('this is the null iterator');
+ InsertAfter(i.Element, aItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlPagedDataFiFo.Destroy;
+function TutlLinkedList.Remove(const aIterator: IutlIterator; const aFreeItem: Boolean): T;
+var
+ i: TIterator;
begin
- Clear;
- inherited Destroy;
+ if not Supports(aIterator, TIterator, i) or (i.Owner <> self) then
+ raise EutlArgument.Create('iterator belongs not to this object', 'aIterator');
+ if not Assigned(i.Element) then
+ raise EutlInvalidOperation.Create('this is the null iterator');
+ result := Remove(i.Element, aFreeItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlSyncPagedDataFiFo/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSyncPagedDataFiFo.WriteIntern(const aProvider: IDataProvider; aCount: Integer): Integer;
+procedure TutlLinkedList.Remove(const aIterator: IutlIterator);
begin
- fLock.Enter;
- try
- result := inherited WriteIntern(aProvider, aCount);
- finally
- fLock.Leave;
- end;
+ Remove(aIterator, true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSyncPagedDataFiFo.ReadIntern(const aConsumer: IDataConsumer; aCount: Integer; const aMoveReadPos: Boolean): Integer;
+procedure TutlLinkedList.Clear;
begin
- fLock.Enter;
- try
- result := inherited ReadIntern(aConsumer, aCount, aMoveReadPos);
- finally
- fLock.Leave;
- end;
+ while (Count > 0) do
+ PopLast(true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlSyncPagedDataFiFo.Create(const aPageSize: Integer);
+constructor TutlLinkedList.Create(const aOwnsItems: Boolean);
begin
- inherited Create(aPageSize);
- fLock := TutlSpinLock.Create;
+ inherited Create;
+ fOwnsItems := aOwnsItems;
+ fFirst := nil;
+ fLast := nil;
+ fCount := 0;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlSyncPagedDataFiFo.Destroy;
+destructor TutlLinkedList.Destroy;
begin
+ Clear;
inherited Destroy;
- FreeAndNil(fLock);
end;
end.
+