diff --git a/tests/tests.lpi b/tests/tests.lpi
index c85aaa2..2938d56 100644
--- a/tests/tests.lpi
+++ b/tests/tests.lpi
@@ -37,7 +37,7 @@
-
+
@@ -66,6 +66,26 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/tests.lpr b/tests/tests.lpr
index 9fa5f8d..8942632 100644
--- a/tests/tests.lpr
+++ b/tests/tests.lpr
@@ -3,7 +3,8 @@ program tests;
{$mode objfpc}{$H+}
uses
- Interfaces, Forms, GUITestRunner, uutlQueueTests, uutlStackTests, uutlListTest, uutlAlgorithm, uutlLinkedListTests;
+ Interfaces, Forms, GUITestRunner,
+ uutlQueueTests, uutlStackTests, uutlListTest, uutlLinkedListTests, uutlHashSetTests, uutlMapTests;
{$R *.res}
diff --git a/tests/tests.lps b/tests/tests.lps
index af8eec2..a5c44a9 100644
--- a/tests/tests.lps
+++ b/tests/tests.lps
@@ -2,208 +2,326 @@
-
+
-
+
-
-
-
-
+
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
+
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/uutlHashSetTests.pas b/tests/uutlHashSetTests.pas
new file mode 100644
index 0000000..39b4f7b
--- /dev/null
+++ b/tests/uutlHashSetTests.pas
@@ -0,0 +1,122 @@
+unit uutlHashSetTests;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, TestFramework,
+ uutlGenerics;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TIntSet = specialize TutlHastSet;
+ TutlHastSetTests = class(TTestCase)
+ private
+ fIntSet: TIntSet;
+
+ protected
+ procedure SetUp; override;
+ procedure TearDown; override;
+
+ published
+ procedure Prop_Count;
+
+ procedure Meth_Add;
+ procedure Meth_Contains;
+ procedure Meth_IndexOf;
+ procedure Meth_Remove;
+ procedure Meth_Delete;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlHastSetTests//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHastSetTests.SetUp;
+begin
+ fIntSet := TIntSet.Create(true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHastSetTests.TearDown;
+begin
+ FreeAndNil(fIntSet);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHastSetTests.Prop_Count;
+begin
+ AssertEquals(0, fIntSet.Count);
+ fIntSet.Add(123);
+ AssertEquals(1, fIntSet.Count);
+ fIntSet.Add(234);
+ AssertEquals(2, fIntSet.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHastSetTests.Meth_Add;
+begin
+ AssertTrue (fIntSet.Add(123));
+ AssertFalse(fIntSet.Add(123));
+ AssertTrue (fIntSet.Add(234));
+ AssertFalse(fIntSet.Add(234));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHastSetTests.Meth_Contains;
+begin
+ AssertFalse(fIntSet.Contains(123));
+ fIntSet.Add(123);
+ AssertTrue (fIntSet.Contains(123));
+
+ AssertFalse(fIntSet.Contains(234));
+ fIntSet.Add(234);
+ AssertTrue (fIntSet.Contains(234));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHastSetTests.Meth_IndexOf;
+begin
+ AssertEquals(-1, fIntSet.IndexOf(234));
+ fIntSet.Add(234);
+ AssertEquals(0, fIntSet.IndexOf(234));
+
+ AssertEquals(-1, fIntSet.IndexOf(345));
+ fIntSet.Add(345);
+ AssertEquals(0, fIntSet.IndexOf(234));
+ AssertEquals(1, fIntSet.IndexOf(345));
+
+ AssertEquals(-1, fIntSet.IndexOf(123));
+ fIntSet.Add(123);
+ AssertEquals(0, fIntSet.IndexOf(123));
+ AssertEquals(1, fIntSet.IndexOf(234));
+ AssertEquals(2, fIntSet.IndexOf(345));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHastSetTests.Meth_Remove;
+begin
+ AssertFalse(fIntSet.Remove(123));
+ fIntSet.Add(123);
+ AssertTrue(fIntSet.Remove(123));
+
+ AssertFalse(fIntSet.Remove(234));
+ fIntSet.Add(234);
+ AssertTrue(fIntSet.Remove(234));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHastSetTests.Meth_Delete;
+begin
+ fIntSet.Add(123);
+ fIntSet.Delete(0);
+ AssertTrue(fIntSet.IsEmpty);
+end;
+
+initialization
+ RegisterTest(TutlHastSetTests.Suite);
+
+end.
+
diff --git a/tests/uutlInterfaces.pas b/tests/uutlInterfaces.pas
new file mode 100644
index 0000000..0d5e3e6
--- /dev/null
+++ b/tests/uutlInterfaces.pas
@@ -0,0 +1,408 @@
+unit uutlInterfaces;
+
+{$mode objfpc}{$H+}
+{$modeswitch nestedprocvars}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Container/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlEnumerator = interface(specialize IEnumerator)
+ ['{134FAC2F-3F23-4BD8-88FB-4B3BD2253E03}']
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlEnumerable = interface(specialize IEnumerable)
+ ['{B6B43A0E-754C-43D0-829A-6632F922A2DE}']
+ function GetUtlEnumerator: specialize IutlEnumerator;
+
+ property Enumerator: specialize IutlEnumerator read GetUtlEnumerator;
+ end;
+
+ ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlReadOnlyIndexer = interface(IUnknown)
+ ['{9E502CF8-3223-4784-8DB7-614187FFFE68}']
+ function GetCount: Integer;
+ function GetItem(const aIndex: Integer): T;
+
+ property Count: Integer read GetCount;
+ property Items[const aIndex: Integer]: T read GetItem;
+ end;
+
+ ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlIndexer = interface(specialize IutlReadOnlyIndexer)
+ ['{4CA50BE2-A1DF-48BE-9E83-0C94015BA873}']
+ procedure SetItem(const aIndex: Integer; aItem: T);
+
+ property Items[const aIndex: Integer]: T read GetItem write SetItem;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Comparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlEqualityComparer = interface(IUnknown)
+ ['{C0FB90CC-D071-490F-BFEE-BAA5C94D1A5B}']
+ function EqualityCompare(constref i1, i2: T): Boolean;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ 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
+ function EqualityCompare(constref i1, i2: T): Boolean;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ 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;
+
+ generic TutlCalbackEqualityComparer = class(TInterfacedObject, specialize IutlEqualityComparer)
+ private type
+ TEqualityCompareEventType = (eetNormal, eetObject, eetNested);
+
+ public type
+ TCompareEvent = specialize TutlEqualityCompareEvent;
+ TCompareEventO = specialize TutlEqualityCompareEventO;
+ TCompareEventN = specialize TutlEqualityCompareEventN;
+
+ strict private
+ fType: TEqualityCompareEventType;
+ fEvent: TCompareEvent;
+ fEventO: TCompareEventO;
+ fEventN: TCompareEventN;
+
+ public
+ 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 TutlComparer = class(specialize TutlEqualityComparer, specialize IutlComparer)
+ public
+ function Compare(constref i1, i2: T): Integer;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ 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
+ TCompareEvent = specialize TutlCompareEvent;
+ TCompareEventO = specialize TutlCompareEventO;
+ TCompareEventN = specialize TutlCompareEventN;
+
+ strict private
+ fType: TCompareEventType;
+ fEvent: TCompareEvent;
+ fEventO: TCompareEventO;
+ fEventN: TCompareEventN;
+
+ public
+ 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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Iterators/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ IutlIterator = interface(IUnknown)
+ ['{327E7628-C9D8-4C47-9630-E979D9C3293D}']
+ function MoveNext: Boolean;
+ function Clone: IutlIterator;
+ function Equals(const aOther: IutlIterator): Boolean;
+ function GetIsValid: Boolean;
+
+ property IsValid: Boolean read GetIsValid;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ IutlBidirectionalIterator = interface(IutlIterator)
+ ['{31D1E828-52CC-467F-8254-2C1384B28DEE}']
+ function MovePrev: Boolean;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ IutlRandomAccessIterator = interface(IutlBidirectionalIterator)
+ ['{AE06BAB6-BB17-4E46-AE88-583EB853233E}']
+ function Increment (const aCount: Integer): Boolean;
+ function Decrement (const aCount: Integer): Boolean;
+ function Compare (constref aOther: IutlRandomAccessIterator): Integer;
+ function GetDifference(constref aOther: IutlRandomAccessIterator): Integer;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlInputIterator = interface(IutlIterator)
+ ['{BD4ED39B-2BBA-41F7-BDC7-E1B45F41AA84}']
+ function GetItem: T;
+
+ property Item: T read GetItem;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlOutputIterator = interface(IutlIterator)
+ ['{132642C1-5235-4450-8956-2092D3F2F83D}']
+ procedure SetItem(aValue: T);
+
+ property Item: T write SetItem;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlInputOutputIterator = interface(IutlIterator)
+ ['{5367DA1F-F98C-4EE7-A454-E8978E2A9B46}']
+ function GetItem: T;
+ procedure SetItem(aValue: T);
+
+ property Item: T read GetItem write SetItem;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlBidirectionalInputIterator = interface(IutlBidirectionalIterator)
+ ['{B2423828-F187-4620-8DA2-9C4EF68B81E3}']
+ function GetItem: T;
+
+ property Item: T read GetItem;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlBidirectionalOutputIterator = interface(IutlBidirectionalIterator)
+ ['{1A13E581-200B-41E7-BC7D-9AD5192DEF0F}']
+ procedure SetItem(aValue: T);
+
+ property Item: T write SetItem;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlBidirectionalInputOutputIterator = interface(IutlBidirectionalIterator)
+ ['{BD8A6D08-7980-45D1-86A6-838402F5CBA6}']
+ function GetItem: T;
+ procedure SetItem(aItem: T);
+
+ property Item: T read GetItem write SetItem;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlRandomAccessInputIterator = interface(IutlRandomAccessIterator)
+ ['{47880DCC-49D4-45C7-90CB-D8E915B7CB0D}']
+ function GetItem: T;
+ function GetItems(const aIndex: Integer): T;
+
+ property Item: T read GetItem;
+ property Items[const aIndex: Integer]: T read GetItems;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlRandomAccessOutputIterator = interface(IutlRandomAccessIterator)
+ ['{E768DA58-E666-47F1-B7D8-61EB6C33C379}']
+ procedure SetItem(aValue: T);
+ procedure SetItems(const aIndex: Integer; aValue: T);
+
+ property Item: T write SetItem;
+ property Items[const aIndex: Integer]: T write SetItems;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlRandomAccessInputOutputIterator = interface(IutlRandomAccessIterator)
+ ['{3A8D3C5D-1085-4073-B1D4-DF1886827B6A}']
+ function GetItem: T;
+ function GetItems(const aIndex: Integer): T;
+
+ procedure SetItem (const aValue: T);
+ procedure SetItems(const aIndex: Integer; aValue: T);
+
+ property Item: T read GetItem write SetItem;
+ property Items[const aIndex: Integer]: T read GetItems write SetItems;
+ end;
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+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;
+operator -(aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator;
+operator < (const i1, i2: TObject): Boolean; inline;
+operator > (const i1, i2: TObject): Boolean; inline;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function IncIt(aIterator: IutlIterator): Boolean;
+begin
+ result := aIterator.MoveNext;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function DecIt(aIterator: IutlBidirectionalIterator): Boolean;
+begin
+ result := aIterator.MovePrev;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function IncIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean;
+begin
+ result := aIterator.Increment(a);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function DecIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean;
+begin
+ result := aIterator.Decrement(a);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+operator + (aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator;
+begin
+ result := IutlRandomAccessIterator(aIterator.Clone);
+ result.Increment(a);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+operator - (aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator;
+begin
+ result := IutlRandomAccessIterator(aIterator.Clone);
+ result.Decrement(a);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+operator < (const i1, i2: TObject): Boolean;
+begin
+ result := Pointer(i1) < Pointer(i2);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+operator > (const i1, i2: TObject): Boolean;
+begin
+ result := Pointer(i1) > Pointer(i2);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlEqualityComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
+begin
+ result := (i1 = i2);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlCalbackEqualityComparer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlCalbackEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
+begin
+ case fType of
+ eetNormal: result := fEvent (i1, i2);
+ eetObject: result := fEventO(i1, i2);
+ eetNested: result := fEventN(i1, i2);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEvent);
+begin
+ inherited Create;
+ fType := eetNormal;
+ fEvent := aEvent;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEventO);
+begin
+ inherited Create;
+ fType := eetObject;
+ fEventO := aEvent;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEventN);
+begin
+ inherited Create;
+ fType := eetNested;
+ fEventN := aEvent;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlComparer.Compare(constref i1, i2: T): Integer;
+begin
+ if (i1 < i2) then
+ result := -1
+ else if (i1 > i2) then
+ result := 1
+ else
+ result := 0;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlCallbackComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlCallbackComparer.Compare(constref i1, i2: T): Integer;
+begin
+ case fType of
+ cetNormal: result := fEvent (i1, i2);
+ cetObject: result := fEventO(i1, i2);
+ cetNested: result := fEventN(i1, i2);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlCallbackComparer.EqualityCompare(constref i1, i2: T): Boolean;
+begin
+ result := (Compare(i1, i2) = 0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlCallbackComparer.Create(const aEvent: TCompareEvent);
+begin
+ inherited Create;
+ fType := cetNormal;
+ fEvent := aEvent;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlCallbackComparer.Create(const aEvent: TCompareEventO);
+begin
+ inherited Create;
+ fType := cetObject;
+ fEventO := aEvent;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlCallbackComparer.Create(const aEvent: TCompareEventN);
+begin
+ inherited Create;
+ fType := cetNested;
+ fEventN := aEvent;
+end;
+
+end.
+
diff --git a/tests/uutlLinkedListTests.pas b/tests/uutlLinkedListTests.pas
index 069ae59..2e4bea8 100644
--- a/tests/uutlLinkedListTests.pas
+++ b/tests/uutlLinkedListTests.pas
@@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, TestFramework,
- uTestHelper, uutlGenerics, uutlExceptions;
+ uutlGenerics, uutlExceptions;
type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -36,6 +36,7 @@ type
procedure Meth_Clear;
procedure Iterator;
+ procedure CompleteIteration;
end;
implementation
@@ -92,46 +93,40 @@ 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);
+ AssertEquals(123, fIntList.First);
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);
+ AssertEquals(234, fIntList.Last);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Meth_PushFirst_PopFirst;
begin
fIntList.PushFirst(123);
- AssertEquals(123, fIntList.First.Value);
+ AssertEquals(123, fIntList.First);
fIntList.PushFirst(234);
- AssertEquals(234, fIntList.First.Value);
+ AssertEquals(234, fIntList.First);
fIntList.PushFirst(345);
- AssertEquals(345, fIntList.First.Value);
+ AssertEquals(345, fIntList.First);
fIntList.PushFirst(456);
- AssertEquals(456, fIntList.First.Value);
+ AssertEquals(456, fIntList.First);
AssertEquals(456, fIntList.PopFirst(false));
- AssertEquals(345, fIntList.First.Value);
+ AssertEquals(345, fIntList.First);
AssertEquals( 0, fIntList.PopFirst(true));
- AssertEquals(234, fIntList.First.Value);
+ AssertEquals(234, fIntList.First);
AssertEquals(234, fIntList.PopFirst(false));
- AssertEquals(123, fIntList.First.Value);
+ AssertEquals(123, fIntList.First);
AssertEquals( 0, fIntList.PopFirst(true));
end;
@@ -139,20 +134,20 @@ end;
procedure TutlLinkedListTests.Meth_PushLast_PopLast;
begin
fIntList.PushLast(123);
- AssertEquals(123, fIntList.Last.Value);
+ AssertEquals(123, fIntList.Last);
fIntList.PushLast(234);
- AssertEquals(234, fIntList.Last.Value);
+ AssertEquals(234, fIntList.Last);
fIntList.PushLast(345);
- AssertEquals(345, fIntList.Last.Value);
+ AssertEquals(345, fIntList.Last);
fIntList.PushLast(456);
- AssertEquals(456, fIntList.Last.Value);
+ AssertEquals(456, fIntList.Last);
AssertEquals(456, fIntList.PopLast(false));
- AssertEquals(345, fIntList.Last.Value);
+ AssertEquals(345, fIntList.Last);
AssertEquals( 0, fIntList.PopLast(true));
- AssertEquals(234, fIntList.Last.Value);
+ AssertEquals(234, fIntList.Last);
AssertEquals(234, fIntList.PopLast(false));
- AssertEquals(123, fIntList.Last.Value);
+ AssertEquals(123, fIntList.Last);
AssertEquals( 0, fIntList.PopLast(true));
end;
@@ -166,16 +161,16 @@ begin
fIntList.PushLast(345);
fIntList.PushLast(456);
- it := fIntList.First;
+ it := fIntList.FirstIterator;
fIntList.InsertBefore(it, 999);
AssertTrue(it.MovePrev);
- AssertEquals(999, it.Value);
+ AssertEquals(999, it.Item);
AssertEquals(5, fIntList.Count);
- it := fIntList.Last;
+ it := fIntList.LastIterator;
fIntList.InsertBefore(it, 888);
AssertTrue(it.MovePrev);
- AssertEquals(888, it.Value);
+ AssertEquals(888, it.Item);
AssertEquals(6, fIntList.Count);
end;
@@ -189,16 +184,16 @@ begin
fIntList.PushLast(345);
fIntList.PushLast(456);
- it := fIntList.First;
+ it := fIntList.FirstIterator;
fIntList.InsertAfter(it, 999);
AssertTrue(it.MoveNext);
- AssertEquals(999, it.Value);
+ AssertEquals(999, it.Item);
AssertEquals(5, fIntList.Count);
- it := fIntList.Last;
+ it := fIntList.LastIterator;
fIntList.InsertAfter(it, 888);
AssertTrue(it.MoveNext);
- AssertEquals(888, it.Value);
+ AssertEquals(888, it.Item);
AssertEquals(6, fIntList.Count);
end;
@@ -212,12 +207,12 @@ begin
fIntList.PushLast(345);
fIntList.PushLast(456);
- it := fIntList.First;
+ it := fIntList.FirstIterator;
it.MoveNext;
fIntList.Remove(it);
AssertEquals(3, fIntList.Count);
- AssertEquals(123, fIntList.First.Value);
+ AssertEquals(123, fIntList.First);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -244,35 +239,57 @@ begin
fIntList.PushLast(345);
fIntList.PushLast(456);
- it1 := fIntList.First;
- AssertEquals(123, it1.Value);
+ it1 := fIntList.FirstIterator;
+ AssertEquals(123, it1.Item);
AssertTrue (it1.IsValid);
- AssertTrue (it1.Equals(fIntList.First));
+ AssertTrue (it1.Equals(fIntList.FirstIterator));
AssertTrue (it1.MoveNext);
- AssertEquals(234, it1.Value);
+ AssertEquals(234, it1.Item);
AssertTrue (it1.MoveNext);
- AssertEquals(345, it1.Value);
+ AssertEquals(345, it1.Item);
AssertTrue (it1.MoveNext);
- AssertEquals(456, it1.Value);
- AssertTrue (it1.Equals(fIntList.Last));
+ AssertEquals(456, it1.Item);
+ AssertTrue (it1.Equals(fIntList.LastIterator));
AssertFalse (it1.MoveNext);
fIntList.PopLast;
AssertFalse (it1.IsValid);
- it1 := fIntList.Last;
- AssertEquals(345, it1.Value);
+ it1 := fIntList.LastIterator;
+ AssertEquals(345, it1.Item);
AssertTrue (it1.IsValid);
- AssertTrue (it1.Equals(fIntList.Last));
+ AssertTrue (it1.Equals(fIntList.LastIterator));
AssertTrue (it1.MovePrev);
- AssertEquals(234, it1.Value);
+ AssertEquals(234, it1.Item);
AssertTrue (it1.MovePrev);
- AssertEquals(123, it1.Value);
- AssertTrue (it1.Equals(fIntList.First));
+ AssertEquals(123, it1.Item);
+ AssertTrue (it1.Equals(fIntList.FirstIterator));
AssertFalse (it1.MovePrev);
fIntList.PopFirst;
AssertFalse (it1.IsValid);
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedListTests.CompleteIteration;
+var
+ i: Integer;
+ it, itEnd: TIntList.Iterator;
+begin
+ for i := 0 to 10 do
+ fIntList.PushLast(i);
+
+ i := 0;
+ it := fIntList.FirstIterator;
+ itEnd := fIntList.LastIterator;
+ AssertTrue(itEnd.MovePrev);
+ repeat
+ AssertEquals(i, it.Item);
+ inc(i);
+ until not it.MoveNext or it.Equals(itEnd);
+
+ AssertTrue(it.MoveNext);
+ AssertEquals(10, it.Item);
+end;
+
initialization
RegisterTest(TutlLinkedListTests.Suite);
diff --git a/tests/uutlMapTests.pas b/tests/uutlMapTests.pas
new file mode 100644
index 0000000..a17771b
--- /dev/null
+++ b/tests/uutlMapTests.pas
@@ -0,0 +1,312 @@
+unit uutlMapTests;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, TestFramework,
+ uTestHelper, uutlGenerics;
+
+type
+ TIntMap = specialize TutlMap;
+ TObjMap = specialize TutlMap;
+ TutlMapTests = class(TIntfObjOwner)
+ private
+ fIntMap: TIntMap;
+ fObjMap: TObjMap;
+
+ procedure AssignNonExistsingItem;
+
+ protected
+ procedure SetUp; override;
+ procedure TearDown; override;
+
+ published
+ procedure Prop_Values;
+ procedure Prop_ValuesAt;
+ procedure Prop_Keys;
+ procedure Prop_KeyValuePairs;
+
+ procedure Prop_Count;
+ procedure Prop_IsEmpty;
+ procedure Prop_Capacity;
+ procedure Prop_CanShrink;
+ procedure Prop_CanExpand;
+ procedure Prop_OwnsKeys;
+ procedure Prop_OwnsValues;
+ procedure Prop_AutoCreate;
+
+ procedure Meth_Add;
+ procedure Meth_TryGetValue;
+ procedure Meth_IndexOf;
+ procedure Meth_Contains;
+ procedure Meth_Delete;
+ procedure Meth_DeleteAt;
+ procedure Meth_Clear;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlMapTests//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.AssignNonExistsingItem;
+begin
+ fIntMap[999] := 123;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.SetUp;
+begin
+ inherited SetUp;
+ fIntMap := TIntMap.Create(true, true);
+ fObjMap := TObjMap.Create(true, true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.TearDown;
+begin
+ FreeAndNil(fIntMap);
+ FreeAndNil(fObjMap);
+ inherited TearDown;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_Values;
+begin
+ fIntMap.Add(123, 987);
+ fIntMap.Add(234, 876);
+ AssertEquals(987, fIntMap[123]);
+ AssertEquals(876, fIntMap[234]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_ValuesAt;
+begin
+ fIntMap.Add(123, 987);
+ fIntMap.Add(234, 876);
+ AssertEquals(987, fIntMap.ValueAt[0]);
+ AssertEquals(876, fIntMap.ValueAt[1]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_Keys;
+begin
+ fIntMap.Add(123, 987);
+ fIntMap.Add(234, 876);
+ AssertEquals(2, fIntMap.Keys.Count);
+ AssertEquals(123, fIntMap.Keys[0]);
+ AssertEquals(234, fIntMap.Keys[1]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_KeyValuePairs;
+begin
+ fIntMap.Add(123, 987);
+ fIntMap.Add(234, 876);
+ AssertEquals(2, fIntMap.KeyValuePairs.Count);
+ AssertEquals(123, fIntMap.KeyValuePairs[0].Key);
+ AssertEquals(987, fIntMap.KeyValuePairs[0].Value);
+ AssertEquals(234, fIntMap.KeyValuePairs[1].Key);
+ AssertEquals(876, fIntMap.KeyValuePairs[1].Value);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_Count;
+begin
+ AssertEquals(0, fIntMap.Count);
+ fIntMap.Add(123, 987);
+ AssertEquals(1, fIntMap.Count);
+ fIntMap.Add(234, 876);
+ AssertEquals(2, fIntMap.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_IsEmpty;
+begin
+ AssertTrue(fIntMap.IsEmpty);
+ fIntMap.Add(123, 987);
+ AssertFalse(fIntMap.IsEmpty);
+ fIntMap.Add(234, 876);
+ AssertFalse(fIntMap.IsEmpty);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_Capacity;
+begin
+ AssertEquals(0, fIntMap.Capacity);
+ fIntMap.Capacity := 10;
+ AssertEquals(10, fIntMap.Capacity);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_CanShrink;
+begin
+ AssertTrue(fIntMap.CanShrink);
+ fIntMap.CanShrink := false;
+ AssertFalse(fIntMap.CanShrink);
+ fIntMap.CanShrink := true;
+ AssertTrue(fIntMap.CanShrink);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_CanExpand;
+begin
+ AssertTrue(fIntMap.CanExpand);
+ fIntMap.CanExpand := false;
+ AssertFalse(fIntMap.CanExpand);
+ fIntMap.CanExpand := true;
+ AssertTrue(fIntMap.CanExpand);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_OwnsKeys;
+var
+ obj: TIntfObj;
+begin
+ AssertTrue(fObjMap.OwnsKeys);
+ fObjMap.OwnsKeys := false;
+ AssertFalse(fObjMap.OwnsKeys);
+
+ obj := TIntfObj.Create(self);
+ fObjMap.Add(obj, nil);
+ fObjMap.Delete(obj);
+ AssertEquals(1, IntfObjCounter);
+ FreeAndNil(obj);
+ AssertEquals(0, IntfObjCounter);
+
+ fObjMap.OwnsKeys := true;
+ AssertTrue(fObjMap.OwnsKeys);
+
+ obj := TIntfObj.Create(self);
+ fObjMap.Add(obj, nil);
+ fObjMap.Delete(obj);
+ AssertEquals(0, IntfObjCounter);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_OwnsValues;
+var
+ key: TIntfObj;
+ obj: TIntfObj;
+begin
+ key := TIntfObj.Create(self);
+
+ AssertTrue(fObjMap.OwnsValues);
+ fObjMap.OwnsValues := false;
+ AssertFalse(fObjMap.OwnsValues);
+
+ obj := TIntfObj.Create(self);
+ fObjMap.Add(key, obj);
+ fObjMap.Delete(key);
+ AssertEquals(1, IntfObjCounter);
+ FreeAndNil(obj);
+ AssertEquals(0, IntfObjCounter);
+
+ fObjMap.OwnsValues := true;
+ AssertTrue(fObjMap.OwnsValues);
+
+ key := TIntfObj.Create(self);
+ obj := TIntfObj.Create(self);
+ fObjMap.Add(key, obj);
+ fObjMap.Delete(key);
+ AssertEquals(0, IntfObjCounter);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Prop_AutoCreate;
+begin
+ AssertException('autocreate false does not throw exception', EutlMap, @AssignNonExistsingItem);
+ fIntMap.AutoCreate := true;
+ AssignNonExistsingItem;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Meth_Add;
+begin
+ fIntMap.Add(123, 987);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Meth_TryGetValue;
+var
+ i: Integer;
+begin
+ fIntMap.Add(123, 987);
+ fIntMap.Add(234, 876);
+ fIntMap.Add(345, 765);
+ AssertFalse (fIntMap.TryGetValue(999, i));
+ AssertTrue (fIntMap.TryGetValue(234, i));
+ AssertEquals(876, i);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Meth_IndexOf;
+begin
+ fIntMap.Add(123, 987);
+ fIntMap.Add(234, 876);
+ fIntMap.Add(345, 765);
+ AssertEquals( 0, fIntMap.IndexOf(123));
+ AssertEquals( 1, fIntMap.IndexOf(234));
+ AssertEquals( 2, fIntMap.IndexOf(345));
+ AssertEquals(-1, fIntMap.IndexOf(999));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Meth_Contains;
+begin
+ fIntMap.Add(123, 987);
+ fIntMap.Add(234, 876);
+ fIntMap.Add(345, 765);
+ AssertTrue (fIntMap.Contains(123));
+ AssertTrue (fIntMap.Contains(234));
+ AssertTrue (fIntMap.Contains(345));
+ AssertFalse(fIntMap.Contains(999));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Meth_Delete;
+begin
+ fIntMap.Add(123, 987);
+ fIntMap.Add(234, 876);
+ fIntMap.Add(345, 765);
+ AssertEquals(3, fIntMap.Count);
+ fIntMap.Delete(123);
+ AssertEquals(2, fIntMap.Count);
+ fIntMap.Delete(234);
+ AssertEquals(1, fIntMap.Count);
+ fIntMap.Delete(345);
+ AssertEquals(0, fIntMap.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Meth_DeleteAt;
+begin
+ fIntMap.Add(123, 987);
+ fIntMap.Add(234, 876);
+ fIntMap.Add(345, 765);
+ AssertEquals(3, fIntMap.Count);
+ fIntMap.DeleteAt(2);
+ AssertEquals(2, fIntMap.Count);
+ fIntMap.DeleteAt(1);
+ AssertEquals(1, fIntMap.Count);
+ fIntMap.DeleteAt(0);
+ AssertEquals(0, fIntMap.Count);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlMapTests.Meth_Clear;
+begin
+ fIntMap.Add(123, 987);
+ fIntMap.Add(234, 876);
+ fIntMap.Add(345, 765);
+ fIntMap.Clear;
+ AssertEquals(0, fIntMap.Count);
+end;
+
+initialization
+ RegisterTest(TutlMapTests.Suite);
+
+end.
+
diff --git a/uutlAlgorithm.pas b/uutlAlgorithm.pas
index 9432499..e087867 100644
--- a/uutlAlgorithm.pas
+++ b/uutlAlgorithm.pas
@@ -5,14 +5,43 @@ unit uutlAlgorithm;
interface
uses
- Classes, SysUtils;
+ Classes, SysUtils,
+ uutlInterfaces;
+type
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic TutlBinarySearch = class(TObject)
+ public type
+ IReadOnlyIndexer = specialize IutlReadOnlyIndexer;
+ IComparer = specialize IutlComparer;
+
+ private
+ class function DoSearch(
+ constref aIndexer: IReadOnlyIndexer;
+ constref aComparer: IComparer;
+ const aMin: Integer;
+ const aMax: Integer;
+ constref aItem: T;
+ out aIndex: Integer): Boolean;
+
+ public
+ // search aItem in aIndexer using aComparer
+ // aIndex is the index the item was found or should be inserted
+ // returns TRUE when found, FALSE otherwise
+ class function Search(
+ constref aIndexer: IReadOnlyIndexer;
+ constref aComparer: IComparer;
+ constref aItem: T;
+ out aIndex: Integer): Boolean;
+ end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function Supports(const aInstance: TObject; const aClass: TClass; out aObj): Boolean; overload;
implementation
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function Supports(const aInstance: TObject; const aClass: TClass; out aObj): Boolean;
begin
@@ -23,5 +52,44 @@ begin
TObject(aObj) := nil;
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlBinarySearch//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class function TutlBinarySearch.DoSearch(
+ constref aIndexer: IReadOnlyIndexer;
+ constref 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, aIndexer.Items[i]);
+ if (cmp = 0) then begin
+ result := true;
+ aIndex := i;
+ end else if (cmp < 0) then
+ result := DoSearch(aIndexer, aComparer, aMin, i-1, aItem, aIndex)
+ else if (cmp > 0) then
+ result := DoSearch(aIndexer, aComparer, i+1, aMax, aItem, aIndex);
+ end else begin
+ result := false;
+ aIndex := aMin;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class function TutlBinarySearch.Search(
+ constref aIndexer: IReadOnlyIndexer;
+ constref aComparer: IComparer;
+ constref aItem: T;
+ out aIndex: Integer): Boolean;
+begin
+ result := DoSearch(aIndexer, aComparer, 0, aIndexer.Count-1, aItem, aIndex);
+end;
+
end.
diff --git a/uutlCommon.pas b/uutlCommon.pas
index 4d20ed3..52ddf52 100644
--- a/uutlCommon.pas
+++ b/uutlCommon.pas
@@ -1,158 +1,29 @@
unit uutlCommon;
-{ Package: Utils
- Prefix: utl - UTiLs
- Beschreibung: diese Unit implementiert allgemein nützliche nicht-generische Klassen }
-
{$mode objfpc}{$H+}
-{$modeswitch nestedprocvars}
interface
uses
- Classes, SysUtils, syncobjs, versionresource, versiontypes, typinfo, uutlGenerics
- {$IFDEF UNIX}, unixtype, pthreads {$ENDIF};
+ Classes, SysUtils;
type
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlStringStack = class(TStringList)
- public
- procedure Push(const aStr: String);
- function Pop: String;
- function Seek: String;
- end;
-
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlInterfaceNoRefCount = class(TObject, IUnknown)
protected
- fRefCount : longint;
+ fRefCount: longint;
+
{ implement methods of IUnknown }
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}; virtual;
function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual;
- public
- property RefCount: LongInt read fRefCount;
- end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlCSVList = class(TStringList)
- private
- FSkipDelims: boolean;
- function GetStrictDelText: string;
- procedure SetStrictDelText(const Value: string);
- public
- property StrictDelimitedText: string read GetStrictDelText write SetStrictDelText;
- // Skip repeated delims instead of reading empty lines?
- property SkipDelims: boolean read FSkipDelims write FSkipDelims;
- end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlCheckSynchronizeEvent = class(TObject)
- private
- fEvent: TEvent;
- function WaitMainThread(const aTimeout: Cardinal): TWaitResult;
- public const
- MAIN_WAIT_GRANULARITY = 10;
- public
- procedure SetEvent;
- procedure ResetEvent;
- function WaitFor(const aTimeout: Cardinal): TWaitResult;
-
- constructor Create(const aEventAttributes: syncobjs.PSecurityAttributes;
- const aManualReset, aInitialState: Boolean; const aName: string);
- destructor Destroy; override;
- end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlBaseEventList = specialize TutlList;
- TutlEventList = class(TutlBaseEventList)
- public
- function AddEvent(const aEventAttributes: syncobjs.PSecurityAttributes; const aManualReset,
- aInitialState: Boolean; const aName : string): TutlCheckSynchronizeEvent;
- function AddDefaultEvent: TutlCheckSynchronizeEvent;
- function WaitAll(const aTimeout: Cardinal): TWaitResult;
- constructor Create;
- end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlVersionInfo = class(TObject)
- private
- fVersionRes: TVersionResource;
- function GetFixedInfo: TVersionFixedInfo;
- function GetStringFileInfo: TVersionStringFileInfo;
- function GetVarFileInfo: TVersionVarFileInfo;
public
- property FixedInfo: TVersionFixedInfo read GetFixedInfo;
- property StringFileInfo: TVersionStringFileInfo read GetStringFileInfo;
- property VarFileInfo: TVersionVarFileInfo read GetVarFileInfo;
-
- function Load(const aInstance: THandle): Boolean;
-
- constructor Create;
- destructor Destroy; override;
- end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- IutlFilterBuilder = interface['{BC5039C7-42E7-428F-A3E7-DDF7757B1907}']
- function Add(aDescr, aMask: string; const aAppendFilterToDesc: boolean = true): IutlFilterBuilder;
- function AddFilter(aFilter: string): IutlFilterBuilder;
- function Compose(const aIncludeAllSupported: String = ''; const aIncludeAllFiles: String = ''): string;
+ property RefCount: LongInt read fRefCount;
end;
-
-function utlEventEqual(const aEvent1, aEvent2): Boolean;
-function utlFilterBuilder: IutlFilterBuilder;
-
implementation
-uses
- {uutlTiming needs to be included after Windows because of GetTickCount64}
- uutlLogger{$IFDEF WINDOWS},Windows{$ENDIF}, uutlTiming;
-
-{$IFNDEF WINDOWS}
-function CharNext(const C: PChar): PChar;
-begin
- //TODO: prüfen ob das für UnicodeString auch stimmt
- Result:= C;
- if Result^>#0 then
- inc(Result);
-end;
-{$IFEND}
-
-function utlEventEqual(const aEvent1, aEvent2): Boolean;
-begin
- result :=
- (TMethod(aEvent1).Code = TMethod(aEvent2).Code) and
- (TMethod(aEvent1).Data = TMethod(aEvent2).Data);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlStringStack//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlStringStack.Push(const aStr: String);
-begin
- Insert(0, aStr);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlStringStack.Pop: String;
-begin
- result := '';
- if Count > 0 then begin
- result := Strings[0];
- Delete(0);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlStringStack.Seek: String;
-begin
- result := '';
- if Count > 0 then
- result := Strings[0];
-end;
-
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlInterfaceNoRefCount///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -176,329 +47,5 @@ begin
result := InterLockedDecrement(fRefCount);
end;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlCSVList///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCSVList.GetStrictDelText: string;
-var
- S: string;
- I, J, Cnt: Integer;
- q: boolean;
- LDelimiters: TSysCharSet;
-begin
- Cnt := GetCount;
- if (Cnt = 1) and (Get(0) = '') then
- Result := QuoteChar + QuoteChar
- else
- begin
- Result := '';
- LDelimiters := [QuoteChar, Delimiter];
- for I := 0 to Cnt - 1 do
- begin
- S := Get(I);
- q:= false;
- if S>'' then begin
- for J:= 1 to length(S) do
- if S[J] in LDelimiters then begin
- q:= true;
- break;
- end;
- if q then S := AnsiQuotedStr(S, QuoteChar);
- end else
- S := AnsiQuotedStr(S, QuoteChar);
- Result := Result + S + Delimiter;
- end;
- System.Delete(Result, Length(Result), 1);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlCSVList.SetStrictDelText(const Value: string);
-var
- S: String;
- P, P1: PChar;
-begin
- BeginUpdate;
- try
- Clear;
- P:= PChar(Value);
- if FSkipDelims then begin
- while (P^<>#0) and (P^=Delimiter) do begin
- P:= CharNext(P);
- end;
- end;
- while (P^<>#0) do begin
- if (P^ = QuoteChar) then begin
- S:= AnsiExtractQuotedStr(P, QuoteChar);
- end else begin
- P1:= P;
- while (P^<>#0) and (P^<>Delimiter) do begin
- P:= CharNext(P);
- end;
- SetString(S, P1, P - P1);
- end;
- Add(S);
- while (P^<>#0) and (P^<>Delimiter) do begin
- P:= CharNext(P);
- end;
- if (P^<>#0) then
- P:= CharNext(P);
- if FSkipDelims then begin
- while (P^<>#0) and (P^=Delimiter) do begin
- P:= CharNext(P);
- end;
- end;
- end;
- finally
- EndUpdate;
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlCheckSynchronizeEvent/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCheckSynchronizeEvent.WaitMainThread(const aTimeout: Cardinal): TWaitResult;
-var
- timeout: qword;
-begin
- timeout:= GetTickCount64 + aTimeout;
- repeat
- result := fEvent.WaitFor(TutlCheckSynchronizeEvent.MAIN_WAIT_GRANULARITY);
- CheckSynchronize();
- until (result <> wrTimeout) or ((GetTickCount64 > timeout) and (aTimeout <> INFINITE));
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlCheckSynchronizeEvent.SetEvent;
-begin
- fEvent.SetEvent;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlCheckSynchronizeEvent.ResetEvent;
-begin
- fEvent.ResetEvent;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCheckSynchronizeEvent.WaitFor(const aTimeout: Cardinal): TWaitResult;
-begin
- if (GetCurrentThreadId = MainThreadID) then
- result := WaitMainThread(aTimeout)
- else
- result := fEvent.WaitFor(aTimeout);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCheckSynchronizeEvent.Create(const aEventAttributes: syncobjs.PSecurityAttributes;
- const aManualReset, aInitialState: Boolean; const aName: string);
-begin
- inherited Create;
- fEvent := TEvent.Create(aEventAttributes, aManualReset, aInitialState, aName);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlCheckSynchronizeEvent.Destroy;
-begin
- FreeAndNil(fEvent);
- inherited Destroy;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlEventList/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEventList.AddEvent(const aEventAttributes: syncobjs.PSecurityAttributes; const aManualReset,
- aInitialState: Boolean; const aName: string): TutlCheckSynchronizeEvent;
-begin
- result := TutlCheckSynchronizeEvent.Create(aEventAttributes, aManualReset, aInitialState, aName);
- Add(result);
-end;
-
-function TutlEventList.AddDefaultEvent: TutlCheckSynchronizeEvent;
-begin
- result := AddEvent(nil, true, false, '');
- result.ResetEvent;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEventList.WaitAll(const aTimeout: Cardinal): TWaitResult;
-var
- i: integer;
- timeout, tick: qword;
-begin
- timeout := GetTickCount64 + aTimeout;
- for i := 0 to Count-1 do begin
- if (aTimeout <> INFINITE) then begin
- tick := GetTickCount64;
- if (tick >= timeout) then begin
- result := wrTimeout;
- exit;
- end else
- result := Items[i].WaitFor(timeout - tick);
- end else
- result := Items[i].WaitFor(INFINITE);
- if result <> wrSignaled then
- exit;
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlEventList.Create;
-begin
- inherited Create(true);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlVersionInfo///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlVersionInfo.GetFixedInfo: TVersionFixedInfo;
-begin
- result := fVersionRes.FixedInfo;
-end;
-
-function TutlVersionInfo.GetStringFileInfo: TVersionStringFileInfo;
-begin
- result := fVersionRes.StringFileInfo;
-end;
-
-function TutlVersionInfo.GetVarFileInfo: TVersionVarFileInfo;
-begin
- result := fVersionRes.VarFileInfo;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlVersionInfo.Load(const aInstance: THandle): Boolean;
-var
- Stream: TResourceStream;
-begin
- result := false;
- if (FindResource(aInstance, PChar(PtrInt(1)), PChar(RT_VERSION)) = 0) then
- exit;
- Stream := TResourceStream.CreateFromID(aInstance, 1, PChar(RT_VERSION));
- try
- fVersionRes.SetCustomRawDataStream(Stream);
- fVersionRes.FixedInfo;// access some property to force load from the stream
- fVersionRes.SetCustomRawDataStream(nil);
- finally
- Stream.Free;
- end;
- result := true;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlVersionInfo.Create;
-begin
- inherited Create;
- fVersionRes := TVersionResource.Create;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlVersionInfo.Destroy;
-begin
- FreeAndNil(fVersionRes);
- inherited Destroy;
-end;
-
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//IutlFilterBuilder///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-type
- TFilterBuilderImpl = class(TInterfacedObject, IutlFilterBuilder)
- private type
- TFilterEntry = class
- Descr,
- Filter: String;
- end;
- TFilterList = specialize TutlList;
- private
- fFilters: TFilterList;
- public
- constructor Create;
- destructor Destroy; override;
- function Add(aDescr, aMask: string; const aAppendFilterToDesc: boolean): IutlFilterBuilder;
- function AddFilter(aFilter: string): IutlFilterBuilder;
- function Compose(const aIncludeAllSupported: String = ''; const aIncludeAllFiles: String = ''): string;
- end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TFilterBuilderImpl.Create;
-begin
- inherited Create;
- fFilters:= TFilterList.Create(true);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TFilterBuilderImpl.Destroy;
-begin
- FreeAndNil(fFilters);
- inherited Destroy;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TFilterBuilderImpl.Compose(const aIncludeAllSupported: String;
- const aIncludeAllFiles: String): string;
-var
- s: String;
- e: TFilterEntry;
-begin
- Result:= '';
- if (aIncludeAllSupported>'') and (fFilters.Count > 0) then begin
- s:= '';
- for e in fFilters do begin
- if s>'' then
- s += ';';
- s += e.Filter;
- end;
- Result+= Format('%s|%s', [aIncludeAllSupported, s, s]);
- end;
-
- for e in fFilters do begin
- if Result>'' then
- Result += '|';
- Result+= Format('%s|%s', [e.Descr, e.Filter]);
- end;
-
- if aIncludeAllFiles > '' then begin
- if Result>'' then
- Result += '|';
- Result+= Format('%s|%s', [aIncludeAllFiles, '*.*']);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TFilterBuilderImpl.Add(aDescr, aMask: string;
- const aAppendFilterToDesc: boolean): IutlFilterBuilder;
-var
- e: TFilterEntry;
-begin
- Result:= Self;
- e:= TFilterEntry.Create;
- if aAppendFilterToDesc then
- e.Descr:= Format('%s (%s)', [aDescr, aMask])
- else
- e.Descr:= aDescr;
- e.Filter:= aMask;
- fFilters.Add(e);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TFilterBuilderImpl.AddFilter(aFilter: string): IutlFilterBuilder;
-var
- c: integer;
-begin
- c:= Pos('|', aFilter);
- if c > 0 then
- Result:= (Self as IutlFilterBuilder).Add(Copy(aFilter, 1, c-1), Copy(aFilter, c+1, Maxint))
- else
- Result:= (Self as IutlFilterBuilder).Add(aFilter, aFilter, false);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function utlFilterBuilder: IutlFilterBuilder;
-begin
- Result:= TFilterBuilderImpl.Create;
-end;
-
end.
diff --git a/uutlGenerics.pas b/uutlGenerics.pas
index 6147900..360f578 100644
--- a/uutlGenerics.pas
+++ b/uutlGenerics.pas
@@ -7,190 +7,116 @@ interface
uses
Classes, SysUtils, TypInfo,
- uutlExceptions;
+ uutlExceptions, uutlInterfaces, uutlAlgorithm, uutlCommon;
type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//Comparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic IutlEqualityComparer = interface(IUnknown)
- ['{C0FB90CC-D071-490F-BFEE-BAA5C94D1A5B}']
- function EqualityCompare(constref i1, i2: T): Boolean;
- end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- 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
- function EqualityCompare(constref i1, i2: T): Boolean;
- end;
-
+//Container/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- 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;
+ generic TutlLinkedList = class(TutlInterfaceNoRefCount,
+ specialize IutlEnumerable)
+ public type
+ Iterator = specialize IutlBidirectionalInputOutputIterator;
- generic TutlCalbackEqualityComparer = class(TInterfacedObject, specialize IutlEqualityComparer)
private type
- TEqualityCompareEventType = (eetNormal, eetObject, eetNested);
+ PElement = ^TElement;
+ TElement = packed record
+ prev: PElement;
+ next: PElement;
+ data: T;
+ end;
- public type
- TCompareEvent = specialize TutlEqualityCompareEvent;
- TCompareEventO = specialize TutlEqualityCompareEventO;
- TCompareEventN = specialize TutlEqualityCompareEventN;
+ TIterator = class(TInterfacedObject,
+ Iterator,
+ IutlBidirectionalIterator,
+ IutlIterator)
+ strict private
+ fOwner: TutlLinkedList;
+ fElement: PElement;
- strict private
- fType: TEqualityCompareEventType;
- fEvent: TCompareEvent;
- fEventO: TCompareEventO;
- fEventN: TCompareEventN;
+ private
+ procedure ReleaseElement(const aElement: PElement);
- public
- function EqualityCompare(constref i1, i2: T): Boolean;
+ public { IutlIterator }
+ function MoveNext: Boolean;
+ function Clone: IutlIterator;
+ function Equals(const aOther: IutlIterator): Boolean; overload;
+ function GetIsValid: 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;
+ property IsValid: Boolean read GetIsValid;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlComparer = class(specialize TutlEqualityComparer, specialize IutlComparer)
- public
- function Compare(constref i1, i2: T): Integer;
- end;
+ public { IutlBidirectionalIterator }
+ function MovePrev: Boolean;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- 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;
+ public { IutlBidirectionalInputOutputIterator }
+ function GetItem: T;
+ procedure SetItem(aValue: T);
- generic TutlCallbackComparer = class(TInterfacedObject, specialize IutlComparer)
- private type
- TCompareEventType = (cetNormal, cetObject, cetNested);
+ public
+ property Element: PElement read fElement;
+ property Owner: TutlLinkedList read fOwner;
- public type
- TCompareEvent = specialize TutlCompareEvent;
- TCompareEventO = specialize TutlCompareEventO;
- TCompareEventN = specialize TutlCompareEventN;
+ constructor Create(const aElement: PElement; const aOwner: TutlLinkedList);
+ destructor Destroy; override;
+ end;
strict private
- fType: TCompareEventType;
- fEvent: TCompareEvent;
- fEventO: TCompareEventO;
- fEventN: TCompareEventN;
-
- public
- 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;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//Iterators/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- IutlIterator = interface(IUnknown)
- ['{327E7628-C9D8-4C47-9630-E979D9C3293D}']
- function MoveNext: Boolean;
- function Clone: IutlIterator;
- function Equals(const aOther: IutlIterator): Boolean;
- function GetIsValid: Boolean;
-
- property IsValid: Boolean read GetIsValid;
- end;
+ fOwnsItems: Boolean;
+ fCount: Integer;
+ fFirst: PElement;
+ fLast: PElement;
+ fIterators: array of TIterator;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- IutlBidirectionalIterator = interface(IutlIterator)
- ['{31D1E828-52CC-467F-8254-2C1384B28DEE}']
- function MovePrev: Boolean;
- end;
+ function GetFirst: T;
+ function GetLast: T;
+ function GetIsEmpty: Boolean;
+ function GetFirstIterator: Iterator;
+ function GetLastIterator: Iterator;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- IutlRandomAccessIterator = interface(IutlBidirectionalIterator)
- ['{AE06BAB6-BB17-4E46-AE88-583EB853233E}']
- function Increment(const aCount: Integer): Boolean;
- function Decrement(const aCount: Integer): Boolean;
- 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;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic IutlInputIterator = interface(IutlIterator)
- ['{BD4ED39B-2BBA-41F7-BDC7-E1B45F41AA84}']
- function GetItem: T;
- property Item: T read GetItem;
- end;
+ function CreateIterator (const aElement: PElement): TIterator;
+ procedure DestroyIterator (const aIterator: TIterator);
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic IutlOutputIterator = interface(IutlIterator)
- ['{132642C1-5235-4450-8956-2092D3F2F83D}']
- procedure SetItem(const aValue: T);
- property Item: T write SetItem;
- end;
+ protected
+ procedure Release (var aItem: T; const aFreeItem: Boolean); virtual;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- 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;
+ public { IutlEnumerable }
+ function GetEnumerator: specialize IEnumerator;
+ function GetUtlEnumerator: specialize IutlEnumerator;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic IutlBidirectionalInputIterator = interface(IutlBidirectionalIterator)
- ['{B2423828-F187-4620-8DA2-9C4EF68B81E3}']
- function GetItem: T;
- property Item: T read GetItem;
- end;
+ public
+ property Count: Integer read fCount;
+ property IsEmpty: Boolean read GetIsEmpty;
+ property First: T read GetFirst;
+ property Last: T read GetLast;
+ property FirstIterator: Iterator read GetFirstIterator;
+ property LastIterator: Iterator read GetLastIterator;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic IutlBidirectionalOutputIterator = interface(IutlBidirectionalIterator)
- ['{1A13E581-200B-41E7-BC7D-9AD5192DEF0F}']
- procedure SetItem(const aValue: T);
- property Item: T write SetItem;
- end;
+ procedure PushFirst (constref aItem: T);
+ function PopFirst (const aFreeItem: Boolean): T;
+ procedure PopFirst;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- 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;
+ procedure PushLast (constref aItem: T);
+ function PopLast (const aFreeItem: Boolean): T;
+ procedure PopLast;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic IutlRandomAccessInputIterator = interface(IutlRandomAccessIterator)
- ['{47880DCC-49D4-45C7-90CB-D8E915B7CB0D}']
- function GetItem: T;
- property Item: T read GetItem;
- 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);
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic IutlRandomAccessOutputIterator = interface(IutlRandomAccessIterator)
- ['{E768DA58-E666-47F1-B7D8-61EB6C33C379}']
- procedure SetItem(const aValue: T);
- property Item: T write SetItem;
- end;
+ procedure Clear;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic IutlRandomAccessInputOutputIterator = interface(IutlRandomAccessIterator)
- ['{3A8D3C5D-1085-4073-B1D4-DF1886827B6A}']
- function GetItem: T;
- procedure SetItem(const aValue: T);
- property Item: T read GetItem write SetItem;
+ constructor Create (const aOwnsItems: Boolean);
+ destructor Destroy; override;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//Container/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlArrayContainer = class(TObject)
+ generic __TutlArrayContainer = class(TutlInterfaceNoRefCount)
protected type
PT = ^T;
@@ -230,7 +156,8 @@ type
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlQueue = class(specialize TutlArrayContainer)
+ generic TutlQueue = class(specialize __TutlArrayContainer,
+ specialize IutlEnumerable)
strict private
fCount: Integer;
fReadPos: Integer;
@@ -240,6 +167,12 @@ type
function GetCount: Integer; override;
procedure SetCapacity(const aValue: integer); override;
+ public { IutlEnumerable }
+ function GetEnumerator: specialize IEnumerator;
+ function GetUtlEnumerator: specialize IutlEnumerator;
+
+ property Enumerator: specialize IutlEnumerator read GetUtlEnumerator;
+
public
property Count;
property IsEmpty;
@@ -260,13 +193,20 @@ type
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlStack = class(specialize TutlArrayContainer)
+ generic TutlStack = class(specialize __TutlArrayContainer,
+ specialize IutlEnumerable)
strict private
fCount: Integer;
protected
function GetCount: Integer; override;
+ public { IutlEnumerable }
+ function GetEnumerator: specialize IEnumerator;
+ function GetUtlEnumerator: specialize IutlEnumerator;
+
+ property Enumerator: specialize IutlEnumerator read GetUtlEnumerator;
+
public
property Count;
property IsEmpty;
@@ -287,29 +227,50 @@ type
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlSimpleList = class(specialize TutlArrayContainer)
+ generic __TutlListBase = class(specialize __TutlArrayContainer,
+ specialize IutlEnumerable)
strict private
fCount: Integer;
- function GetFirst: T;
- function GetLast: T;
- function GetItem (const aIndex: Integer): T;
-
- procedure SetItem (const aIndex: Integer; aValue: T);
-
protected
function GetCount: Integer; override;
- procedure InsertIntern(const aIndex: Integer; constref aValue: T);
- procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
+ function GetItem (const aIndex: Integer): T; virtual;
+ procedure SetItem (const aIndex: Integer; aValue: T); virtual;
+
+ procedure InsertIntern(const aIndex: Integer; constref aValue: T); virtual;
+ procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); virtual;
+
+ public { IutlEnumerable }
+ function GetEnumerator: specialize IEnumerator;
+ function GetUtlEnumerator: specialize IutlEnumerator;
+
+ property Enumerator: specialize IutlEnumerator read GetUtlEnumerator;
public
property Count;
+ property IsEmpty;
property Capacity;
property CanShrink;
property CanExpand;
property OwnsItems;
+ procedure Clear;
+ procedure ShrinkToFit;
+
+ constructor Create(const aOwnsItems: Boolean);
+ destructor Destroy; override;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic TutlSimpleList = class(specialize __TutlListBase,
+ specialize IutlReadOnlyIndexer,
+ specialize IutlIndexer)
+ strict private
+ function GetFirst: T;
+ function GetLast: T;
+
+ public
property First: T read GetFirst;
property Last: T read GetLast;
@@ -321,16 +282,12 @@ type
procedure Move (const aCurrentIndex, aNewIndex: Integer);
procedure Delete (const aIndex: Integer);
function Extract (const aIndex: Integer): T;
- procedure ShrinkToFit;
- procedure Clear;
procedure PushFirst (constref aItem: T);
function PopFirst (const aFreeItem: Boolean): T;
procedure PushLast (constref aItem: T);
function PopLast (const aFreeItem: Boolean): T;
-
- destructor Destroy; override;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -346,7 +303,7 @@ type
function Extract (const aItem: T; const aDefault: T): T; overload;
function Remove (const aItem: T): Integer;
- constructor Create(const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
+ constructor Create (const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
destructor Destroy; override;
end;
@@ -359,108 +316,189 @@ type
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlLinkedList = class(TObject)
+ generic TutlCustomHashSet = class(specialize __TutlListBase,
+ specialize IutlReadOnlyIndexer,
+ specialize IutlIndexer)
+ private type
+ TBinarySearch = specialize TutlBinarySearch;
+
public type
- Iterator = specialize IutlBidirectionalInputOutputIterator;
+ IComparer = specialize IutlComparer;
- private type
- PElement = ^TElement;
- TElement = packed record
- prev: PElement;
- next: PElement;
- data: T;
+ strict private
+ fComparer: IComparer;
+
+ protected
+ procedure SetItem(const aIndex: Integer; aValue: T); override;
+
+ public
+ property Items[const aIndex: Integer]: T read GetItem write SetItem; default;
+
+ function Add (constref aItem: T): Boolean;
+ function Contains (constref aItem: T): Boolean;
+ function IndexOf (constref aItem: T): Integer;
+ function Remove (constref aItem: T): Boolean;
+ procedure Delete (const aIndex: Integer);
+
+ constructor Create(const aComparer: IComparer; const aOwnsItems: Boolean);
+ destructor Destroy; override;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic TutlHastSet = class(specialize TutlCustomHashSet)
+ public type
+ TComparer = specialize TutlComparer;
+
+ public
+ constructor Create(const aOwnsItems: Boolean);
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EutlMap = class(EutlException);
+ generic TutlCustomMap = class(TutlInterfaceNoRefCount)
+ public type
+ ////////////////////////////////////////////////////////////////////////////////////////////////
+ IComparer = specialize IutlComparer;
+ TKeyValuePair = packed record
+ Key: TKey;
+ Value: TValue;
end;
- TIterator = class(TInterfacedObject,
- Iterator,
- IutlBidirectionalIterator,
- IutlIterator)
+ ////////////////////////////////////////////////////////////////////////////////////////////////
+ THashSet = class(specialize TutlCustomHashSet)
strict private
- fOwner: TutlLinkedList;
- fElement: PElement;
+ fOwner: TutlCustomMap;
- private
- procedure ReleaseElement(const aElement: PElement);
+ protected
+ procedure Release(var aItem: TKeyValuePair; const aFreeItem: Boolean); override;
- public { IutlIterator }
- function MoveNext: Boolean;
- function Clone: IutlIterator;
- function Equals(const aOther: IutlIterator): Boolean;
- function GetIsValid: Boolean;
+ public
+ constructor Create(const aOwner: TutlCustomMap; const aComparer: IComparer);
+ end;
- property IsValid: Boolean read GetIsValid;
+ ////////////////////////////////////////////////////////////////////////////////////////////////
+ TKeyValuePairComparer = class(TInterfacedObject, THashSet.IComparer)
+ private
+ fComparer: IComparer;
- public { IutlBidirectionalIterator }
- function MovePrev: Boolean;
+ public { IutlEqualityComparer }
+ function EqualityCompare(constref i1, i2: TKeyValuePair): Boolean;
- public { IutlBidirectionalInputOutputIterator }
- function GetValue: T;
- procedure SetValue(const aValue: T);
+ public { IutlComparer }
+ function Compare(constref i1, i2: TKeyValuePair): Integer;
public
- property Element: PElement read fElement;
- property Owner: TutlLinkedList read fOwner;
-
- constructor Create(const aElement: PElement; const aOwner: TutlLinkedList);
+ constructor Create(aComparer: IComparer);
destructor Destroy; override;
end;
- strict private
- fOwnsItems: Boolean;
- fCount: Integer;
- fFirst: PElement;
- fLast: PElement;
- fIterators: array of TIterator;
+ ////////////////////////////////////////////////////////////////////////////////////////////////
+ TKeyCollection = class(TutlInterfaceNoRefCount,
+ specialize IutlEnumerable,
+ specialize IutlReadOnlyIndexer)
+ private
+ fHashSet: THashSet;
- function GetFirst: Iterator;
- function GetLast: Iterator;
- function GetIsEmpty: Boolean;
+ public { IutlEnumerable }
+ function GetEnumerator: specialize IEnumerator;
+ function GetUtlEnumerator: specialize IutlEnumerator;
- 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;
+ public { IutlReadOnlyIndexer }
+ function GetItem(const aIndex: Integer): TKey;
+ function GetCount: Integer;
- function CreateIterator (const aElement: PElement): TIterator;
- procedure DestroyIterator (const aIterator: TIterator);
+ public
+ property Items[const aIndex: Integer]: TKey read GetItem; default;
+ property Count: Integer read GetCount;
+ //property Enumerator: specialize IutlEnumerator read GetUtlEnumerator;
- protected
- procedure Release (var aItem: T; const aFreeItem: Boolean); virtual;
+ constructor Create(const aHashSet: THashSet);
+ end;
- public
- property Count: Integer read fCount;
- property IsEmpty: Boolean read GetIsEmpty;
- property First: Iterator read GetFirst;
- property Last: Iterator read GetLast;
+ ////////////////////////////////////////////////////////////////////////////////////////////////
+ TKeyValuePairCollection = class(TutlInterfaceNoRefCount,
+ specialize IutlEnumerable,
+ specialize IutlReadOnlyIndexer)
+ private
+ fHashSet: THashSet;
- procedure PushFirst (constref aItem: T);
- function PopFirst (const aFreeItem: Boolean): T;
- procedure PopFirst;
+ public { IutlEnumerable }
+ function GetEnumerator: specialize IEnumerator;
+ function GetUtlEnumerator: specialize IutlEnumerator;
- procedure PushLast (constref aItem: T);
- function PopLast (const aFreeItem: Boolean): T;
- procedure PopLast;
+ public { IutlReadOnlyIndexer }
+ function GetItem(const aIndex: Integer): TKeyValuePair;
+ function GetCount: Integer;
- 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);
+ public
+ property Items[const aIndex: Integer]: TKeyValuePair read GetItem; default;
+ property Count: Integer read GetCount;
+ property Enumerator: specialize IutlEnumerator read GetUtlEnumerator;
+
+ constructor Create(const aHashSet: THashSet);
+ end;
+
+ strict private
+ fAutoCreate: Boolean;
+ fOwnsKeys: Boolean;
+ fOwnsValues: Boolean;
+ fHashSetRef: THashSet;
+ fKeyCollection: TKeyCollection;
+ fKeyValuePairCollection: TKeyValuePairCollection;
+
+ function GetValue (aKey: TKey): TValue;
+ function GetValueAt (const aIndex: Integer): TValue;
+ function GetCount: Integer;
+ function GetIsEmpty: Boolean;
+ function GetCapacity: Integer;
+ function GetCanShrink: Boolean;
+ function GetCanExpand: Boolean;
+
+ procedure SetValue (aKey: TKey; const aValue: TValue);
+ procedure SetValueAt (const aIndex: Integer; const aValue: TValue);
+ procedure SetCapacity (const aValue: Integer);
+ procedure SetCanShrink (const aValue: Boolean);
+ procedure SetCanExpand (const aValue: Boolean);
+ public
+ property Values [aKey: TKey]: TValue read GetValue write SetValue; default;
+ property ValueAt[const aIndex: Integer]: TValue read GetValueAt write SetValueAt;
+
+ property Keys: TKeyCollection read fKeyCollection;
+ property KeyValuePairs: TKeyValuePairCollection read fKeyValuePairCollection;
+
+ property Count: Integer read GetCount;
+ property IsEmpty: Boolean read GetIsEmpty;
+ property Capacity: Integer read GetCapacity write SetCapacity;
+ property CanShrink: Boolean read GetCanShrink write SetCanShrink;
+ property CanExpand: Boolean read GetCanExpand write SetCanExpand;
+ property OwnsKeys: Boolean read fOwnsKeys write fOwnsKeys;
+ property OwnsValues: Boolean read fOwnsValues write fOwnsValues;
+ property AutoCreate: Boolean read fAutoCreate write fAutoCreate;
+
+ procedure Add (constref aKey: TKey; constref aValue: TValue);
+ function TryAdd (constref aKey: TKey; constref aValue: TValue): Boolean;
+ function TryGetValue (constref aKey: TKey; out aValue: TValue): Boolean;
+ function IndexOf (constref aKey: TKey): Integer;
+ function Contains (constref aKey: TKey): Boolean;
+ procedure Delete (constref aKey: TKey);
+ procedure DeleteAt (const aIndex: Integer);
procedure Clear;
- constructor Create (const aOwnsItems: Boolean);
- destructor Destroy; override;
+ constructor Create(const aHashSet: THashSet; const aOwnsKeys: Boolean; const aOwnsValues: Boolean);
+ destructor Destroy; override;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-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;
+ generic TutlMap = class(specialize TutlCustomMap)
+ public type
+ TComparer = specialize TutlComparer;
+ strict private
+ fHashSetImpl: THashSet;
+ public
+ constructor Create(const aOwnsKeys: Boolean; const aOwnsValues: Boolean);
+ destructor Destroy; override;
+ end;
procedure FinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
@@ -469,185 +507,398 @@ implementation
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function IncIt(aIterator: IutlIterator): Boolean;
+procedure FinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
+var
+ o: TObject;
begin
- result := aIterator.MoveNext;
-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;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function DecIt(aIterator: IutlBidirectionalIterator): Boolean;
-begin
- result := aIterator.MovePrev;
-end;
+ tkInterface: begin
+ IUnknown(obj) := nil;
+ end;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function IncIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean;
-begin
- result := aIterator.Increment(a);
+ tkAString: begin
+ AnsiString(Obj) := '';
+ end;
+
+ tkUString: begin
+ UnicodeString(Obj) := '';
+ end;
+
+ tkString: begin
+ String(Obj) := '';
+ end;
+ end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function DecIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean;
+//TutlLinkedList.TIterator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedList.TIterator.ReleaseElement(const aElement: PElement);
begin
- result := aIterator.Decrement(a);
+ if (aElement = fElement) then
+ fElement := nil;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-operator + (aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator;
+function TutlLinkedList.TIterator.MoveNext: Boolean;
begin
- result := IutlRandomAccessIterator(aIterator.Clone);
- result.Increment(a);
+ if not Assigned(fElement) then
+ raise EutlInvalidOperation.Create('this is the null iterator');
+ result := Assigned(fElement^.next);
+ if result then
+ fElement := fElement^.next;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-operator - (aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator;
+function TutlLinkedList.TIterator.Clone: IutlIterator;
begin
- result := IutlRandomAccessIterator(aIterator.Clone);
- result.Decrement(a);
+ result := fOwner.CreateIterator(fElement);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure FinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
+function TutlLinkedList.TIterator.Equals(const aOther: IutlIterator): Boolean;
var
- o: TObject;
+ o: TIterator;
begin
- case aTypeInfo^.Kind of
- tkClass: begin
- if (aFreeObject) then begin
- o := TObject(obj);
- Pointer(obj) := nil;
- if Assigned(o) then
- o.Free;
- end;
- end;
+ result := Supports(aOther, TIterator, o)
+ and not (Assigned(fElement) xor Assigned(o.fElement))
+ and (fElement = o.fElement)
+ and (fOwner = o.fOwner);
+end;
- tkInterface: begin
- IUnknown(obj) := nil;
- end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlLinkedList.TIterator.GetIsValid: Boolean;
+begin
+ result := Assigned(fElement);
+end;
- tkAString: begin
- AnsiString(Obj) := '';
- end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlLinkedList.TIterator.MovePrev: Boolean;
+begin
+ if not Assigned(fElement) then
+ raise EutlInvalidOperation.Create('this is the null iterator');
+ result := Assigned(fElement^.prev);
+ if result then
+ fElement := fElement^.prev;
+end;
- tkUString: begin
- UnicodeString(Obj) := '';
- end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlLinkedList.TIterator.GetItem: T;
+begin
+ if not Assigned(fElement) then
+ raise EutlInvalidOperation.Create('this is the null iterator');
+ result := fElement^.data;
+end;
- tkString: begin
- String(Obj) := '';
- end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedList.TIterator.SetItem(aValue: T);
+begin
+ if not Assigned(fElement) then
+ raise EutlInvalidOperation.Create('this is the null iterator');
+ fElement^.data := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlLinkedList.TIterator.Create(const aElement: PElement; const aOwner: TutlLinkedList);
+begin
+ inherited Create;
+ fOwner := aOwner;
+ fElement := aElement;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TutlLinkedList.TIterator.Destroy;
+begin
+ if Assigned(fOwner) then
+ fOwner.DestroyIterator(self);
+ inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlLinkedList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlLinkedList.GetFirst: T;
+begin
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := fFirst^.data;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlLinkedList.GetLast: T;
+begin
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := fLast^.data;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlLinkedList.GetIsEmpty: Boolean;
+begin
+ result := (fCount = 0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlLinkedList.GetFirstIterator: Iterator;
+begin
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := CreateIterator(fFirst);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlLinkedList.GetLastIterator: Iterator;
+begin
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := CreateIterator(fLast);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedList.LinkElement(const aElement: PElement);
+begin
+ 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;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlEqualityComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedList.InsertBefore(const aElement: PElement; constref aItem: T);
+var
+ e: PElement;
+begin
+ 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;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
+procedure TutlLinkedList.InsertAfter(const aElement: PElement; constref aItem: T);
+var
+ e: PElement;
begin
- result := (i1 = i2);
+ 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;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlCalbackEqualityComparer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlLinkedList.Remove(const aElement: PElement; const aFreeItem: Boolean): T;
+var
+ i: Integer;
+begin
+ 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{%H-}, 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;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCalbackEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
+function TutlLinkedList.CreateIterator(const aElement: PElement): TIterator;
begin
- case fType of
- eetNormal: result := fEvent (i1, i2);
- eetObject: result := fEventO(i1, i2);
- eetNested: result := fEventN(i1, i2);
+ result := TIterator.Create(aElement, self);
+ SetLength(fIterators, Length(fIterators) + 1);
+ fIterators[High(fIterators)] := result;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedList.DestroyIterator(const aIterator: TIterator);
+var
+ i: Integer;
+begin
+ 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;
+ end;
end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEvent);
+procedure TutlLinkedList.Release(var aItem: T; const aFreeItem: Boolean);
begin
- inherited Create;
- fType := eetNormal;
- fEvent := aEvent;
+ FinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem);
+ FillByte(aItem, SizeOf(aItem), 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEventO);
+function TutlLinkedList.GetEnumerator: specialize IEnumerator;
begin
- inherited Create;
- fType := eetObject;
- fEventO := aEvent;
+ // TODO
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEventN);
+function TutlLinkedList.GetUtlEnumerator: specialize IutlEnumerator;
begin
- inherited Create;
- fType := eetNested;
- fEventN := aEvent;
+ // TODO
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedList.PushFirst(constref aItem: T);
+begin
+ InsertBefore(fFirst, aItem);
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlComparer.Compare(constref i1, i2: T): Integer;
+function TutlLinkedList.PopFirst(const aFreeItem: Boolean): T;
begin
- if (i1 < i2) then
- result := -1
- else if (i1 > i2) then
- result := 1
- else
- result := 0;
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := Remove(fFirst, aFreeItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlCallbackComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedList.PopFirst;
+begin
+ PopFirst(true);
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCallbackComparer.Compare(constref i1, i2: T): Integer;
+procedure TutlLinkedList.PushLast(constref aItem: T);
begin
- case fType of
- cetNormal: result := fEvent (i1, i2);
- cetObject: result := fEventO(i1, i2);
- cetNested: result := fEventN(i1, i2);
- end;
+ InsertAfter(fLast, aItem)
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCallbackComparer.EqualityCompare(constref i1, i2: T): Boolean;
+function TutlLinkedList.PopLast(const aFreeItem: Boolean): T;
begin
- result := (Compare(i1, i2) = 0);
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := Remove(fLast, aFreeItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCallbackComparer.Create(const aEvent: TCompareEvent);
+procedure TutlLinkedList.PopLast;
begin
- inherited Create;
- fType := cetNormal;
- fEvent := aEvent;
+ PopLast(true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedList.InsertBefore(const aIterator: IutlIterator; constref aItem: T);
+var
+ i: TIterator;
+begin
+ 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 TutlCallbackComparer.Create(const aEvent: TCompareEventO);
+procedure TutlLinkedList.InsertAfter(const aIterator: IutlIterator; constref aItem: T);
+var
+ i: TIterator;
begin
- inherited Create;
- fType := cetObject;
- fEventO := aEvent;
+ 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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlLinkedList.Remove(const aIterator: IutlIterator; const aFreeItem: Boolean): T;
+var
+ i: TIterator;
+begin
+ 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;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCallbackComparer.Create(const aEvent: TCompareEventN);
+procedure TutlLinkedList.Remove(const aIterator: IutlIterator);
+begin
+ Remove(aIterator, true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinkedList.Clear;
+begin
+ while (Count > 0) do
+ PopLast(true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlLinkedList.Create(const aOwnsItems: Boolean);
begin
inherited Create;
- fType := cetNested;
- fEventN := aEvent;
+ fOwnsItems := aOwnsItems;
+ fFirst := nil;
+ fLast := nil;
+ fCount := 0;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TutlLinkedList.Destroy;
+begin
+ Clear;
+ inherited Destroy;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlArrayContainer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//__TutlArrayContainer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlArrayContainer.GetIsEmpty: Boolean;
+function __TutlArrayContainer.GetIsEmpty: Boolean;
begin
result := (Count = 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlArrayContainer.GetInternalItem(const aIndex: Integer): PT;
+function __TutlArrayContainer.GetInternalItem(const aIndex: Integer): PT;
begin
if (aIndex < 0) or (aIndex >= fCapacity) then
raise EutlOutOfRange.Create('capacity out of range', aIndex, 0, fCapacity-1);
@@ -655,7 +906,7 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayContainer.SetCapacity(const aValue: integer);
+procedure __TutlArrayContainer.SetCapacity(const aValue: integer);
begin
if (fCapacity = aValue) then
exit;
@@ -667,14 +918,14 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayContainer.Release(var aItem: T; const aFreeItem: Boolean);
+procedure __TutlArrayContainer.Release(var aItem: T; const aFreeItem: Boolean);
begin
FinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem);
FillByte(aItem, SizeOf(aItem), 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayContainer.Shrink(const aExactFit: Boolean);
+procedure __TutlArrayContainer.Shrink(const aExactFit: Boolean);
begin
if not fCanShrink then
raise EutlInvalidOperation.Create('shrinking is not allowed');
@@ -685,7 +936,7 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayContainer.Expand;
+procedure __TutlArrayContainer.Expand;
begin
if (Count < fCapacity) then
exit;
@@ -700,7 +951,7 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlArrayContainer.Create(const aOwnsItems: Boolean);
+constructor __TutlArrayContainer.Create(const aOwnsItems: Boolean);
begin
inherited Create;
fOwnsItems := aOwnsItems;
@@ -711,7 +962,7 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlArrayContainer.Destroy;
+destructor __TutlArrayContainer.Destroy;
begin
if Assigned(fList) then begin
FreeMem(fList);
@@ -758,6 +1009,18 @@ begin
end;
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlQueue.GetEnumerator: specialize IEnumerator;
+begin
+ // TODO
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlQueue.GetUtlEnumerator: specialize IutlEnumerator;
+begin
+ // TODO
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueue.Enqueue(constref aItem: T);
begin
@@ -784,7 +1047,7 @@ begin
raise EutlInvalidOperation.Create('queue is empty');
p := GetInternalItem(fReadPos);
if aFreeItem
- then FillByte(result, SizeOf(result), 0)
+ then FillByte(result{%H-}, SizeOf(result), 0)
else result := p^;
Release(p^, aFreeItem);
dec(fCount);
@@ -841,6 +1104,18 @@ begin
result := fCount;
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlStack.GetEnumerator: specialize IEnumerator;
+begin
+ // TODO
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlStack.GetUtlEnumerator: specialize IutlEnumerator;
+begin
+ // TODO
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStack.Push(constref aItem: T);
begin
@@ -865,7 +1140,7 @@ begin
raise EutlInvalidOperation.Create('stack is empty');
p := GetInternalItem(fCount-1);
if aFreeItem
- then FillByte(result, SizeOf(result), 0)
+ then FillByte(result{%H-}, SizeOf(result), 0)
else result := p^;
Release(p^, aFreeItem);
dec(fCount);
@@ -911,51 +1186,35 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlSimpleList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//__TutlListBase////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.GetFirst: T;
+function __TutlListBase.GetCount: Integer;
begin
- if IsEmpty then
- raise EutlInvalidOperation.Create('list is empty');
- result := GetInternalItem(0)^;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.GetLast: T;
-begin
- if IsEmpty then
- raise EutlInvalidOperation.Create('list is empty');
- result := GetInternalItem(fCount-1)^;
+ result := fCount;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.GetItem(const aIndex: Integer): T;
+function __TutlListBase.GetItem(const aIndex: Integer): T;
begin
- if (aIndex < 0) or (aIndex >= fCount) then
- raise EutlOutOfRange.Create(aIndex, 0, fCount-1);
+ if (aIndex < 0) or (aIndex >= Count) then
+ raise EutlOutOfRange.Create(aIndex, 0, Count-1);
result := GetInternalItem(aIndex)^;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.SetItem(const aIndex: Integer; aValue: T);
+procedure __TutlListBase.SetItem(const aIndex: Integer; aValue: T);
var
p: PT;
begin
- if (aIndex < 0) or (aIndex >= fCount) then
- raise EutlOutOfRange.Create(aIndex, 0, fCount-1);
+ if (aIndex < 0) or (aIndex >= Count) then
+ raise EutlOutOfRange.Create(aIndex, 0, Count-1);
p := GetInternalItem(aIndex);
Release(p^, true);
p^ := aValue;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.GetCount: Integer;
-begin
- result := fCount;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.InsertIntern(const aIndex: Integer; constref aValue: T);
+procedure __TutlListBase.InsertIntern(const aIndex: Integer; constref aValue: T);
var
p: PT;
begin
@@ -971,7 +1230,7 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
+procedure __TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean);
var
p: PT;
begin
@@ -986,10 +1245,72 @@ begin
FillByte(GetInternalItem(fCount)^, (Capacity-fCount) * SizeOf(T), 0);
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function __TutlListBase.GetEnumerator: specialize IEnumerator;
+begin
+ // TODO
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function __TutlListBase.GetUtlEnumerator: specialize IutlEnumerator;
+begin
+ // TODO
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure __TutlListBase.Clear;
+begin
+ while (Count > 0) do begin
+ dec(fCount);
+ Release(GetInternalItem(fCount)^, true);
+ end;
+ fCount := 0;
+ if CanShrink then
+ ShrinkToFit;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure __TutlListBase.ShrinkToFit;
+begin
+ Shrink(true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor __TutlListBase.Create(const aOwnsItems: Boolean);
+begin
+ inherited Create(aOwnsItems);
+ fCount := 0;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor __TutlListBase.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlSimpleList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlSimpleList.GetFirst: T;
+begin
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := GetInternalItem(0)^;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlSimpleList.GetLast: T;
+begin
+ if IsEmpty then
+ raise EutlInvalidOperation.Create('list is empty');
+ result := GetInternalItem(Count-1)^;
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSimpleList.Add(constref aItem: T): Integer;
begin
- result := fCount;
+ result := Count;
InsertIntern(result, aItem);
end;
@@ -1005,16 +1326,16 @@ var
tmp: T;
p1, p2: PT;
begin
- 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);
+ if (aIndex1 < 0) or (aIndex1 >= Count) then
+ raise EutlOutOfRange.Create(aIndex1, 0, Count-1);
+ if (aIndex2 < 0) or (aIndex2 >= Count) then
+ raise EutlOutOfRange.Create(aIndex2, 0, Count-1);
p1 := GetInternalItem(aIndex1);
p2 := GetInternalItem(aIndex2);
- System.Move(p1^, tmp, SizeOf(T));
+ System.Move(p1^, tmp{%H-}, SizeOf(T));
System.Move(p2^, p1^, SizeOf(T));
System.Move(tmp, p2^, SizeOf(T));
- FillByte(tmp, SizeOf(tmp), 0);
+ FillByte(tmp, SizeOf(tmp), 0)
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1023,15 +1344,15 @@ var
tmp: T;
cur, new: PT;
begin
- 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 < 0) or (aCurrentIndex >= Count) then
+ raise EutlOutOfRange.Create(aCurrentIndex, 0, Count-1);
+ if (aNewIndex < 0) or (aNewIndex >= Count) then
+ raise EutlOutOfRange.Create(aNewIndex, 0, Count-1);
if (aCurrentIndex = aNewIndex) then
exit;
cur := GetInternalItem(aCurrentIndex);
new := GetInternalItem(aNewIndex);
- System.Move(cur^, tmp, SizeOf(T));
+ System.Move(cur^, tmp{%H-}, SizeOf(T));
if (aNewIndex > aCurrentIndex) then begin
System.Move((cur+1)^, cur^, SizeOf(T) * (aNewIndex - aCurrentIndex));
end else begin
@@ -1055,436 +1376,482 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.ShrinkToFit;
+procedure TutlSimpleList.PushFirst(constref aItem: T);
begin
- Shrink(true);
+ InsertIntern(0, aItem);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlSimpleList.PopFirst(const aFreeItem: Boolean): T;
+begin
+ if aFreeItem
+ then FillByte(result{%H-}, SizeOf(result), 0)
+ else result := GetItem(0);
+ DeleteIntern(0, aFreeItem);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlSimpleList.PushLast(constref aItem: T);
+begin
+ InsertIntern(Count, aItem);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlSimpleList.PopLast(const aFreeItem: Boolean): T;
+begin
+ if aFreeItem
+ then FillByte(result{%H-}, SizeOf(result), 0)
+ else result := GetItem(Count-1);
+ DeleteIntern(Count-1, aFreeItem);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlCustomList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlCustomList.IndexOf(const aItem: T): Integer;
+begin
+ result := Count-1;
+ while (result >= 0)
+ and not fEqualityComparer.EqualityCompare(Items[result], aItem)
+ do
+ dec(result);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlCustomList.Remove(const aItem: T): Integer;
+begin
+ result := IndexOf(aItem);
+ if (result >= 0) then
+ DeleteIntern(result, true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlCustomList.Create(const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
+begin
+ if not Assigned(aEqualityComparer) then
+ raise EutlArgumentNil.Create('aEqualityComparer');
+ inherited Create(aOwnsItems);
+ fEqualityComparer := aEqualityComparer;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TutlCustomList.Destroy;
+begin
+ fEqualityComparer := nil;
+ inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlList.Create(const aOwnsItems: Boolean);
+begin
+ inherited Create(TEqualityComparer.Create, aOwnsItems);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlCustomHashSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlCustomHashSet.SetItem(const aIndex: Integer; aValue: T);
+begin
+ if not fComparer.EqualityCompare(GetItem(aIndex), aValue) then
+ EutlInvalidOperation.Create('values are not equal');
+ inherited SetItem(aIndex, aValue);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlCustomHashSet.Add(constref aItem: T): Boolean;
+var
+ i: Integer;
+begin
+ result := not TBinarySearch.Search(self, fComparer, aItem, i);
+ if result then
+ InsertIntern(i, aItem);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlCustomHashSet.Contains(constref aItem: T): Boolean;
+var
+ i: Integer;
+begin
+ result := TBinarySearch.Search(self, fComparer, aItem, i);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlCustomHashSet.IndexOf(constref aItem: T): Integer;
+begin
+ if not TBinarySearch.Search(self, fComparer, aItem, result) then
+ result := -1;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.Clear;
+function TutlCustomHashSet.Remove(constref aItem: T): Boolean;
+var
+ i: Integer;
begin
- while (fCount > 0) do begin
- dec(fCount);
- Release(GetInternalItem(fCount)^, true);
- end;
- fCount := 0;
- if CanShrink then
- ShrinkToFit;
+ result := TBinarySearch.Search(self, fComparer, aItem, i);
+ if result then
+ DeleteIntern(i, true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.PushFirst(constref aItem: T);
+procedure TutlCustomHashSet.Delete(const aIndex: Integer);
begin
- InsertIntern(0, aItem);
+ DeleteIntern(aIndex, true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.PopFirst(const aFreeItem: Boolean): T;
+constructor TutlCustomHashSet.Create(const aComparer: IComparer; const aOwnsItems: Boolean);
begin
- if aFreeItem
- then FillByte(result, SizeOf(result), 0)
- else result := GetItem(0);
- DeleteIntern(0, aFreeItem);
+ inherited Create(aOwnsItems);
+ fComparer := aComparer;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlSimpleList.PushLast(constref aItem: T);
+destructor TutlCustomHashSet.Destroy;
begin
- InsertIntern(fCount, aItem);
+ fComparer := nil;
+ inherited Destroy;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlSimpleList.PopLast(const aFreeItem: Boolean): T;
+//TutlHastSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlHastSet.Create(const aOwnsItems: Boolean);
begin
- if aFreeItem
- then FillByte(result, SizeOf(result), 0)
- else result := GetItem(fCount-1);
- DeleteIntern(fCount-1, aFreeItem);
+ inherited Create(TComparer.Create, aOwnsItems);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlSimpleList.Destroy;
+//TutlCustomMap.THashSet////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlCustomMap.THashSet.Release(var aItem: TKeyValuePair; const aFreeItem: Boolean);
begin
- Clear;
- inherited Destroy;
+ FinalizeObject(aItem.Key, TypeInfo(aItem.Key), fOwner.OwnsKeys and aFreeItem);
+ FinalizeObject(aItem.Value, TypeInfo(aItem.Value), fOwner.OwnsValues and aFreeItem);
+ inherited Release(aItem, aFreeItem);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlCustomList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCustomList.IndexOf(const aItem: T): Integer;
+constructor TutlCustomMap.THashSet.Create(const aOwner: TutlCustomMap; const aComparer: IComparer);
begin
- result := Count-1;
- while (result >= 0)
- and not fEqualityComparer.EqualityCompare(Items[result], aItem)
- do
- dec(result);
+ inherited Create(aComparer, true);
+ fOwner := aOwner;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCustomList.Extract(const aItem: T; const aDefault: T): T;
-var
- i: Integer;
+//TutlCustomMap.TKeyValuePairComparer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlCustomMap.TKeyValuePairComparer.EqualityCompare(constref i1, i2: TKeyValuePair): Boolean;
begin
- i := IndexOf(aItem);
- if (i >= 0) then begin
- result := Items[i];
- DeleteIntern(i, false);
- end else
- result := aDefault;
+ result := (Compare(i1, i2) = 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCustomList.Remove(const aItem: T): Integer;
+function TutlCustomMap.TKeyValuePairComparer.Compare(constref i1, i2: TKeyValuePair): Integer;
begin
- result := IndexOf(aItem);
- if (result >= 0) then
- DeleteIntern(result, true);
+ result := fComparer.Compare(i1.Key, i2.Key);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCustomList.Create(const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
+constructor TutlCustomMap.TKeyValuePairComparer.Create(aComparer: IComparer);
begin
- if not Assigned(aEqualityComparer) then
- raise EutlArgumentNil.Create('aEqualityComparer');
- inherited Create(aOwnsItems);
- fEqualityComparer := aEqualityComparer;
+ inherited Create;
+ fComparer := aComparer;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlCustomList.Destroy;
+destructor TutlCustomMap.TKeyValuePairComparer.Destroy;
begin
- fEqualityComparer := nil;
+ fComparer := nil;
inherited Destroy;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlCustomMap.TKeyCollection//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlList.Create(const aOwnsItems: Boolean);
+function TutlCustomMap.TKeyCollection.GetEnumerator: specialize IEnumerator;
begin
- inherited Create(TEqualityComparer.Create, aOwnsItems);
+ result := GetUtlEnumerator;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlLinkedList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.TIterator.ReleaseElement(const aElement: PElement);
+function TutlCustomMap.TKeyCollection.GetUtlEnumerator: specialize IutlEnumerator;
begin
- if (aElement = fElement) then
- fElement := nil;
+ // TODO
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.TIterator.MoveNext: Boolean;
+function TutlCustomMap.TKeyCollection.GetItem(const aIndex: Integer): TKey;
begin
- if not Assigned(fElement) then
- raise EutlInvalidOperation.Create('this is the null iterator');
- result := Assigned(fElement^.next);
- if result then
- fElement := fElement^.next;
+ result := fHashSet[aIndex].Key;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.TIterator.Clone: IutlIterator;
+function TutlCustomMap.TKeyCollection.GetCount: Integer;
begin
- result := fOwner.CreateIterator(fElement);
+ result := fHashSet.Count;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.TIterator.Equals(const aOther: IutlIterator): Boolean;
-var
- o: TIterator;
+constructor TutlCustomMap.TKeyCollection.Create(const aHashSet: THashSet);
begin
- result := Supports(aOther, TIterator, o)
- and (fElement = o.fElement)
- and (fOwner = o.fOwner);
+ inherited Create;
+ fHashSet := aHashSet;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.TIterator.GetIsValid: Boolean;
+//TutlCustomMap.TKeyValuePairCollection/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlCustomMap.TKeyValuePairCollection.GetEnumerator: specialize IEnumerator;
begin
- result := Assigned(fElement);
+ result := GetUtlEnumerator;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.TIterator.MovePrev: Boolean;
+function TutlCustomMap.TKeyValuePairCollection.GetUtlEnumerator: specialize IutlEnumerator;
begin
- if not Assigned(fElement) then
- raise EutlInvalidOperation.Create('this is the null iterator');
- result := Assigned(fElement^.prev);
- if result then
- fElement := fElement^.prev;
+ // TODO
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.TIterator.GetValue: T;
+function TutlCustomMap.TKeyValuePairCollection.GetItem(const aIndex: Integer): TKeyValuePair;
begin
- if not Assigned(fElement) then
- raise EutlInvalidOperation.Create('this is the null iterator');
- result := fElement^.data;
+ result := fHashSet[aIndex];
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.TIterator.SetValue(const aValue: T);
+function TutlCustomMap.TKeyValuePairCollection.GetCount: Integer;
begin
- if not Assigned(fElement) then
- raise EutlInvalidOperation.Create('this is the null iterator');
- fElement^.data := aValue;
+ result := fHashSet.Count;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlLinkedList.TIterator.Create(const aElement: PElement; const aOwner: TutlLinkedList);
+constructor TutlCustomMap.TKeyValuePairCollection.Create(const aHashSet: THashSet);
begin
inherited Create;
- fOwner := aOwner;
- fElement := aElement;
+ fHashSet := aHashSet;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlLinkedList.TIterator.Destroy;
+//TutlCustomMap/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlCustomMap.GetValue(aKey: TKey): TValue;
+var
+ i: Integer;
+ kvp: TKeyValuePair;
begin
- if Assigned(fOwner) then
- fOwner.DestroyIterator(self);
- inherited Destroy;
+ kvp.Key := aKey;
+ i := fHashSetRef.IndexOf(kvp);
+ if (i < 0)
+ then FillByte(result{%H-}, SizeOf(result), 0)
+ else result := fHashSetRef[i].Value;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlLinkedList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.GetFirst: Iterator;
+function TutlCustomMap.GetValueAt(const aIndex: Integer): TValue;
begin
- if IsEmpty then
- raise EutlInvalidOperation.Create('list is empty');
- result := CreateIterator(fFirst);
+ result := fHashSetRef[aIndex].Value;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.GetLast: Iterator;
+function TutlCustomMap.GetCount: Integer;
begin
- if IsEmpty then
- raise EutlInvalidOperation.Create('list is empty');
- result := CreateIterator(fLast);
+ result := fHashSetRef.Count;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.GetIsEmpty: Boolean;
+function TutlCustomMap.GetIsEmpty: Boolean;
begin
- result := (fCount = 0);
+ result := (fHashSetRef.Count <= 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.LinkElement(const aElement: PElement);
+function TutlCustomMap.GetCapacity: Integer;
begin
- 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;
+ result := fHashSetRef.Capacity;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.InsertBefore(const aElement: PElement; constref aItem: T);
-var
- e: PElement;
+function TutlCustomMap.GetCanShrink: Boolean;
begin
- 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);
+ result := fHashSetRef.CanShrink;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.InsertAfter(const aElement: PElement; constref aItem: T);
-var
- e: PElement;
+function TutlCustomMap.GetCanExpand: Boolean;
begin
- 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);
+ result := fHashSetRef.CanExpand;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.Remove(const aElement: PElement; const aFreeItem: Boolean): T;
+procedure TutlCustomMap.SetValue(aKey: TKey; const aValue: TValue);
var
i: Integer;
-begin
- 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);
+ 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;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.CreateIterator(const aElement: PElement): TIterator;
+procedure TutlCustomMap.SetValueAt(const aIndex: Integer; const aValue: TValue);
+var
+ kvp: TKeyValuePair;
begin
- result := TIterator.Create(aElement, self);
- SetLength(fIterators, Length(fIterators) + 1);
- fIterators[High(fIterators)] := result;
+ kvp := fHashSetRef[aIndex];
+ kvp.Value := aValue;
+ fHashSetRef[aIndex] := kvp;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.DestroyIterator(const aIterator: TIterator);
-var
- i: Integer;
+procedure TutlCustomMap.SetCapacity(const aValue: Integer);
begin
- 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;
- end;
- end;
+ fHashSetRef.Capacity := aValue;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.Release(var aItem: T; const aFreeItem: Boolean);
+procedure TutlCustomMap.SetCanShrink(const aValue: Boolean);
begin
- FinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem);
- FillByte(aItem, SizeOf(aItem), 0);
+ fHashSetRef.CanShrink := aValue;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.PushFirst(constref aItem: T);
+procedure TutlCustomMap.SetCanExpand(const aValue: Boolean);
begin
- InsertBefore(fFirst, aItem);
+ fHashSetRef.CanExpand := aValue;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.PopFirst(const aFreeItem: Boolean): T;
+procedure TutlCustomMap.Add(constref aKey: TKey; constref aValue: TValue);
begin
- if IsEmpty then
- raise EutlInvalidOperation.Create('list is empty');
- result := Remove(fFirst, aFreeItem);
+ if not TryAdd(aKey, aValue) then
+ raise EutlMap.Create('key already exists');
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.PopFirst;
+function TutlCustomMap.TryAdd(constref aKey: TKey; constref aValue: TValue): Boolean;
+var
+ kvp: TKeyValuePair;
begin
- PopFirst(true);
+ kvp.Key := aKey;
+ kvp.Value := aValue;
+ result := fHashSetRef.Add(kvp);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.PushLast(constref aItem: T);
+function TutlCustomMap.TryGetValue(constref aKey: TKey; out aValue: TValue): Boolean;
+var
+ i: Integer;
begin
- InsertAfter(fLast, aItem)
+ i := IndexOf(aKey);
+ result := (i >= 0);
+ if result
+ then aValue := fHashSetRef[i].Value
+ else FillByte(result, SizeOf(result), 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.PopLast(const aFreeItem: Boolean): T;
+function TutlCustomMap.IndexOf(constref aKey: TKey): Integer;
+var
+ kvp: TKeyValuePair;
begin
- if IsEmpty then
- raise EutlInvalidOperation.Create('list is empty');
- result := Remove(fLast, aFreeItem);
+ kvp.Key := aKey;
+ result := fHashSetRef.IndexOf(kvp);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.PopLast;
+function TutlCustomMap.Contains(constref aKey: TKey): Boolean;
begin
- PopLast(true);
+ result := (IndexOf(aKey) >= 0);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.InsertBefore(const aIterator: IutlIterator; constref aItem: T);
+procedure TutlCustomMap.Delete(constref aKey: TKey);
var
- i: TIterator;
+ kvp: TKeyValuePair;
begin
- 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);
+ kvp.Key := aKey;
+ if not fHashSetRef.Remove(kvp) then
+ raise EutlMap.Create('key not found');
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.InsertAfter(const aIterator: IutlIterator; constref aItem: T);
-var
- i: TIterator;
+procedure TutlCustomMap.DeleteAt(const aIndex: Integer);
begin
- 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);
+ fHashSetRef.Delete(aIndex);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlLinkedList.Remove(const aIterator: IutlIterator; const aFreeItem: Boolean): T;
-var
- i: TIterator;
+procedure TutlCustomMap.Clear;
begin
- 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);
+ fHashSetRef.Clear;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.Remove(const aIterator: IutlIterator);
+constructor TutlCustomMap.Create(
+ const aHashSet: THashSet;
+ const aOwnsKeys: Boolean;
+ const aOwnsValues: Boolean);
begin
- Remove(aIterator, true);
+ if not Assigned(aHashSet) then
+ EutlArgumentNil.Create('aHashSet');
+
+ inherited Create;
+
+ fAutoCreate := false;
+ fHashSetRef := aHashSet;
+ fOwnsKeys := aOwnsKeys;
+ fOwnsValues := aOwnsValues;
+
+ fKeyCollection := TKeyCollection.Create(fHashSetRef);
+ fKeyValuePairCollection := TKeyValuePairCollection.Create(fHashSetRef);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlLinkedList.Clear;
+destructor TutlCustomMap.Destroy;
begin
- while (Count > 0) do
- PopLast(true);
+ FreeAndNil(fKeyValuePairCollection);
+ FreeAndNil(fKeyCollection);
+ fHashSetRef := nil;
+ inherited Destroy;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlLinkedList.Create(const aOwnsItems: Boolean);
+//TutlMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlMap.Create(const aOwnsKeys: Boolean; const aOwnsValues: Boolean);
begin
- inherited Create;
- fOwnsItems := aOwnsItems;
- fFirst := nil;
- fLast := nil;
- fCount := 0;
+ fHashSetImpl := THashSet.Create(self, TKeyValuePairComparer.Create(TComparer.Create));
+ inherited Create(fHashSetImpl, aOwnsKeys, aOwnsValues);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TutlLinkedList.Destroy;
+destructor TutlMap.Destroy;
begin
Clear;
inherited Destroy;
+ FreeAndNil(fHashSetImpl);
end;
end.