diff --git a/tests/tests.lpi b/tests/tests.lpi
index 3e57aad..b6f758c 100644
--- a/tests/tests.lpi
+++ b/tests/tests.lpi
@@ -37,7 +37,7 @@
-
+
@@ -55,73 +55,129 @@
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -150,6 +206,12 @@
+
+
+
+
+
+
diff --git a/tests/tests.lpr b/tests/tests.lpr
index b393bc2..6ddab23 100644
--- a/tests/tests.lpr
+++ b/tests/tests.lpr
@@ -1,11 +1,22 @@
program tests;
{$mode objfpc}{$H+}
+{$WARN 5023 off}
uses
Interfaces, Forms, GUITestRunner,
- uutlStackTests, uutlQueueTests, uutlListTest, uutlHashSetTests, uutlArrayTests,
- uutlAlgorithmTests, uutlMapTests, uutlEnumeratorTests;
+
+ // test cases
+ uutlAlgorithmTests, uutlEnumeratorTests, uutlHashSetTests, uutlLinqTests,
+ uutlListTest, uutlMapTests, uutlQueueTests, uutlStackTests,
+
+ // test misc
+ uTestHelper,
+
+ // units unter test
+ uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlEnumerator,
+ uutlFilter, uutlGenerics, uutlInterfaces, uutlLinq, uutlListBase, uutlLogger,
+ uutlStreamHelper, uutlSyncObjs, uutlTypes, uutlXmlHelper, uutlObservable, uutlObservableListTests;
{$R *.res}
diff --git a/tests/tests.lps b/tests/tests.lps
index 1d7f0bf..58c2ceb 100644
--- a/tests/tests.lps
+++ b/tests/tests.lps
@@ -4,402 +4,605 @@
-
+
-
-
-
-
+
+
+
-
-
-
+
+
-
-
-
+
+
+
-
-
-
+
+
+
+
-
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
+
+
+
+
+
+
+
+
+
-
+
-
-
+
+
+
-
+
-
-
-
-
+
+
+
-
+
-
-
-
+
+
+
-
+
-
+
+
+
-
+
-
-
-
-
+
+
+
+
-
+
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
+
+
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
-
+
+
-
-
-
-
+
+
+
-
+
+
-
-
-
+
+
+
-
+
+
-
-
-
-
+
+
+
-
+
+
-
-
-
-
+
+
+
-
+
-
-
-
+
+
+
+
-
+
+
-
-
-
-
+
+
+
+
-
+
-
-
-
-
+
+
+
+
+
-
+
-
-
-
-
-
+
+
+
+
+
-
+
+
-
-
-
+
+
+
+
-
+
+
-
-
-
-
+
+
+
+
-
+
-
-
-
-
-
+
+
+
-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
diff --git a/tests/uutlAlgorithmTests.pas b/tests/uutlAlgorithmTests.pas
index 15c492e..fe07ad3 100644
--- a/tests/uutlAlgorithmTests.pas
+++ b/tests/uutlAlgorithmTests.pas
@@ -19,7 +19,7 @@ type
implementation
uses
- uutlGenerics, uutlAlgorithm;
+ uutlTypes, uutlGenerics, uutlAlgorithm;
type
TIntArray = specialize TutlArray;
@@ -36,8 +36,7 @@ var
index: Integer;
ret: Boolean;
begin
- arr := TIntArray.Create;
- arr.Count := 10;
+ SetLength(arr, 10);
arr[0] := 1;
arr[1] := 4;
arr[2] := 5;
@@ -49,23 +48,23 @@ begin
arr[8] := 21;
arr[9] := 22;
- ret := TBinarySearch.Search(arr, TIntComparer.Create, 4, index);
+ ret := TBinarySearch.Search(arr[0], Length(arr), TIntComparer.Create, 4, index);
AssertTrue (ret);
AssertEquals(1, index);
- ret := TBinarySearch.Search(arr, TIntComparer.Create, 7, index);
+ ret := TBinarySearch.Search(arr[0], Length(arr), TIntComparer.Create, 7, index);
AssertFalse (ret);
AssertEquals(4, index);
- ret := TBinarySearch.Search(arr, TIntComparer.Create, 13, index);
+ ret := TBinarySearch.Search(arr[0], Length(arr), TIntComparer.Create, 13, index);
AssertTrue (ret);
AssertEquals(6, index);
- ret := TBinarySearch.Search(arr, TIntComparer.Create, 19, index);
+ ret := TBinarySearch.Search(arr[0], Length(arr), TIntComparer.Create, 19, index);
AssertFalse (ret);
AssertEquals(7, index);
- ret := TBinarySearch.Search(arr, TIntComparer.Create, 25, index);
+ ret := TBinarySearch.Search(arr[0], Length(arr), TIntComparer.Create, 25, index);
AssertFalse (ret);
AssertEquals(10, index);
end;
@@ -75,8 +74,7 @@ procedure TutlAlgorithmTest.QuickSort;
var
arr: TIntArray;
begin
- arr := TIntArray.Create;
- arr.Count := 20;
+ SetLength(arr, 20);
arr[ 0] := 134;
arr[ 1] := 314;
arr[ 2] := 721;
@@ -97,7 +95,7 @@ begin
arr[17] := 456;
arr[18] := 678;
arr[19] := 832;
- TQuickSort.Sort(arr, TIntComparer.Create);
+ TQuickSort.Sort(arr[0], Length(arr), TIntComparer.Create);
AssertEquals(126, arr[ 0]);
AssertEquals(134, arr[ 1]);
AssertEquals(163, arr[ 2]);
diff --git a/tests/uutlArrayTests.pas b/tests/uutlArrayTests.pas
deleted file mode 100644
index 4f4eca0..0000000
--- a/tests/uutlArrayTests.pas
+++ /dev/null
@@ -1,151 +0,0 @@
-unit uutlArrayTests;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes, SysUtils, TestFramework,
- uutlGenerics;
-
-type
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TIntArray = specialize TutlArray;
-
- TutlArrayTest = class(TTestCase)
- published
- procedure Prop_Get_Count;
- procedure Prop_Set_Count;
- procedure Prop_Get_Items;
- procedure Prop_Set_Items;
- procedure Prop_Get_Data;
- procedure Prop_Set_Data;
-
- procedure Meth_Ctor;
- end;
-
-implementation
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlArrayTest/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayTest.Prop_Get_Count;
-var
- arr: TIntArray;
-begin
- arr := TIntArray.Create;
- try
- AssertEquals(0, arr.Count);
- finally
- FreeAndNil(arr);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayTest.Prop_Set_Count;
-var
- arr: TIntArray;
-begin
- arr := TIntArray.Create;
- try
- AssertEquals(0, arr.Count);
- arr.Count := 1;
- AssertEquals(1, arr.Count);
- arr.Count := 5;
- AssertEquals(5, arr.Count);
- finally
- FreeAndNil(arr);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayTest.Prop_Get_Items;
-var
- arr: TIntArray;
-begin
- arr := TIntArray.Create;
- try
- arr.Count := 1;
- AssertEquals(0, arr[0]);
- finally
- FreeAndNil(arr);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayTest.Prop_Set_Items;
-var
- arr: TIntArray;
-begin
- arr := TIntArray.Create;
- try
- arr.Count := 3;
- arr[0] := 1;
- arr[1] := 3;
- arr[2] := 5;
- AssertEquals(1, arr[0]);
- AssertEquals(3, arr[1]);
- AssertEquals(5, arr[2]);
- finally
- FreeAndNil(arr);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayTest.Prop_Get_Data;
-var
- arr: TIntArray;
- data: TIntArray.TData;
-begin
- arr := TIntArray.Create;
- try
- arr.Count := 3;
- arr[0] := 1;
- arr[1] := 3;
- arr[2] := 5;
- data := arr.Data;
- AssertEquals(3, Length(data));
- AssertEquals(1, data[0]);
- AssertEquals(3, data[1]);
- AssertEquals(5, data[2]);
- finally
- FreeAndNil(arr);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayTest.Prop_Set_Data;
-var
- arr: TIntArray;
- data: TIntArray.TData;
-begin
- arr := TIntArray.Create;
- try
- SetLength(data, 5);
- arr.Data := data;
- AssertEquals(5, arr.Count);
- finally
- FreeAndNil(arr);
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayTest.Meth_Ctor;
-var
- arr: TIntArray;
- data: TIntArray.TData;
-begin
- SetLength(data, 5);
- arr := TIntArray.Create(data);
- try
- AssertEquals(5, arr.Count);
- finally
- FreeAndNil(arr);
- end;
-end;
-
-initialization
- RegisterTest(TutlArrayTest.Suite);
-
-end.
-
diff --git a/tests/uutlEnumeratorTests.pas b/tests/uutlEnumeratorTests.pas
index 52f9df5..447ffde 100644
--- a/tests/uutlEnumeratorTests.pas
+++ b/tests/uutlEnumeratorTests.pas
@@ -1,281 +1,522 @@
unit uutlEnumeratorTests;
{$mode objfpc}{$H+}
-{$modeswitch nestedprocvars}
+{$IFDEF UTL_NESTED_PROCVARS}
+ {$modeswitch nestedprocvars}
+{$ENDIF}
interface
uses
Classes, SysUtils, TestFramework,
- uutlEnumerator;
+ uutlEnumerator, uutlInterfaces;
type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ IIntEnumerator = specialize {$IFDEF UTL_ENUMERATORS}IutlEnumerator{$ELSE}IEnumerator{$ENDIF};
TutlEnumeratorTests = class(TTestCase)
+ protected
+ fEnumerator: IIntEnumerator;
+
+ function GenerateOther(const aData: array of Integer): IIntEnumerator;
+ procedure Generate(const aData: array of Integer); virtual; abstract;
+
published
- procedure ArrayEnumerator;
- procedure ArrayEnumerator_Reverse;
- procedure ArrayEnumerator_Count;
- procedure ArrayEnumerator_Skip;
- procedure ArrayEnumerator_Take;
- procedure ArrayEnumerator_Skip_Reverse;
- procedure ArrayEnumerator_Take_Reverse;
- procedure ArrayEnumerator_Reverse_Skip;
- procedure ArrayEnumerator_Reverse_Take;
- procedure ArrayEnumerator_Where;
- procedure ArrayEnumerator_Select;
+ // Procedure Names: ProcedureUnderTest_[Parameter]_EnumeratorItems_Result
+ procedure Iterate_1to5_1to5;
+ {$IFDEF UTL_ENUMERATORS}
+ procedure Count_1to5_5;
+ procedure Any_Empty_False;
+ procedure Any_1to5_True;
+ procedure Reverse_1to5_5to1;
+ procedure Skip2_1to5_3to5;
+ procedure Take3_1to5_1to3;
+ procedure Skip5_Reverse_0to9_9to5;
+ procedure Take5_Reverse_0to9_4to0;
+ procedure Reverse_Skip5_0to9_4to0;
+ procedure Reverse_Take5_0to9_9to5;
+ procedure Contains3_1to5_true;
+ procedure Contains9_1to5_false;
+ procedure Concat6to8_1to5_1to8;
+ {$IFDEF UTL_ADVANCED_ENUMERATORS}
+ procedure Sort;
+ procedure Where_IsEven;
+ procedure Distinct;
+ procedure Intersect;
+ procedure Union;
+ procedure Without;
+ procedure Select;
+ {$ENDIF}
+ {$ENDIF}
+ end;
+
+ TutlArrayEnumeratorTests = class(TutlEnumeratorTests)
+ protected
+ procedure Generate(const aData: array of Integer); override;
+
+ public
+ procedure SetUp; override;
end;
implementation
uses
- uutlFilter;
+ uutlFilter, uutlComparer;
type
- TIntCalbackFilter = specialize TutlCalbackFilter;
- TIntArrEnumerator = specialize TutlArrayEnumerator;
- TFloatArrEnumerator = specialize TutlArrayEnumerator;
+ TIntArrayEnumerator = specialize TutlArrayEnumerator;
-function CreateArrayEnumerator(const aSize: Integer): TIntArrEnumerator.IEnumerator;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlEnumeratorTests///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlEnumeratorTests.GenerateOther(const aData: array of Integer): IIntEnumerator;
var
- arr: array of Integer;
i: Integer;
+ arr: TIntArrayEnumerator.TArray;
begin
- SetLength(arr, aSize);
- for i := low(arr) to high(arr) do
- arr[i] := i + 1;
- result := TIntArrEnumerator.Create(arr);
+ SetLength(arr, Length(aData));
+ for i := low(aData) to high(aData) do
+ arr[i] := aData[i];
+ result := TIntArrayEnumerator.Create(arr);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlEnumeratorTests///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlEnumeratorTests.Iterate_1to5_1to5;
+begin
+ Generate([1, 2, 3, 4, 5]);
+ fEnumerator.Reset;
+ AssertTrue (fEnumerator.MoveNext);
+ AssertEquals(1, fEnumerator.GetCurrent);
+ AssertTrue (fEnumerator.MoveNext);
+ AssertEquals(2, fEnumerator.GetCurrent);
+ AssertTrue (fEnumerator.MoveNext);
+ AssertEquals(3, fEnumerator.GetCurrent);
+ AssertTrue (fEnumerator.MoveNext);
+ AssertEquals(4, fEnumerator.GetCurrent);
+ AssertTrue (fEnumerator.MoveNext);
+ AssertEquals(5, fEnumerator.GetCurrent);
+ AssertFalse (fEnumerator.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IFDEF UTL_ENUMERATORS}
+procedure TutlEnumeratorTests.Count_1to5_5;
+var
+ i: Integer;
+begin
+ Generate([1, 2, 3, 4, 5]);
+ i := fEnumerator.Count;
+ AssertEquals(5, i);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlEnumeratorTests.Any_Empty_False;
+begin
+ AssertFalse(fEnumerator.Any);
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEnumeratorTests.ArrayEnumerator;
+procedure TutlEnumeratorTests.Any_1to5_True;
+begin
+ Generate([1, 2, 3, 4, 5]);
+ AssertTrue(fEnumerator.Any);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlEnumeratorTests.Reverse_1to5_5to1;
var
- e: TIntArrEnumerator.IEnumerator;
+ e: IIntEnumerator;
begin
- e := CreateArrayEnumerator(5);
+ e := fEnumerator.Reverse;
+ Generate([1, 2, 3, 4, 5]);
+ e.Reset;
AssertTrue (e.MoveNext);
- AssertEquals(1, e.Current);
+ AssertEquals(5, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(2, e.Current);
+ AssertEquals(4, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(3, e.Current);
+ AssertEquals(3, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(4, e.Current);
+ AssertEquals(2, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(5, e.Current);
+ AssertEquals(1, e.GetCurrent);
AssertFalse (e.MoveNext);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEnumeratorTests.ArrayEnumerator_Reverse;
+procedure TutlEnumeratorTests.Skip2_1to5_3to5;
var
- e: TIntArrEnumerator.IEnumerator;
+ e: IIntEnumerator;
begin
- e := CreateArrayEnumerator(5)
- .Reverse;
- AssertTrue (e.MoveNext);
- AssertEquals(5, e.Current);
+ e := fEnumerator.Skip(2);
+ Generate([1, 2, 3, 4, 5]);
+ e.Reset;
AssertTrue (e.MoveNext);
- AssertEquals(4, e.Current);
- AssertTrue (e.MoveNext);
- AssertEquals(3, e.Current);
+ AssertEquals(3, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(2, e.Current);
+ AssertEquals(4, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(1, e.Current);
+ AssertEquals(5, e.GetCurrent);
AssertFalse (e.MoveNext);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEnumeratorTests.ArrayEnumerator_Count;
+procedure TutlEnumeratorTests.Take3_1to5_1to3;
var
- e: TIntArrEnumerator.IEnumerator;
+ e: IIntEnumerator;
begin
- e := CreateArrayEnumerator(5);
- AssertEquals(5, e.Count);
+ e := fEnumerator.Take(3);
+ Generate([1, 2, 3, 4, 5]);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.GetCurrent);
+ AssertFalse (e.MoveNext);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEnumeratorTests.ArrayEnumerator_Skip;
+procedure TutlEnumeratorTests.Skip5_Reverse_0to9_9to5;
var
- e: TIntArrEnumerator.IEnumerator;
+ e: IIntEnumerator;
begin
- e := CreateArrayEnumerator(10)
- .Skip(5);
+ e := fEnumerator.Skip(5).Reverse;
+ Generate([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
+ e.Reset;
AssertTrue (e.MoveNext);
- AssertEquals(6, e.Current);
+ AssertEquals(9, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(7, e.Current);
+ AssertEquals(8, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(8, e.Current);
+ AssertEquals(7, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(9, e.Current);
+ AssertEquals(6, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(10, e.Current);
+ AssertEquals(5, e.GetCurrent);
AssertFalse (e.MoveNext);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEnumeratorTests.ArrayEnumerator_Take;
+procedure TutlEnumeratorTests.Take5_Reverse_0to9_4to0;
var
- e: TIntArrEnumerator.IEnumerator;
+ e: IIntEnumerator;
begin
- e := CreateArrayEnumerator(10)
- .Take(5);
+ e := fEnumerator.Take(5).Reverse;
+ Generate([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
+ e.Reset;
AssertTrue (e.MoveNext);
- AssertEquals(1, e.Current);
+ AssertEquals(4, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(2, e.Current);
+ AssertEquals(3, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(3, e.Current);
+ AssertEquals(2, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(4, e.Current);
+ AssertEquals(1, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(5, e.Current);
+ AssertEquals(0, e.GetCurrent);
AssertFalse (e.MoveNext);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEnumeratorTests.ArrayEnumerator_Skip_Reverse;
+procedure TutlEnumeratorTests.Reverse_Skip5_0to9_4to0;
var
- e: TIntArrEnumerator.IEnumerator;
+ e: IIntEnumerator;
begin
- e := CreateArrayEnumerator(10)
- .Skip(5)
- .Reverse;
+ e := fEnumerator.Reverse.Skip(5);
+ Generate([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
+ e.Reset;
AssertTrue (e.MoveNext);
- AssertEquals(10, e.Current);
+ AssertEquals(4, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(9, e.Current);
+ AssertEquals(3, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(8, e.Current);
+ AssertEquals(2, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(7, e.Current);
+ AssertEquals(1, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(6, e.Current);
+ AssertEquals(0, e.GetCurrent);
AssertFalse (e.MoveNext);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEnumeratorTests.ArrayEnumerator_Take_Reverse;
+procedure TutlEnumeratorTests.Reverse_Take5_0to9_9to5;
var
- e: TIntArrEnumerator.IEnumerator;
+ e: IIntEnumerator;
begin
- e := CreateArrayEnumerator(10)
- .Take(5)
- .Reverse;
+ e := fEnumerator.Reverse.Take(5);
+ Generate([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
+ e.Reset;
AssertTrue (e.MoveNext);
- AssertEquals(5, e.Current);
+ AssertEquals(9, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(4, e.Current);
+ AssertEquals(8, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(3, e.Current);
+ AssertEquals(7, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(2, e.Current);
+ AssertEquals(6, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(1, e.Current);
+ AssertEquals(5, e.GetCurrent);
AssertFalse (e.MoveNext);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEnumeratorTests.ArrayEnumerator_Reverse_Skip;
+procedure TutlEnumeratorTests.Contains3_1to5_true;
var
- e: TIntArrEnumerator.IEnumerator;
+ b: Boolean;
begin
- e := CreateArrayEnumerator(10)
- .Reverse
- .Skip(5);
+ Generate([1, 2, 3, 4, 5]);
+ b := fEnumerator.Contains(3, specialize TutlEqualityComparer.Create);
+ AssertTrue(b);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlEnumeratorTests.Contains9_1to5_false;
+var
+ b: Boolean;
+begin
+ Generate([1, 2, 3, 4, 5]);
+ b := fEnumerator.Contains(9, specialize TutlEqualityComparer.Create);
+ AssertFalse(b);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlEnumeratorTests.Concat6to8_1to5_1to8;
+var
+ e: IIntEnumerator;
+begin
+ e := fEnumerator.Concat(GenerateOther([6, 7, 8]));
+ Generate([1, 2, 3, 4, 5]);
+ e.Reset;
AssertTrue (e.MoveNext);
- AssertEquals(5, e.Current);
+ AssertEquals(1, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(4, e.Current);
+ AssertEquals(2, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(3, e.Current);
+ AssertEquals(3, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(2, e.Current);
+ AssertEquals(4, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(1, e.Current);
+ AssertEquals(5, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(7, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(8, e.GetCurrent);
AssertFalse (e.MoveNext);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEnumeratorTests.ArrayEnumerator_Reverse_Take;
+{$IFDEF UTL_ADVANCED_ENUMERATORS}
+procedure TutlEnumeratorTests.Sort;
var
- e: TIntArrEnumerator.IEnumerator;
+ e: IIntEnumerator;
begin
- e := CreateArrayEnumerator(10)
- .Reverse
- .Take(5);
+ e := fEnumerator.Sort(specialize TutlComparer.Create);
+ Generate([5, 8, 2, 6, 9, 4, 2, 6, 8, 4, 2, 5, 8, 4]);
+ e.Reset;
AssertTrue (e.MoveNext);
- AssertEquals(10, e.Current);
+ AssertEquals(2, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(9, e.Current);
+ AssertEquals(2, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(8, e.Current);
+ AssertEquals(2, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(7, e.Current);
+ AssertEquals(4, e.GetCurrent);
AssertTrue (e.MoveNext);
- AssertEquals(6, e.Current);
+ AssertEquals(4, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(8, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(8, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(8, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(9, e.GetCurrent);
AssertFalse (e.MoveNext);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEnumeratorTests.ArrayEnumerator_Where;
+function IsEven(constref i: Integer): Boolean;
+begin
+ result := (i mod 2) = 0;
+end;
- function IsEven(constref i: Integer): Boolean;
- begin
- result := (i mod 2) = 0;
- end;
+procedure TutlEnumeratorTests.Where_IsEven;
+var
+ e: IIntEnumerator;
+begin
+ e := fEnumerator.Where(specialize TutlCallbackFilter.Create(@IsEven));
+ Generate([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(0, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.GetCurrent);
+ AssertTrue (e.MoveNext);
+ AssertEquals(8, e.GetCurrent);
+ AssertFalse (e.MoveNext);
+end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlEnumeratorTests.Distinct;
var
- e: TIntArrEnumerator.IEnumerator;
+ e: IIntEnumerator;
begin
- e := CreateArrayEnumerator(10)
- .Where(TIntCalbackFilter.Create(@IsEven));
+ e := fEnumerator.Distinct(specialize TutlComparer.Create);
+ Generate([1, 5, 2, 7, 1, 3, 7, 4, 5, 8]);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.Current);
AssertTrue (e.MoveNext);
AssertEquals(2, e.Current);
AssertTrue (e.MoveNext);
+ AssertEquals(7, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
AssertEquals(4, e.Current);
AssertTrue (e.MoveNext);
+ AssertEquals(8, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlEnumeratorTests.Intersect;
+var
+ e: IIntEnumerator;
+begin
+ e := fEnumerator
+ .Intersect(GenerateOther([5, 6, 8]), specialize TutlComparer.Create);
+ Generate([1, 6, 4, 8, 2, 5]);
+ e.Reset;
+ AssertTrue (e.MoveNext);
AssertEquals(6, e.Current);
AssertTrue (e.MoveNext);
AssertEquals(8, e.Current);
AssertTrue (e.MoveNext);
- AssertEquals(10, e.Current);
+ AssertEquals(5, e.Current);
AssertFalse (e.MoveNext);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEnumeratorTests.ArrayEnumerator_Select;
+procedure TutlEnumeratorTests.Union;
+var
+ e: IIntEnumerator;
+begin
+ e := fEnumerator
+ .Union(GenerateOther([9, 3, 4, 6, 7]), specialize TutlComparer.Create);
+ Generate([1, 6, 4, 8, 2, 5]);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(8, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(9, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(7, e.Current);
+ AssertFalse (e.MoveNext);
+end;
- function ConvertToFloat(constref a: Integer): Single;
- begin
- result := Single(a);
- end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlEnumeratorTests.Without;
+var
+ e: IIntEnumerator;
+begin
+ e := fEnumerator
+ .Without(GenerateOther([6, 8, 5]), specialize TutlComparer.Create);
+ Generate([1, 6, 4, 8, 2, 5]);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function ConvertToFloat(constref a: Integer): Single;
+begin
+ result := Single(a) / 2.0;
+end;
+procedure TutlEnumeratorTests.Select;
var
- e: TFloatArrEnumerator.IEnumerator;
+ e: specialize IutlEnumerator;
begin
e := specialize TutlSelectEnumerator.Create(
- CreateArrayEnumerator(5),
- specialize TutlCalbackSelector.Create(@ConvertToFloat));
+ fEnumerator,
+ specialize TutlCallbackSelector.Create(@ConvertToFloat));
+ Generate([1, 2, 3, 4, 5]);
+ e.Reset;
AssertTrue (e.MoveNext);
- AssertEquals(1.0, e.Current);
+ AssertEquals(0.5, e.Current);
AssertTrue (e.MoveNext);
- AssertEquals(2.0, e.Current);
+ AssertEquals(1.0, e.Current);
AssertTrue (e.MoveNext);
- AssertEquals(3.0, e.Current);
+ AssertEquals(1.5, e.Current);
AssertTrue (e.MoveNext);
- AssertEquals(4.0, e.Current);
+ AssertEquals(2.0, e.Current);
AssertTrue (e.MoveNext);
- AssertEquals(5.0, e.Current);
+ AssertEquals(2.5, e.Current);
AssertFalse (e.MoveNext);
end;
+{$ENDIF}
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlArrayEnumeratorTests//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlArrayEnumeratorTests.Generate(const aData: array of Integer);
+var
+ i: Integer;
+ arr: TIntArrayEnumerator.TArray;
+begin
+ SetLength(arr, Length(aData));
+ for i := low(aData) to high(aData) do
+ arr[i] := aData[i];
+ (fEnumerator as TIntArrayEnumerator).Data := arr;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlArrayEnumeratorTests.SetUp;
+begin
+ fEnumerator := TIntArrayEnumerator.Create;
+end;
initialization
- RegisterTest(TutlEnumeratorTests.Suite);
+ RegisterTest(TutlArrayEnumeratorTests.Suite);
end.
diff --git a/tests/uutlHashSetTests.pas b/tests/uutlHashSetTests.pas
index 39b4f7b..dcf0cb0 100644
--- a/tests/uutlHashSetTests.pas
+++ b/tests/uutlHashSetTests.pas
@@ -10,7 +10,7 @@ uses
type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TIntSet = specialize TutlHastSet;
+ TIntSet = specialize TutlHashSet;
TutlHastSetTests = class(TTestCase)
private
fIntSet: TIntSet;
diff --git a/tests/uutlLinqTests.pas b/tests/uutlLinqTests.pas
new file mode 100644
index 0000000..d916e2d
--- /dev/null
+++ b/tests/uutlLinqTests.pas
@@ -0,0 +1,855 @@
+unit uutlLinqTests;
+
+{$mode objfpc}{$H+}
+{$IFDEF UTL_NESTED_PROCVARS}
+ {$modeswitch nestedprocvars}
+{$ENDIF}
+
+interface
+
+{$IFDEF UTL_ENUMERATORS}
+uses
+ Classes, SysUtils, TestFramework,
+ uutlLinq;
+
+type
+ TutlLinqTests = class(TTestCase)
+ published
+ procedure proc_Count;
+ procedure proc_Any;
+ procedure proc_Contains;
+ procedure proc_Contains_WithComparer;
+ procedure proc_ToArray;
+
+ procedure proc_Reverse;
+ procedure proc_Skip;
+ procedure proc_Take;
+ procedure proc_Concat;
+ procedure proc_Concat_WithArray;
+ {$IFDEF UTL_ADVANCED_ENUMERATORS}
+ procedure proc_Sort;
+ procedure proc_Sort_WithComparer;
+ procedure proc_Where_WithFilter;
+ procedure proc_Where_WithNormalCallback;
+ procedure proc_Where_WithObjectCallback;
+ {$IFDEF UTL_NESTED_PROCVARS}
+ procedure proc_Where_WithNestedCallback;
+ {$ENDIF}
+ procedure proc_Distinct;
+ procedure proc_Distinct_WithComparer;
+ procedure proc_Intersect;
+ procedure proc_Intersect_WithComparer;
+ procedure proc_Union;
+ procedure proc_Union_WithComparer;
+ procedure proc_Without;
+ procedure proc_Without_WithComparer;
+ procedure proc_Select_WithSelector;
+ procedure proc_Select_WithNormalCallback;
+ procedure proc_Select_WithObjectCallback;
+ {$IFDEF UTL_NESTED_PROCVARS}
+ procedure proc_Select_WithNestedCallback;
+ {$ENDIF}
+ procedure proc_SelectMany_WithSelector;
+ procedure proc_SelectMany_WithNormalCallback;
+ procedure proc_SelectMany_WithObjectCallback;
+ {$IFDEF UTL_NESTED_PROCVARS}
+ procedure proc_SelectMany_WithNestedCallback;
+ {$ENDIF}
+ procedure proc_Zip;
+ {$ENDIF}
+ end;
+{$ENDIF}
+
+implementation
+
+{$IFDEF UTL_ENUMERATORS}
+uses
+ uutlEnumerator, uutlComparer, uutlFilter, uutlTypes, uutlInterfaces;
+
+type
+ TIntArrEnumerator = specialize TutlArrayEnumerator;
+ TStringArrEnumerator = specialize TutlArrayEnumerator;
+
+ TCallbackObject = class(TInterfacedObject,
+ specialize IutlFilter,
+ specialize IutlSelector)
+ public
+ function Filter(constref i: Integer): Boolean;
+ function Select(constref i: Integer): Single;
+ end;
+
+ TSelectManyObject = class(TInterfacedObject,
+ specialize IutlSelector>)
+ public
+ function Select(constref i: Integer): specialize IutlEnumerator;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TestFilter(constref i: Integer): Boolean;
+begin
+ result := (i mod 2) = 0;
+end;
+
+function TestSelector(constref i: Integer): Single;
+begin
+ result := i / 2.0;
+end;
+
+function TestManySelector(constref i: Integer): specialize IutlEnumerator;
+var
+ data: array of Single;
+begin
+ SetLength(data, 3);
+ data[0] := 10 * i + 1.5;
+ data[1] := 10 * i + 5.0;
+ data[2] := 10 * i + 7.5;
+ result := specialize TutlArrayEnumerator.Create(data);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TCallbackObject.Filter(constref i: Integer): Boolean;
+begin
+ result := TestFilter(i);
+end;
+
+function TCallbackObject.Select(constref i: Integer): Single;
+begin
+ result := TestSelector(i);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TSelectManyObject.Select(constref i: Integer): specialize IutlEnumerator;
+begin
+ result := TestManySelector(i);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function CreateArrayEnumerator(const aSize: Integer; const aStartIndex: Integer = 1): TIntArrEnumerator.IEnumerator;
+var
+ arr: array of Integer;
+ i: Integer;
+begin
+ SetLength(arr, aSize);
+ for i := low(arr) to high(arr) do
+ arr[i] := aStartIndex + i;
+ result := TIntArrEnumerator.Create(arr);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function CreateArrayEnumerator(const aData: array of Integer): TIntArrEnumerator.IEnumerator;
+var
+ arr: array of Integer;
+ i: Integer;
+begin
+ SetLength(arr, Length(aData));
+ for i := low(arr) to high(arr) do
+ arr[i] := aData[i];
+ result := TIntArrEnumerator.Create(arr);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function CreateStringEnumerator(const aData: array of String): TStringArrEnumerator.IEnumerator;
+var
+ arr: array of String;
+ i: Integer;
+begin
+ SetLength(arr, Length(aData));
+ for i := low(arr) to high(arr) do
+ arr[i] := aData[i];
+ result := TStringArrEnumerator.Create(arr);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlLinqTests/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Count;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := CreateArrayEnumerator(10);
+ AssertEquals(10, specialize utlCount(e));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Any;
+begin
+ AssertFalse(specialize utlAny(CreateArrayEnumerator(0)));
+ AssertTrue (specialize utlAny(CreateArrayEnumerator(1)));
+ AssertTrue (specialize utlAny(CreateArrayEnumerator(2)));
+ AssertTrue (specialize utlAny(CreateArrayEnumerator(9)));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Contains;
+begin
+ AssertFalse(specialize utlContains(CreateArrayEnumerator(10), 11));
+ AssertFalse(specialize utlContains(CreateArrayEnumerator(10), -1));
+ AssertTrue (specialize utlContains(CreateArrayEnumerator(10), 4));
+ AssertTrue (specialize utlContains(CreateArrayEnumerator(10), 6));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Contains_WithComparer;
+begin
+ AssertFalse(specialize utlContains(CreateArrayEnumerator(10), 11, specialize TutlEqualityComparer.Create));
+ AssertFalse(specialize utlContains(CreateArrayEnumerator(10), -1, specialize TutlEqualityComparer.Create));
+ AssertTrue (specialize utlContains(CreateArrayEnumerator(10), 4, specialize TutlEqualityComparer.Create));
+ AssertTrue (specialize utlContains(CreateArrayEnumerator(10), 6, specialize TutlEqualityComparer.Create));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_ToArray;
+var
+ arr: array of Integer;
+begin
+ arr := specialize utlToArray(CreateArrayEnumerator(5));
+ AssertEquals(5, Length(arr));
+ AssertEquals(1, arr[0]);
+ AssertEquals(2, arr[1]);
+ AssertEquals(3, arr[2]);
+ AssertEquals(4, arr[3]);
+ AssertEquals(5, arr[4]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Reverse;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlReverse(CreateArrayEnumerator(5));
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Skip;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlSkip(CreateArrayEnumerator(5), 2);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Take;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlTake(CreateArrayEnumerator(5), 3);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Concat;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlConcat(
+ CreateArrayEnumerator(2, 1),
+ CreateArrayEnumerator(2, 3));
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Concat_WithArray;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlConcat(
+ specialize TutlArray>.Create(
+ CreateArrayEnumerator(2, 1),
+ CreateArrayEnumerator(2, 3),
+ CreateArrayEnumerator(2, 5)));
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IFDEF UTL_ADVANCED_ENUMERATORS}
+procedure TutlLinqTests.proc_Sort;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlSort(CreateArrayEnumerator([1, 5, 3, 6, 7, 9, 2]));
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(7, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(9, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Sort_WithComparer;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlSort(CreateArrayEnumerator([1, 5, 3, 6, 7, 9, 2]), specialize TutlComparer.Create);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(7, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(9, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Where_WithFilter;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlWhere(CreateArrayEnumerator(5), TCallbackObject.Create);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Where_WithNormalCallback;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlWhere(CreateArrayEnumerator(5), @TestFilter);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Where_WithObjectCallback;
+var
+ e: TIntArrEnumerator.IEnumerator;
+ o: TCallbackObject;
+begin
+ o := TCallbackObject.Create;
+ try
+ e := specialize utlWhereO(CreateArrayEnumerator(5), @o.Filter);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertFalse (e.MoveNext);
+ finally
+ FreeAndNil(o);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IFDEF UTL_NESTED_PROCVARS}
+procedure TutlLinqTests.proc_Where_WithNestedCallback;
+
+ function IsEventNested(constref i: Integer): Boolean;
+ begin
+ result := (i mod 2) = 0;
+ end;
+
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlWhereN(CreateArrayEnumerator(5), @IsEventNested);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Distinct;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlDistinct(CreateArrayEnumerator([1, 4, 3, 6, 1, 3, 4, 7 ]));
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(7, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Distinct_WithComparer;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlDistinct(CreateArrayEnumerator([1, 4, 3, 6, 1, 3, 4, 7 ]), specialize TutlComparer.Create);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(7, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Intersect;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlIntersect(
+ CreateArrayEnumerator([ 1, 2, 3, 4, 5, 6, 7 ]),
+ CreateArrayEnumerator([ 3, 5, 4, 3 ]));
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Intersect_WithComparer;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlIntersect(
+ CreateArrayEnumerator([ 1, 2, 3, 4, 5, 6, 7 ]),
+ CreateArrayEnumerator([ 3, 5, 4, 3 ]),
+ specialize TutlComparer.Create);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Union;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlUnion(
+ CreateArrayEnumerator([ 2, 4, 5, 7 ]),
+ CreateArrayEnumerator([ 3, 5, 4, 3, 8 ]));
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(7, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(8, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Union_WithComparer;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlUnion(
+ CreateArrayEnumerator([ 2, 4, 5, 7 ]),
+ CreateArrayEnumerator([ 3, 5, 4, 3, 8 ]),
+ specialize TutlComparer.Create);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(7, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(3, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(8, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Without;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlWithout(
+ CreateArrayEnumerator([ 1, 2, 3, 4, 5, 6, 7 ]),
+ CreateArrayEnumerator([ 3, 5, 4, 3 ]),
+ specialize TutlComparer.Create);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(7, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Without_WithComparer;
+var
+ e: TIntArrEnumerator.IEnumerator;
+begin
+ e := specialize utlWithout(
+ CreateArrayEnumerator([ 1, 2, 3, 4, 5, 6, 7 ]),
+ CreateArrayEnumerator([ 3, 5, 4, 3 ]));
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(7, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Select_WithSelector;
+var
+ e: specialize IutlEnumerator;
+begin
+ e := specialize utlSelect(
+ CreateArrayEnumerator(4),
+ TCallbackObject.Create);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(0.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(1.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(1.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2.0, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Select_WithNormalCallback;
+var
+ e: specialize IutlEnumerator;
+begin
+ e := specialize utlSelect(
+ CreateArrayEnumerator(4),
+ @TestSelector);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(0.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(1.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(1.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2.0, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Select_WithObjectCallback;
+var
+ o: TCallbackObject;
+ e: specialize IutlEnumerator;
+begin
+ o := TCallbackObject.Create;
+ try
+ e := specialize utlSelectO(
+ CreateArrayEnumerator(4),
+ @o.Select);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(0.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(1.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(1.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2.0, e.Current);
+ AssertFalse (e.MoveNext);
+ finally
+ FreeAndNil(o);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IFDEF UTL_NESTED_PROCVARS}
+procedure TutlLinqTests.proc_Select_WithNestedCallback;
+
+ function TestSelectorNested(constref i: Integer): Single;
+ begin
+ result := i / 2.0;
+ end;
+
+var
+ e: specialize IutlEnumerator;
+begin
+ e := specialize utlSelectN(
+ CreateArrayEnumerator(4),
+ @TestSelectorNested);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(0.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(1.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(1.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(2.0, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_SelectMany_WithSelector;
+var
+ e: specialize IutlEnumerator;
+begin
+ e := specialize utlSelectMany(
+ CreateArrayEnumerator(3),
+ TSelectManyObject.Create);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(11.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(15.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(17.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(21.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(25.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(27.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(31.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(35.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(37.5, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_SelectMany_WithNormalCallback;
+var
+ e: specialize IutlEnumerator;
+begin
+ e := specialize utlSelectMany(
+ CreateArrayEnumerator(3),
+ @TestManySelector);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(11.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(15.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(17.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(21.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(25.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(27.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(31.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(35.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(37.5, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_SelectMany_WithObjectCallback;
+var
+ o: TSelectManyObject;
+ e: specialize IutlEnumerator;
+begin
+ o := TSelectManyObject.Create;
+ try
+ e := specialize utlSelectManyO(
+ CreateArrayEnumerator(3),
+ @o.Select);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(11.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(15.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(17.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(21.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(25.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(27.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(31.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(35.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(37.5, e.Current);
+ AssertFalse (e.MoveNext);
+ finally
+ FreeAndNil(o);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IFDEF UTL_NESTED_PROCVARS}
+procedure TutlLinqTests.proc_SelectMany_WithNestedCallback;
+
+ function TestManySelectorNested(constref i: Integer): specialize IutlEnumerator;
+ begin
+ result := TestManySelector(i);
+ end;
+
+var
+ e: specialize IutlEnumerator;
+begin
+ e := specialize utlSelectManyN(
+ CreateArrayEnumerator(3),
+ @TestManySelectorNested);
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(11.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(15.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(17.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(21.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(25.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(27.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(31.5, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(35.0, e.Current);
+ AssertTrue (e.MoveNext);
+ AssertEquals(37.5, e.Current);
+ AssertFalse (e.MoveNext);
+end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlLinqTests.proc_Zip;
+var
+ e: specialize IutlEnumerator>;
+begin
+ e := specialize utlZip(
+ CreateArrayEnumerator([ 1, 4, 6, 9 ]),
+ CreateStringEnumerator([ 'fuu', 'bar', 'baz' ]));
+ e.Reset;
+ AssertTrue (e.MoveNext);
+ AssertEquals(1, e.Current.First);
+ AssertEquals('fuu', e.Current.Second);
+ AssertTrue (e.MoveNext);
+ AssertEquals(4, e.Current.First);
+ AssertEquals('bar', e.Current.Second);
+ AssertTrue (e.MoveNext);
+ AssertEquals(6, e.Current.First);
+ AssertEquals('baz', e.Current.Second);
+ AssertFalse (e.MoveNext);
+end;
+{$ENDIF}
+
+initialization
+ RegisterTest(TutlLinqTests.Suite);
+{$ENDIF}
+
+end.
+
diff --git a/tests/uutlMapTests.pas b/tests/uutlMapTests.pas
index 60478b1..9631fc2 100644
--- a/tests/uutlMapTests.pas
+++ b/tests/uutlMapTests.pas
@@ -49,9 +49,6 @@ type
implementation
-uses
- uutlExceptions;
-
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMapTests//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -221,7 +218,7 @@ end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_AutoCreate;
begin
- AssertException('autocreate false does not throw exception', EutlInvalidOperation, @AssignNonExistsingItem);
+ AssertException('autocreate false does not throw exception', EInvalidOperation, @AssignNonExistsingItem);
fIntMap.AutoCreate := true;
AssignNonExistsingItem;
end;
diff --git a/tests/uutlObservableListTests.pas b/tests/uutlObservableListTests.pas
new file mode 100644
index 0000000..d64d025
--- /dev/null
+++ b/tests/uutlObservableListTests.pas
@@ -0,0 +1,140 @@
+unit uutlObservableListTests;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, TestFramework,
+ uutlGenerics, uutlObservable, uutlEvent;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TObservableIntList = specialize TutlObservableList;
+ TEventArgList = specialize TutlList;
+ TutlObservableListTests = class(TTestCase)
+ private
+ fCaptureEvents: Boolean;
+ fList: TObservableIntList;
+ fEventArgs: TEventArgList;
+
+ procedure EventHandler(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+
+ public
+ procedure SetUp; override;
+ procedure TearDown; override;
+
+ published
+ procedure Add;
+ procedure Delete;
+ procedure ReplaceItem;
+ procedure Clear;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlObservableListTests///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlObservableListTests.EventHandler(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+begin
+ if fCaptureEvents then
+ fEventArgs.Add(aEventArgs);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlObservableListTests.SetUp;
+begin
+ inherited SetUp;
+ fCaptureEvents := false;
+ fEventArgs := TEventArgList.Create(true);
+ fList := TObservableIntList.Create(true);
+ fList.RegisterEventHandler(@EventHandler);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlObservableListTests.TearDown;
+begin
+ FreeAndNil(fList);
+ FreeAndNil(fEventArgs);
+ inherited TearDown;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlObservableListTests.Add;
+var
+ ea: TObservableIntList.TItemEventArgs;
+begin
+ fCaptureEvents := true;
+ fList.Add(5);
+
+ AssertEquals(1, fEventArgs.Count);
+ AssertTrue (Supports(fEventArgs[0], TObservableIntList.TItemEventArgs, ea));
+ AssertTrue (oetAdd = ea.EventType);
+ AssertEquals(0, ea.Index);
+ AssertEquals(5, ea.Item);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlObservableListTests.Delete;
+var
+ ea: TObservableIntList.TItemEventArgs;
+begin
+ fList.Add(5);
+ fList.Add(10);
+ fList.Add(15);
+
+ fCaptureEvents := true;
+
+ fList.Delete(1);
+
+ AssertEquals(1, fEventArgs.Count);
+ AssertTrue (Supports(fEventArgs[0], TObservableIntList.TItemEventArgs, ea));
+ AssertTrue (oetRemove = ea.EventType);
+ AssertEquals(1, ea.Index);
+ AssertEquals(10, ea.Item);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlObservableListTests.ReplaceItem;
+var
+ ea: TObservableIntList.TReplaceEventArgs;
+begin
+ fList.Add(5);
+ fList.Add(10);
+ fList.Add(15);
+
+ fCaptureEvents := true;
+
+ fList[1] := 99;
+
+ AssertEquals(1, fEventArgs.Count);
+ AssertTrue (Supports(fEventArgs[0], TObservableIntList.TReplaceEventArgs, ea));
+ AssertTrue (oetReplace = ea.EventType);
+ AssertEquals(1, ea.Index);
+ AssertEquals(10, ea.OldItem);
+ AssertEquals(99, ea.NewItem);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlObservableListTests.Clear;
+var
+ ea: TutlObservableEventArgs;
+begin
+ fList.Add(5);
+ fList.Add(10);
+ fList.Add(15);
+
+ fCaptureEvents := true;
+
+ fList.Clear;
+
+ AssertEquals(1, fEventArgs.Count);
+ AssertTrue (Supports(fEventArgs[0], TutlObservableEventArgs, ea));
+ AssertTrue (oetClear = ea.EventType);
+end;
+
+initialization
+ RegisterTest(TutlObservableListTests.Suite);
+end.
+
diff --git a/uutlAlgorithm.pas b/uutlAlgorithm.pas
index 47144bb..6000981 100644
--- a/uutlAlgorithm.pas
+++ b/uutlAlgorithm.pas
@@ -12,8 +12,9 @@ type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlBinarySearch = class
public type
- IReadOnlyArray = specialize IutlReadOnlyArray;
- IComparer = specialize IutlComparer;
+ IReadOnlyArray = specialize IutlReadOnlyArray;
+ IComparer = specialize IutlComparer;
+ PT = ^T;
private
class function DoSearch(
@@ -23,9 +24,16 @@ type
const aMax: Integer;
constref aItem: T;
out aIndex: Integer): Boolean;
+ class function DoSearch(
+ constref aArray: PT;
+ constref aComparer: IComparer;
+ const aMin: Integer;
+ const aMax: Integer;
+ constref aItem: T;
+ out aIndex: Integer): Boolean;
public
- // search aItem in aList using aComparer
+ // search aItem in aArray using aComparer
// aList needs to bee sorted
// aIndex is the index the item was found or should be inserted
// returns TRUE when found, FALSE otherwise
@@ -33,7 +41,18 @@ type
constref aArray: IReadOnlyArray;
constref aComparer: IComparer;
constref aItem: T;
- out aIndex: Integer): Boolean;
+ out aIndex: Integer): Boolean; overload;
+
+ // search aItem in aList using aComparer
+ // aList needs to bee sorted
+ // aIndex is the index the item was found or should be inserted
+ // returns TRUE when found, FALSE otherwise
+ class function Search(
+ const aArray;
+ const aCount: Integer;
+ constref aComparer: IComparer;
+ constref aItem: T;
+ out aIndex: Integer): Boolean; overload;
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -41,18 +60,29 @@ type
public type
IArray = specialize IutlArray;
IComparer = specialize IutlComparer;
+ PT = ^T;
private
class procedure DoSort(
constref aArray: IArray;
constref aComparer: IComparer;
aLow: Integer;
- aHigh: Integer);
+ aHigh: Integer); overload;
+
+ class procedure DoSort(
+ constref aArray: PT;
+ constref aComparer: IComparer;
+ aLow: Integer;
+ aHigh: Integer); overload;
public
class procedure Sort(
constref aArray: IArray;
- constref aComparer: IComparer);
+ constref aComparer: IComparer); overload;
+ class procedure Sort(
+ var aArray: T;
+ constref aCount: Integer;
+ constref aComparer: IComparer); overload;
end;
implementation
@@ -86,6 +116,33 @@ begin
end;
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class function TutlBinarySearch.DoSearch(
+ constref aArray: PT;
+ 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, aArray[i]);
+ if (cmp = 0) then begin
+ result := true;
+ aIndex := i;
+ end else if (cmp < 0) then
+ result := DoSearch(aArray, aComparer, aMin, i-1, aItem, aIndex)
+ else if (cmp > 0) then
+ result := DoSearch(aArray, aComparer, i+1, aMax, aItem, aIndex);
+ end else begin
+ result := false;
+ aIndex := aMin;
+ end;
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlBinarySearch.Search(
constref aArray: IReadOnlyArray;
@@ -93,9 +150,24 @@ class function TutlBinarySearch.Search(
constref aItem: T;
out aIndex: Integer): Boolean;
begin
+ if not Assigned(aComparer) then
+ raise EArgumentNilException.Create('aComparer');
result := DoSearch(aArray, aComparer, 0, aArray.Count-1, aItem, aIndex);
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class function TutlBinarySearch.Search(
+ const aArray;
+ const aCount: Integer;
+ constref aComparer: IComparer;
+ constref aItem: T;
+ out aIndex: Integer): Boolean;
+begin
+ if not Assigned(aComparer) then
+ raise EArgumentNilException.Create('aComparer');
+ result := DoSearch(@aArray, aComparer, 0, aCount-1, aItem, aIndex);
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlQuickSort/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -138,13 +210,69 @@ begin
until (aLow >= aHigh);
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class procedure TutlQuickSort.DoSort(
+ constref aArray: PT;
+ constref aComparer: IComparer;
+ aLow: Integer;
+ aHigh: Integer);
+var
+ lo, hi: Integer;
+ p, tmp: T;
+begin
+ if not Assigned(aArray) then
+ raise EArgumentNilException.Create('aArray');
+
+ repeat
+ lo := aLow;
+ hi := aHigh;
+ p := aArray[(aLow + aHigh) div 2];
+ repeat
+ while (aComparer.Compare(p, aArray[lo]) > 0) do
+ lo := lo + 1;
+ while (aComparer.Compare(p, aArray[hi]) < 0) do
+ hi := hi - 1;
+ if (lo <= hi) then begin
+ tmp := aArray[lo];
+ aArray[lo] := aArray[hi];
+ aArray[hi] := tmp;
+ lo := lo + 1;
+ hi := hi - 1;
+ end;
+ until (lo > hi);
+
+ if (hi - aLow < aHigh - lo) then begin
+ if (aLow < hi) then
+ DoSort(aArray, aComparer, aLow, hi);
+ aLow := lo;
+ end else begin
+ if (lo < aHigh) then
+ DoSort(aArray, aComparer, lo, aHigh);
+ aHigh := hi;
+ end;
+ until (aLow >= aHigh);
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlQuickSort.Sort(
constref aArray: IArray;
constref aComparer: IComparer);
begin
+ if not Assigned(aComparer) then
+ raise EArgumentNilException.Create('aComparer');
DoSort(aArray, aComparer, 0, aArray.GetCount-1);
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class procedure TutlQuickSort.Sort(
+ var aArray: T;
+ constref aCount: Integer;
+ constref aComparer: IComparer);
+begin
+ if not Assigned(aComparer) then
+ raise EArgumentNilException.Create('aComparer');
+ DoSort(@aArray, aComparer, 0, aCount-1);
+end;
+
end.
diff --git a/uutlArrayContainer.pas b/uutlArrayContainer.pas
index abe357f..10c91a5 100644
--- a/uutlArrayContainer.pas
+++ b/uutlArrayContainer.pas
@@ -49,9 +49,6 @@ type
implementation
-uses
- uutlExceptions;
-
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlArrayContainer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -64,7 +61,7 @@ end;
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);
+ raise EOutOfRangeException.Create('capacity out of range', aIndex, 0, fCapacity-1);
result := fList + aIndex;
end;
@@ -74,7 +71,7 @@ begin
if (fCapacity = aValue) then
exit;
if (aValue < Count) then
- raise EutlArgument.Create('can not reduce capacity below count', 'Capacity');
+ raise EArgumentException.Create('can not reduce capacity below count');
ReAllocMem(fList, aValue * SizeOf(T));
FillByte((fList + fCapacity)^, (aValue - fCapacity) * SizeOf(T), 0);
fCapacity := aValue;
@@ -91,7 +88,7 @@ end;
procedure TutlArrayContainer.Shrink(const aExactFit: Boolean);
begin
if not fCanShrink then
- raise EutlInvalidOperation.Create('shrinking is not allowed');
+ raise EInvalidOperation.Create('shrinking is not allowed');
if (aExactFit) then
SetCapacity(Count)
else if (fCapacity > 128) and (Count < fCapacity shr 2) then // less than 25% used
@@ -104,7 +101,7 @@ begin
if (Count < fCapacity) then
exit;
if not fCanExpand then
- raise EutlInvalidOperation.Create('expanding is not allowed');
+ raise EInvalidOperation.Create('expanding is not allowed');
if (fCapacity <= 0) then
SetCapacity(4)
else if (fCapacity < 128) then
diff --git a/uutlCommon.pas b/uutlCommon.pas
index fa877cf..18c2d34 100644
--- a/uutlCommon.pas
+++ b/uutlCommon.pas
@@ -5,7 +5,8 @@ unit uutlCommon;
interface
uses
- Classes, SysUtils, typinfo;
+ Classes, SysUtils, versionresource, versiontypes, typinfo
+ {$IFDEF UNIX}, unixtype, pthreads {$ENDIF};
type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -15,20 +16,182 @@ type
{ 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;
+ 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;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure utlFinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
+ 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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ 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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ EOutOfRangeException = class(Exception)
+ private
+ fMin: Integer;
+ fMax: Integer;
+ fIndex: Integer;
+
+ public
+ property Min: Integer read fMin;
+ property Max: Integer read fMax;
+ property Index: Integer read fIndex;
+
+ constructor Create(const aIndex, aMin, aMax: Integer);
+ constructor Create(const aMsg: String; const aIndex, aMin, aMax: Integer);
+ 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;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function Supports (const aInstance: TObject; const aClass: TClass; out aObj): Boolean;
+function GetTickCount64 (): QWord;
+function GetMicroTime (): QWord;
+
+function utlRateLimited (const Reference: QWord; const Interval: QWord): boolean;
+procedure utlFinalizeObject (var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
+function utlFilterBuilder (): IutlFilterBuilder;
implementation
+uses
+ {$IFDEF WINDOWS}
+ Windows,
+ {$ELSE}
+ Unix, BaseUnix,
+ {$ENDIF}
+ uutlGenerics;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+type
+ TFilterBuilderImpl = class(
+ TInterfacedObject,
+ IutlFilterBuilder)
+ private type
+ TFilterEntry = class
+ Descr,
+ Filter: String;
+ end;
+ TFilterList = specialize TutlList;
+
+ private
+ fFilters: TFilterList;
+
+ public
+ function Add (aDescr, aMask: string; const aAppendFilterToDesc: boolean): IutlFilterBuilder;
+ function AddFilter(aFilter: string): IutlFilterBuilder;
+ function Compose (const aIncludeAllSupported: String = ''; const aIncludeAllFiles: String = ''): string;
+
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Helper Methods////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function Supports(const aInstance: TObject; const aClass: TClass; out aObj): Boolean;
+begin
+ result := Assigned(aInstance) and aInstance.InheritsFrom(aClass);
+ if result
+ then TObject(aObj) := aInstance
+ else TObject(aObj) := nil;
+end;
+
+{$IF DEFINED(WINDOWS)}
+var
+ PERF_FREQ: Int64;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function GetTickCount64: QWord;
+begin
+ // GetTickCount64 is better, but we need to check the Windows version to use it
+ Result := Windows.GetTickCount();
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function GetMicroTime: QWord;
+var
+ pc: Int64;
+begin
+ pc := 0;
+ QueryPerformanceCounter(pc);
+ Result:= (pc * 1000*1000) div PERF_FREQ;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$ELSEIF DEFINED(UNIX)}
+function GetTickCount64: QWord;
+var
+ tp: TTimeVal;
+begin
+ fpgettimeofday(@tp, nil);
+ Result := (Int64(tp.tv_sec) * 1000) + (tp.tv_usec div 1000);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function GetMicroTime: QWord;
+var
+ tp: TTimeVal;
+begin
+ fpgettimeofday(@tp, nil);
+ Result := (Int64(tp.tv_sec) * 1000*1000) + tp.tv_usec;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$ELSE}
+function GetTickCount64: QWord;
+begin
+ Result := Trunc(Now * 24 * 60 * 60 * 1000);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function GetMicroTime: QWord;
+begin
+ Result := Trunc(Now * 24 * 60 * 60 * 1000*1000);
+end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function utlRateLimited(const Reference: QWord; const Interval: QWord): boolean;
+begin
+ Result := GetMicroTime - Reference > Interval;
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure utlFinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
var
@@ -62,6 +225,12 @@ begin
end;
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function utlFilterBuilder: IutlFilterBuilder;
+begin
+ result := TFilterBuilderImpl.Create;
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlInterfaceNoRefCount///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -85,5 +254,235 @@ 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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//EOutOfRange///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor EOutOfRangeException.Create(const aIndex, aMin, aMax: Integer);
+begin
+ Create('', aIndex, aMin, aMax);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor EOutOfRangeException.Create(const aMsg: String; const aIndex, aMin, aMax: Integer);
+var
+ s: String;
+begin
+ fIndex := aIndex;
+ fMin := aMin;
+ fMax := aMax;
+ s := Format('index (%d) out of range (%d:%d)', [fIndex, fMin, fMax]);
+ if (aMsg <> '') then
+ s := s + ': ' + aMsg;
+ inherited Create(s);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlFilterBuilder///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TFilterBuilderImpl.Create;
+begin
+ inherited Create;
+ fFilters:= TFilterList.Create(true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TFilterBuilderImpl.Destroy;
+begin
+ FreeAndNil(fFilters);
+ inherited Destroy;
+end;
+
+initialization
+{$IF DEFINED(WINDOWS)}
+ PERF_FREQ := 0;
+ QueryPerformanceFrequency(PERF_FREQ);
+{$ENDIF}
+
end.
diff --git a/uutlComparer.pas b/uutlComparer.pas
index 1c149a5..7c615f9 100644
--- a/uutlComparer.pas
+++ b/uutlComparer.pas
@@ -1,7 +1,9 @@
unit uutlComparer;
{$mode objfpc}{$H+}
-{$modeswitch nestedprocvars}
+{$IFDEF UTL_NESTED_PROCVARS}
+ {$modeswitch nestedprocvars}
+{$ENDIF}
interface
@@ -22,7 +24,9 @@ type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlEqualityCompareEvent = function(constref i1, i2: T): Boolean;
generic TutlEqualityCompareEventO = function(constref i1, i2: T): Boolean of object;
+ {$IFDEF UTL_NESTED_PROCVARS}
generic TutlEqualityCompareEventN = function(constref i1, i2: T): Boolean is nested;
+ {$ENDIF}
generic TutlCalbackEqualityComparer = class(
TInterfacedObject,
@@ -34,21 +38,26 @@ type
public type
TCompareEvent = specialize TutlEqualityCompareEvent;
TCompareEventO = specialize TutlEqualityCompareEventO;
+ {$IFDEF UTL_NESTED_PROCVARS}
TCompareEventN = specialize TutlEqualityCompareEventN;
+ {$ENDIF}
strict private
fType: TEqualityCompareEventType;
fEvent: TCompareEvent;
fEventO: TCompareEventO;
+ {$IFDEF UTL_NESTED_PROCVARS}
fEventN: TCompareEventN;
+ {$ENDIF}
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); overload;
constructor Create(const aEvent: TCompareEventO); overload;
+ {$IFDEF UTL_NESTED_PROCVARS}
constructor Create(const aEvent: TCompareEventN); overload;
+ {$ENDIF}
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -64,7 +73,9 @@ type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlCompareEvent = function(constref i1, i2: T): Integer;
generic TutlCompareEventO = function(constref i1, i2: T): Integer of object;
+ {$IFDEF UTL_NESTED_PROCVARS}
generic TutlCompareEventN = function(constref i1, i2: T): Integer is nested;
+ {$ENDIF}
generic TutlCallbackComparer = class(
TInterfacedObject,
@@ -77,22 +88,27 @@ type
public type
TCompareEvent = specialize TutlCompareEvent;
TCompareEventO = specialize TutlCompareEventO;
+ {$IFDEF UTL_NESTED_PROCVARS}
TCompareEventN = specialize TutlCompareEventN;
+ {$ENDIF}
strict private
fType: TCompareEventType;
fEvent: TCompareEvent;
fEventO: TCompareEventO;
+ {$IFDEF UTL_NESTED_PROCVARS}
fEventN: TCompareEventN;
+ {$ENDIF}
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); overload;
constructor Create(const aEvent: TCompareEventO); overload;
+ {$IFDEF UTL_NESTED_PROCVARS}
constructor Create(const aEvent: TCompareEventN); overload;
+ {$ENDIF}
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -132,7 +148,9 @@ begin
case fType of
eetNormal: result := fEvent (i1, i2);
eetObject: result := fEventO(i1, i2);
+ {$IFDEF UTL_NESTED_PROCVARS}
eetNested: result := fEventN(i1, i2);
+ {$ENDIF}
else
raise Exception.Create('invalid or unknown callback type');
end;
@@ -155,12 +173,14 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IFDEF UTL_NESTED_PROCVARS}
constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEventN);
begin
inherited Create;
fType := eetNested;
fEventN := aEvent;
end;
+{$ENDIF}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -184,7 +204,9 @@ begin
case fType of
cetNormal: result := fEvent (i1, i2);
cetObject: result := fEventO(i1, i2);
+ {$IFDEF UTL_NESTED_PROCVARS}
cetNested: result := fEventN(i1, i2);
+ {$ENDIF}
else
raise Exception.Create('invalid or unknown callback type');
end;
@@ -213,12 +235,14 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IFDEF UTL_NESTED_PROCVARS}
constructor TutlCallbackComparer.Create(const aEvent: TCompareEventN);
begin
inherited Create;
fType := cetNested;
fEventN := aEvent;
end;
+{$ENDIF}
end.
diff --git a/uutlEnumerator.pas b/uutlEnumerator.pas
index 70133f2..0eaa0c0 100644
--- a/uutlEnumerator.pas
+++ b/uutlEnumerator.pas
@@ -6,35 +6,56 @@ interface
uses
Classes, SysUtils,
- uutlInterfaces;
+ uutlInterfaces, uutlTypes
+ {$IFDEF UTL_ADVANCED_ENUMERATORS}
+ , uutlAlgorithm
+ {$ENDIF};
type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlEnumerator = class(
- TInterfacedObject,
- specialize IutlEnumerator)
+ TInterfacedObject
+ , specialize IEnumerator
+ {$IFDEF UTL_ENUMERATORS}, specialize IutlEnumerator{$ENDIF})
public type
- IEnumerator = specialize IutlEnumerator;
- IFilter = specialize IutlFilter;
- TArray = specialize TGenericArray;
+ {$IFDEF UTL_ENUMERATORS}
+ TArray = specialize TutlArray;
+ IEnumerator = specialize IutlEnumerator;
+ IEqualityComparer = specialize IutlEqualityComparer;
+ {$IFDEF UTL_ADVANCED_ENUMERATORS}
+ IComparer = specialize IutlComparer;
+ IFilter = specialize IutlFilter;
+ {$ENDIF}
+ {$ENDIF}
public { IEnumerator }
function GetCurrent: T; virtual; abstract;
function MoveNext: Boolean; virtual; abstract;
procedure Reset; virtual; abstract;
+ {$IFDEF UTL_ENUMERATORS}
public { IutlEnumerator }
function GetEnumerator: IEnumerator; virtual;
- function Count: Integer; virtual;
-
- function Reverse: IEnumerator; virtual;
- function Skip (const aCount: Integer): IEnumerator; virtual;
- function Take (const aCount: Integer): IEnumerator; virtual;
- function Where(const aFilter: IFilter): IEnumerator; virtual;
-
- function ToArray: TArray; virtual;
+ function Count (): Integer; virtual;
+ function Any (): Boolean; virtual;
+ function ToArray (): TArray; virtual;
+ function Contains (constref aElement: T; aComparer: IEqualityComparer): Boolean; virtual;
+
+ function Skip (aCount: Integer): IEnumerator; virtual;
+ function Take (aCount: Integer): IEnumerator; virtual;
+ function Concat (aEnumerator: IEnumerator): IEnumerator; virtual;
+ function Reverse (): IEnumerator; virtual;
+ {$IFDEF UTL_ADVANCED_ENUMERATORS}
+ function Sort (aComparer: IComparer): IEnumerator; virtual;
+ function Where (aFilter: IFilter): IEnumerator; virtual;
+ function Distinct (aComparer: IComparer): IEnumerator; virtual;
+ function Intersect(aEnumerator: IEnumerator; aComparer: IComparer): IEnumerator; virtual;
+ function Union (aEnumerator: IEnumerator; aComparer: IComparer): IEnumerator; virtual;
+ function Without (aEnumerator: IEnumerator; aComparer: IComparer): IEnumerator; virtual;
+ {$ENDIF}
+ {$ENDIF}
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -45,59 +66,144 @@ type
PT = ^T;
strict private
- fReverse: Boolean;
fMemory: PT;
+ fReverse: Boolean;
fCurrent: Integer;
- fCount: Integer;
+ fFirst: Integer;
+ fLast: Integer;
+
+ protected
+ property Memory: PT read fMemory write fMemory;
+ property Reverse: Boolean read fReverse write fReverse;
+ property First: Integer read fFirst write fFirst;
+ property Last: Integer read fLast write fLast;
public { IEnumerator }
- function GetCurrent: T; override;
- function MoveNext: Boolean; override;
+ function GetCurrent: T; override;
+ function MoveNext: Boolean; override;
procedure Reset; override;
+ {$IFDEF UTL_ADVANCED_ENUMERATORS}
public { IutlEnumerator }
- function Count: Integer; override;
- function Reverse: IEnumerator; override;
+ function Count (): Integer; override;
+ function Any (): Boolean; override;
+ function ToArray (): TArray; override;
+ {$ENDIF}
public
- constructor Create(const aMemory: PT; const aCount: Integer); overload;
- constructor Create(const aMemory: PT; const aCount: Integer; const aReverse: Boolean); overload;
+ constructor Create(
+ const aMemory: PT;
+ const aCount: Integer); overload;
+ constructor Create(
+ const aMemory: PT;
+ const aReverse: Boolean;
+ const aFirst: Integer;
+ const aLast: Integer); overload;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlArrayEnumerator = class(
+ specialize TutlMemoryEnumerator)
+
+ {$IFNDEF UTL_ENUMERATORS}
+ public type
+ TArray = specialize TutlArray;
+ {$ENDIF}
+
+ strict private
+ fData: TArray;
+
+ public { IEnumerator }
+ procedure Reset; override;
+
+ public
+ property Data: TArray read fData write fData;
+
+ constructor Create; overload;
+ constructor Create(const aData: TArray); overload;
+ constructor Create(const aData: TArray; const aReverse: Boolean); overload;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IFDEF UTL_ENUMERATORS}
+ generic TutlReverseEnumerator = class(
+ specialize TutlArrayEnumerator)
+
+ strict private
+ fEnumerator: IEnumerator;
+
+ public { IEnumerator }
+ procedure Reset; override;
+
+ public
+ constructor Create(aEnumerator: IEnumerator); reintroduce;
+ end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
+ generic TutlSortEnumerator = class(
+ specialize TutlArrayEnumerator)
+
+ strict private
+ fEnumerator: IEnumerator;
+ fComparer: IComparer;
+
+ public { IEnumerator }
+ procedure Reset; override;
+
+ public
+ constructor Create(aEnumerator: IEnumerator; aComparer: IComparer); reintroduce;
+ end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
+ generic TutlDistinctEnumerator = class(
specialize TutlEnumerator)
strict private
- fArray: TArray;
- fReverse: Boolean;
- fCurrent: Integer;
- fFirst: Integer;
- fLast: Integer;
+ fEnumerator: IEnumerator;
+ fComparer: IComparer;
+ fCurrent: T;
+ fData: array of T;
public { IEnumerator }
- function GetCurrent: T; override;
- function MoveNext: Boolean; override;
+ function GetCurrent: T; override;
+ function MoveNext: Boolean; override;
procedure Reset; override;
- public { IutlEnumerator }
- function Count: Integer; override;
+ public
+ constructor Create(aEnumerator: IEnumerator; aComparer: IComparer); reintroduce;
+ end;
+{$ENDIF}
- function Reverse: IEnumerator; override;
- function Skip(const aCount: Integer): IEnumerator; override;
- function Take(const aCount: Integer): IEnumerator; override;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
+ generic TutlIntersectWithoutEnumerator = class(
+ specialize TutlEnumerator)
- function ToArray: TArray; override;
+ strict private
+ fWithoutMode: Boolean;
+ fEnumerator: IEnumerator;
+ fOther: IEnumerator;
+ fComparer: IComparer;
+ fData: array of T;
+ fCurrent: T;
+
+ public { IEnumerator }
+ function GetCurrent: T; override;
+ function MoveNext: Boolean; override;
+ procedure Reset; override;
public
constructor Create(
- const aArray: TArray); overload;
- constructor Create(
- const aArray: TArray;
- const aReverse: Boolean;
- const aFirst: Integer;
- const aLast: Integer); overload;
+ const aWithoutMode: Boolean;
+ aEnumerator: IEnumerator;
+ aOther: IEnumerator;
+ aComparer: IComparer); reintroduce;
end;
+{$ENDIF}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlSkipTakeEnumerator = class(
@@ -111,16 +217,17 @@ type
fCurrentTake: Integer;
public { IEnumerator }
- function GetCurrent: T; override;
- function MoveNext: Boolean; override;
+ function GetCurrent: T; override;
+ function MoveNext: Boolean; override;
procedure Reset; override;
public
- constructor Create(const aEnumerator: IEnumerator; const aSkip: Integer; const aTake: Integer);
+ constructor Create(aEnumerator: IEnumerator; const aSkip: Integer; const aTake: Integer);
destructor Destroy; override;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
generic TutlWhereEnumerator = class(
specialize TutlEnumerator)
@@ -129,16 +236,18 @@ type
fFilter: IFilter;
public { IEnumerator }
- function GetCurrent: T; override;
- function MoveNext: Boolean; override;
+ function GetCurrent: T; override;
+ function MoveNext: Boolean; override;
procedure Reset; override;
public
- constructor Create(const aEnumerator: IEnumerator; const aFilter: IFilter);
+ constructor Create(aEnumerator: IEnumerator; aFilter: IFilter);
destructor Destroy; override;
end;
+{$ENDIF}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
generic TutlSelectEnumerator = class(
specialize TutlEnumerator)
@@ -151,149 +260,216 @@ type
fSelector: ISelector;
public { IEnumerator }
- function GetCurrent: Tout; override;
- function MoveNext: Boolean; override;
+ function GetCurrent: Tout; override;
+ function MoveNext: Boolean; override;
procedure Reset; override;
public
- constructor Create(const aEnumerator: IInEnumerator; const aSelector: ISelector);
+ constructor Create(aEnumerator: IInEnumerator; aSelector: ISelector);
destructor Destroy; override;
end;
+{$ENDIF}
-implementation
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
+ generic TutlSelectManyEnumerator = class(
+ specialize TutlEnumerator)
-uses
- uutlExceptions;
+ public type
+ IInEnumerator = specialize IutlEnumerator;
+ IOutEnumerator = specialize IutlEnumerator;
+ ISelector = specialize IutlSelector;
+
+ strict private
+ fEnumerator: IInEnumerator;
+ fSelector: ISelector;
+ fCurrent: IOutEnumerator;
+
+ public { IEnumerator }
+ function GetCurrent: Tout; override;
+ function MoveNext: Boolean; override;
+ procedure Reset; override;
+
+ public
+ constructor Create(aEnumerator: IInEnumerator; aSelector: ISelector);
+ destructor Destroy; override;
+ end;
+{$ENDIF}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEnumerator.GetEnumerator: IEnumerator;
-begin
- result := self;
-end;
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
+ generic TutlZipEnumerator = class(
+ specialize TutlEnumerator>)
+
+ public type
+ IEnumeratorT = specialize IutlEnumerator;
+ IEnumeratorS = specialize IutlEnumerator;
+ TPair = specialize TutlPair;
+
+ strict private
+ fEnumeratorT: IEnumeratorT;
+ fEnumeratorS: IEnumeratorS;
+
+ public { IEnumerator }
+ function GetCurrent: TPair; override;
+ function MoveNext: Boolean; override;
+ procedure Reset; override;
+
+ public
+ constructor Create(aEnumeratorT: IEnumeratorT; aEnumeratorS: IEnumeratorS);
+ destructor Destroy; override;
+ end;
+{$ENDIF}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEnumerator.Reverse: IEnumerator;
-var
- arr: TArray;
-begin
- arr := ToArray;
- result := specialize TutlArrayEnumerator.Create(arr, true, low(arr), high(arr));
-end;
+ generic TutlConcatEnumerator = class(
+ specialize TutlEnumerator)
+
+ public type
+ TEnumerators = array of IEnumerator;
+ strict private
+ fEnumerators: TEnumerators;
+ fCurrent: Integer;
+
+ public { IEnumerator }
+ function GetCurrent: T; override;
+ function MoveNext: Boolean; override;
+ procedure Reset; override;
+
+ public
+ constructor Create(aEnumerators: TEnumerators);
+ destructor Destroy; override;
+ end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEnumerator.Skip(const aCount: Integer): IEnumerator;
+{$IFDEF UTL_ENUMERATORS}
+function TutlEnumerator.GetEnumerator: IEnumerator;
begin
- result := specialize TutlSkipTakeEnumerator.Create(self, aCount, -1);
+ result := self;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEnumerator.Take(const aCount: Integer): IEnumerator;
+function TutlEnumerator.Count: Integer;
begin
- result := specialize TutlSkipTakeEnumerator.Create(self, -1, aCount);
+ result := 0;
+ Reset;
+ while MoveNext do
+ inc(result);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEnumerator.Where(const aFilter: IFilter): IEnumerator;
+function TutlEnumerator.Any: Boolean;
begin
- result := specialize TutlWhereEnumerator.Create(self, aFilter);
+ Reset;
+ result := MoveNext;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEnumerator.ToArray: TArray;
var
i: Integer;
- arr: array of T;
begin
i := 0;
- SetLength(arr, i);
+ SetLength(result, i);
Reset;
while MoveNext do begin
inc(i);
- SetLength(arr, i);
- arr[i-1] := GetCurrent;
+ SetLength(result, i);
+ result[i-1] := GetCurrent;
end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEnumerator.Count: Integer;
+function TutlEnumerator.Contains(constref aElement: T; aComparer: IEqualityComparer): Boolean;
begin
- result := 0;
Reset;
- while MoveNext do
- inc(result);
+ result := false;
+ while MoveNext and not result do
+ result := aComparer.EqualityCompare(aElement, GetCurrent);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlMemoryEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlEnumerator.Skip(aCount: Integer): IEnumerator;
+begin
+ result := specialize TutlSkipTakeEnumerator.Create(self, aCount, -1);
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMemoryEnumerator.GetCurrent: T;
-var
- p: PT;
+function TutlEnumerator.Take(aCount: Integer): IEnumerator;
begin
- if (fCurrent < 0) or (fCurrent >= fCount) then
- raise EutlInvalidOperation.Create('enumerator is not initialized');
- p := fMemory;
- if fReverse
- then inc(p, fCount - fCurrent - 1)
- else inc(p, fCurrent);
- result := p^;
+ result := specialize TutlSkipTakeEnumerator.Create(self, -1, aCount);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMemoryEnumerator.MoveNext: Boolean;
+function TutlEnumerator.Concat(aEnumerator: IEnumerator): IEnumerator;
+type
+ TConcatEnumerator = specialize TutlConcatEnumerator;
begin
- inc(fCurrent);
- result := (fCurrent < fCount);
+ result := TConcatEnumerator.Create(TConcatEnumerator.TEnumerators.Create(self, aEnumerator));
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlMemoryEnumerator.Reset;
+function TutlEnumerator.Reverse: IEnumerator;
begin
- fCurrent := -1;
+ result := specialize TutlReverseEnumerator.Create(self);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMemoryEnumerator.Count: Integer;
+{$IFDEF UTL_ADVANCED_ENUMERATORS}
+function TutlEnumerator.Sort(aComparer: IComparer): IEnumerator;
begin
- result := fCount;
+ result := specialize TutlSortEnumerator.Create(self, aComparer);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlMemoryEnumerator.Reverse: IEnumerator;
+function TutlEnumerator.Where(aFilter: IFilter): IEnumerator;
begin
- result := TutlMemoryEnumerator.Create(fMemory, fCount, not fReverse);
+ result := specialize TutlWhereEnumerator.Create(self, aFilter);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlMemoryEnumerator.Create(const aMemory: PT; const aCount: Integer);
+function TutlEnumerator.Distinct(aComparer: IComparer): IEnumerator;
begin
- Create(aMemory, aCount, false);
+ result := specialize TutlDistinctEnumerator.Create(self, aComparer);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlMemoryEnumerator.Create(const aMemory: PT; const aCount: Integer; const aReverse: Boolean);
+function TutlEnumerator.Intersect(aEnumerator: IEnumerator; aComparer: IComparer): IEnumerator;
begin
- inherited Create;
- fMemory := aMemory;
- fCount := aCount;
- fReverse := aReverse;
- fCurrent := -1;
+ result := specialize TutlIntersectWithoutEnumerator.Create(false, self, aEnumerator, aComparer);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlArrayEnumerator///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlEnumerator.Union(aEnumerator: IEnumerator; aComparer: IComparer): IEnumerator;
+begin
+ result := Concat(aEnumerator).Distinct(aComparer);
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlArrayEnumerator.GetCurrent: T;
+function TutlEnumerator.Without(aEnumerator: IEnumerator; aComparer: IComparer): IEnumerator;
begin
- if (fCurrent < fFirst) or (fCurrent > fLast) then
- raise EutlInvalidOperation.Create('enumerator is not initialized');
- result := fArray[fCurrent];
+ result := specialize TutlIntersectWithoutEnumerator.Create(true, self, aEnumerator, aComparer);
end;
+{$ENDIF}
+{$ENDIF}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlArrayEnumerator.MoveNext: Boolean;
+//TutlMemoryEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlMemoryEnumerator.{%H-}GetCurrent: T;
+begin
+ if not Assigned(fMemory) or (fCurrent < fFirst) or (fCurrent > fLast) then
+ raise EInvalidOperation.Create('enumerator is not initialized');
+ result := (fMemory + fCurrent)^;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlMemoryEnumerator.MoveNext: Boolean;
begin
if fReverse
then dec(fCurrent)
@@ -302,7 +478,7 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlArrayEnumerator.Reset;
+procedure TutlMemoryEnumerator.Reset;
begin
if fReverse
then fCurrent := fLast + 1
@@ -310,75 +486,240 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlArrayEnumerator.Count: Integer;
+{$IFDEF UTL_ADVANCED_ENUMERATORS}
+function TutlMemoryEnumerator.Count: Integer;
begin
+ Reset;
result := fLast - fFirst + 1;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlArrayEnumerator.Reverse: IEnumerator;
-begin
- result := specialize TutlArrayEnumerator.Create(fArray, not fReverse, fFirst, fLast);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlArrayEnumerator.Skip(const aCount: Integer): IEnumerator;
-begin
- if fReverse
- then result := specialize TutlArrayEnumerator.Create(fArray, fReverse, fFirst, fLast - aCount)
- else result := specialize TutlArrayEnumerator.Create(fArray, fReverse, fFirst + aCount, fLast);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlArrayEnumerator.Take(const aCount: Integer): IEnumerator;
+function TutlMemoryEnumerator.Any: Boolean;
begin
- if fReverse
- then result := specialize TutlArrayEnumerator.Create(fArray, fReverse, fLast - aCount + 1, fLast)
- else result := specialize TutlArrayEnumerator.Create(fArray, fReverse, fFirst, fFirst + aCount - 1);
+ Reset;
+ result := fFirst <= fLast;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlArrayEnumerator.ToArray: TArray;
+function TutlMemoryEnumerator.ToArray: TArray;
var
i: Integer;
begin
+ Reset;
SetLength(result, fLast - fFirst + 1);
if fReverse then begin
for i := fFirst to fLast do
- result[i-fFirst] := fArray[i];
+ result[i-fFirst] := fMemory[i];
end else
- System.Move(fArray[fFirst], result[0], Length(result));
+ System.Move(fMemory^, result[0], SizeOf(T) * Length(result));
end;
+{$ENDIF}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlArrayEnumerator.Create(const aArray: TArray);
+constructor TutlMemoryEnumerator.Create(const aMemory: PT; const aCount: Integer);
begin
- Create(aArray, false, low(aArray), high(aArray));
+ Create(aMemory, false, 0, aCount - 1)
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlArrayEnumerator.Create(
- const aArray: TArray;
+constructor TutlMemoryEnumerator.Create(
+ const aMemory: PT;
const aReverse: Boolean;
const aFirst: Integer;
const aLast: Integer);
begin
inherited Create;
- fArray := aArray;
+
+ fMemory := aMemory;
fReverse := aReverse;
fFirst := aFirst;
fLast := aLast;
- if (fFirst < low(fArray)) then
- fFirst := low(fArray);
- if (fLast > high(fArray)) then
- fLast := high(fArray);
-
if fReverse
then fCurrent := fLast + 1
else fCurrent := fFirst - 1;
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlArrayEnumerator///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlArrayEnumerator.Reset;
+begin
+ Memory := @fData[0];
+ First := low(fData);
+ Last := high(fData);
+ inherited Reset;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlArrayEnumerator.Create;
+begin
+ inherited Create(nil, false, 0, -1);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlArrayEnumerator.Create(const aData: TArray);
+begin
+ Create(aData, false);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlArrayEnumerator.Create(const aData: TArray; const aReverse: Boolean);
+begin
+ fData := aData;
+ inherited Create(@fData[0], aReverse, low(fData), high(fData));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlReverseEnumerator/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IFDEF UTL_ENUMERATORS}
+procedure TutlReverseEnumerator.Reset;
+begin
+ Data := fEnumerator.ToArray;
+ Reverse := true;
+ inherited Reset;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlReverseEnumerator.Create(aEnumerator: IEnumerator);
+begin
+ inherited Create;
+ fEnumerator := aEnumerator;
+end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlSortEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
+procedure TutlSortEnumerator.Reset;
+type
+ TBinarySearch = specialize TutlBinarySearch;
+var
+ c, i: Integer;
+ tmp: T;
+ arr: TArray;
+begin
+ c := 0;
+ SetLength(arr, c);
+ fEnumerator.Reset;
+ while fEnumerator.MoveNext do begin
+ tmp := fEnumerator.GetCurrent;
+ TBinarySearch.Search(arr[0], c, fComparer, tmp, i);
+ inc(c);
+ SetLength(arr, c);
+ Move(arr[i], arr[i+1], SizeOf(T) * (Length(arr) - i - 1));
+ FillByte(arr[i], SizeOf(T), 0);
+ arr[i] := tmp;
+ end;
+ Data := arr;
+ First := low(arr);
+ Last := high(arr);
+ inherited Reset;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlSortEnumerator.Create(aEnumerator: IEnumerator; aComparer: IComparer);
+begin
+ inherited Create;
+ fEnumerator := aEnumerator;
+ fComparer := aComparer;
+end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlDistinctEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
+function TutlDistinctEnumerator.GetCurrent: T;
+begin
+ result := fCurrent;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlDistinctEnumerator.MoveNext: Boolean;
+type
+ TBinarySearch = specialize TutlBinarySearch;
+var
+ i: Integer;
+begin
+ result := false;
+ while not result and fEnumerator.MoveNext do begin
+ fCurrent := fEnumerator.GetCurrent;
+ result := not TBinarySearch.Search(fData[0], Length(fData), fComparer, fCurrent, i);
+ if result then begin
+ SetLength(fData, Length(fData) + 1);
+ Move(fData[i], fData[i+1], SizeOf(T) * (Length(fData) - i - 1));
+ FillByte(fData[i], SizeOf(T), 0);
+ fData[i] := fCurrent;
+ end;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlDistinctEnumerator.Reset;
+begin
+ SetLength(fData, 0);
+ fEnumerator.Reset;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlDistinctEnumerator.Create(aEnumerator: IEnumerator; aComparer: IComparer);
+begin
+ inherited Create;
+ fEnumerator := aEnumerator;
+ fComparer := aComparer;
+end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlIntersectWithoutEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
+function TutlIntersectWithoutEnumerator.GetCurrent: T;
+begin
+ result := fCurrent;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlIntersectWithoutEnumerator.MoveNext: Boolean;
+type
+ TBinarySearch = specialize TutlBinarySearch;
+var
+ i: Integer;
+begin
+ result := false;
+ while not result and fEnumerator.MoveNext do begin
+ fCurrent := fEnumerator.GetCurrent;
+ result := TBinarySearch.Search(fData[0], Length(fData), fComparer, fCurrent, i);
+ if fWithoutMode then
+ result := not result;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlIntersectWithoutEnumerator.Reset;
+begin
+ fEnumerator.Reset;
+ fData := fOther.Distinct(fComparer).Sort(fComparer).ToArray();
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlIntersectWithoutEnumerator.Create(
+ const aWithoutMode: Boolean;
+ aEnumerator: IEnumerator;
+ aOther: IEnumerator;
+ aComparer: IComparer);
+begin
+ inherited Create;
+ fWithoutMode := aWithoutMode;
+ fEnumerator := aEnumerator;
+ fOther := aOther;
+ fComparer := aComparer;
+end;
+{$ENDIF}
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSkipTakeEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -410,10 +751,10 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlSkipTakeEnumerator.Create(const aEnumerator: IEnumerator; const aSkip: Integer; const aTake: Integer);
+constructor TutlSkipTakeEnumerator.Create(aEnumerator: IEnumerator; const aSkip: Integer; const aTake: Integer);
begin
if not Assigned(aEnumerator) then
- raise EutlArgumentNil.Create('aEnumerator');
+ raise EArgumentNilException.Create('aEnumerator');
inherited Create;
fEnumerator := aEnumerator;
fSkip := aSkip;
@@ -432,6 +773,7 @@ end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlWhereEnumerator///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
function TutlWhereEnumerator.GetCurrent: T;
begin
result := fEnumerator.Current;
@@ -452,12 +794,12 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlWhereEnumerator.Create(const aEnumerator: IEnumerator; const aFilter: IFilter);
+constructor TutlWhereEnumerator.Create(aEnumerator: IEnumerator; aFilter: IFilter);
begin
if not Assigned(aEnumerator) then
- raise EutlArgumentNil.Create('aEnumerator');
+ raise EArgumentNilException.Create('aEnumerator');
if not Assigned(aFilter) then
- raise EutlArgumentNil.Create('aFilter');
+ raise EArgumentNilException.Create('aFilter');
inherited Create;
fEnumerator := aEnumerator;
fFilter := aFilter;
@@ -470,10 +812,12 @@ begin
fFilter := nil;
inherited Destroy;
end;
+{$ENDIF}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSelectEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
function TutlSelectEnumerator.GetCurrent: Tout;
begin
result := fSelector.Select(fEnumerator.Current);
@@ -492,12 +836,12 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlSelectEnumerator.Create(const aEnumerator: IInEnumerator; const aSelector: ISelector);
+constructor TutlSelectEnumerator.Create(aEnumerator: IInEnumerator; aSelector: ISelector);
begin
if not Assigned(aEnumerator) then
- raise EutlArgumentNil.Create('aEnumerator');
+ raise EArgumentNilException.Create('aEnumerator');
if not Assigned(aSelector) then
- raise EutlArgumentNil.Create('aSelector');
+ raise EArgumentNilException.Create('aSelector');
inherited Create;
fEnumerator := aEnumerator;
fSelector := aSelector;
@@ -510,6 +854,152 @@ begin
fSelector := nil;
inherited Destroy;
end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlSelectManyEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
+function TutlSelectManyEnumerator.GetCurrent: Tout;
+begin
+ if not Assigned(fCurrent) then
+ raise EInvalidOperation.Create('enumerator is not initialized');
+ result := fCurrent.GetCurrent;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlSelectManyEnumerator.MoveNext: Boolean;
+begin
+ result := false;
+ while not result do begin
+ while not Assigned(fCurrent) do begin
+ if not fEnumerator.MoveNext then
+ exit;
+ fCurrent := fSelector.Select(fEnumerator.Current);
+ if Assigned(fCurrent) then
+ fCurrent.Reset;
+ end;
+ result := fCurrent.MoveNext;
+ if not result then
+ fCurrent := nil;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlSelectManyEnumerator.Reset;
+begin
+ fEnumerator.Reset;
+ fCurrent := nil;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlSelectManyEnumerator.Create(aEnumerator: IInEnumerator; aSelector: ISelector);
+begin
+ inherited Create;
+ fEnumerator := aEnumerator;
+ fSelector := aSelector;
+ fCurrent := nil;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TutlSelectManyEnumerator.Destroy;
+begin
+ fCurrent := nil;
+ fEnumerator := nil;
+ fSelector := nil;
+ inherited Destroy;
+end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+{$IF DEFINED(UTL_ENUMERATORS) AND DEFINED(UTL_ADVANCED_ENUMERATORS)}
+function TutlZipEnumerator.GetCurrent: TPair;
+begin
+ result.First := fEnumeratorT.GetCurrent;
+ result.Second := fEnumeratorS.GetCurrent;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlZipEnumerator.MoveNext: Boolean;
+begin
+ result := fEnumeratorT.MoveNext and fEnumeratorS.MoveNext;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlZipEnumerator.Reset;
+begin
+ fEnumeratorT.Reset;
+ fEnumeratorS.Reset;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlZipEnumerator.Create(aEnumeratorT: IEnumeratorT; aEnumeratorS: IEnumeratorS);
+begin
+ inherited Create;
+ fEnumeratorT := aEnumeratorT;
+ fEnumeratorS := aEnumeratorS;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TutlZipEnumerator.Destroy;
+begin
+ fEnumeratorT := nil;
+ fEnumeratorS := nil;
+ inherited Destroy;
+end;
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlConcatEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlConcatEnumerator.{%H-}GetCurrent: T;
+begin
+ if (fCurrent < low(fEnumerators)) or (fCurrent > high(fEnumerators)) then
+ raise EInvalidOperation.Create('enumerator is not initialized');
+ result := fEnumerators[fCurrent].Current;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlConcatEnumerator.MoveNext: Boolean;
+begin
+ if (fCurrent < 0) then begin
+ fCurrent := 0;
+ fEnumerators[fCurrent].Reset;
+ end;
+ result := false;
+ while not result and (fCurrent <= high(fEnumerators)) and not fEnumerators[fCurrent].MoveNext do begin
+ inc(fCurrent);
+ if (fCurrent > high(fEnumerators)) then
+ exit;
+ fEnumerators[fCurrent].Reset;
+ end;
+ result := (fCurrent <= high(fEnumerators));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlConcatEnumerator.Reset;
+begin
+ fCurrent := -1;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlConcatEnumerator.Create(aEnumerators: TEnumerators);
+begin
+ inherited Create;
+ fCurrent := -1;
+ fEnumerators := aEnumerators;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TutlConcatEnumerator.Destroy;
+var
+ i: Integer;
+begin
+ for i := low(fEnumerators) to high(fEnumerators) do
+ fEnumerators [i] := nil;
+ SetLength(fEnumerators, 0);
+ inherited Destroy;
+end;
end.
diff --git a/uutlEvent.pas b/uutlEvent.pas
index e971483..2085df0 100644
--- a/uutlEvent.pas
+++ b/uutlEvent.pas
@@ -6,92 +6,105 @@ interface
uses
Classes, SysUtils, syncobjs,
- uutlCommon, uutlGenerics;
+ uutlTypes, uutlCommon, uutlGenerics, uutlInterfaces;
type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEventType = byte;
- TutlEventTypes = set of TutlEventType;
-
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- IutlEvent = interface(IUnknown)
+ IutlEventArgs = interface(IUnknown)
['{FC7AA96D-9C2C-42AD-A680-DE55341F2B35}']
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEventList = class(specialize TutlSimpleList)
- public
- constructor Create; reintroduce;
+ IutlEventListener = interface(IUnknown)
+ ['{BC45E26B-96F7-4151-87F1-C330C8C668E5}']
+ procedure DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEvent = class(TInterfacedObject, IutlEvent)
- private
- fSender: TObject;
- fEventType: TutlEventType;
- fTimestamp: Single;
+ TutlEventHandler = procedure (constref aSender: TObject; constref aEvent: IutlEventArgs) of object;
+ TutlEventArgs = class(TInterfacedObject, IutlEventArgs);
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic IutlObservable = interface(specialize {$IFDEF UTL_ADVANCED_ENUMERATORS}IutlEnumerable{$ELSE}IEnumerable{$ENDIF})
+ ['{C54BD844-8273-4ACF-90C5-05DACF4359AF}']
+ procedure RegisterEventHandler (const aHandler: TutlEventHandler);
+ procedure UnregisterEventHandler(const aHandler: TutlEventHandler);
+ end;
- public
- property Sender: TObject read fSender;
- property EventType: TutlEventType read fEventType;
- property Timestamp: Single read fTimestamp;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ generic TutlEventList = class(specialize TutlCustomHashSet)
+ private type
+ TComparer = class(TInterfacedObject, IComparer)
+ public
+ function EqualityCompare(constref i1, i2: T): Boolean;
+ function Compare (constref i1, i2: T): Integer;
+ end;
- constructor Create(const aSender: TObject; const aEventType: TutlEventType);
+ public
+ constructor Create;
end;
+ TutlNotifyEventList = specialize TutlEventList;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- IutlEventListener = interface(IUnknown)
- ['{BC45E26B-96F7-4151-87F1-C330C8C668E5}']
- procedure DispatchEvent(aEvent: IutlEvent);
- end;
+ TutlEventListenerSet = class(
+ specialize TutlCustomHashSet
+ , IutlEventListener)
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEventListenerSet = class(specialize TutlHashSetBase)
private type
TComparer = class(TInterfacedObject, IComparer)
- function Compare(const i1, i2: IutlEventListener): Integer;
+ public
+ function EqualityCompare(constref i1, i2: IutlEventListener): Boolean;
+ function Compare (constref i1, i2: IutlEventListener): Integer;
end;
- function GetEmpty: Boolean;
- public
- property Empty: Boolean read GetEmpty;
-
- procedure DispatchEvent(aEvent: IutlEvent); virtual;
-
- function RegisterListener(const aListener: IutlEventListener): Boolean;
- function UnregisterListener(const aListener: IutlEventListener): Boolean;
+ public { IutlEventListener }
+ procedure DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);
- constructor Create;
+ public
+ constructor Create; reintroduce;
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEventListenerCallback = class(TInterfacedObject, IutlEventListener)
- public type
- TCallback = procedure(aEvent: IutlEvent) of object;
+ TutlEventListenerCallback = class(
+ TInterfacedObject
+ , IutlEventListener)
+
private
- fCallback: TCallback;
- private { IEventListener }
- procedure DispatchEvent(aEvent: IutlEvent);
+ fHandler: TutlEventHandler;
+
+ public { IEventListener }
+ procedure DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);
+
public
- constructor Create(const aCallback: TCallback);
+ constructor Create(const aHandler: TutlEventHandler);
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEventListenerAsync = class(TutlInterfaceNoRefCount, IutlEventListener)
+ TutlEventListenerAsync = class(
+ TutlInterfaceNoRefCount
+ , IutlEventListener)
+
+ private type
+ TEventPair = specialize TutlPair;
+ TEventList = class(specialize TutlSimpleList)
+ protected
+ procedure Release(var aItem: TEventPair; const aFreeItem: Boolean); override;
+ end;
+
private
- fEventLock: TCriticalSection;
- fListenerLock: TCriticalSection;
- fEvents: TutlEventList;
- fListener: TutlEventListenerSet;
+ fEventLock: TCriticalSection;
+ fListenerLock: TCriticalSection;
+ fEvents: TEventList;
+ fListener: TutlEventListenerSet;
- function PopEvent: IutlEvent;
+ function PopEventPair(out aPair: TEventPair): Boolean;
- private { IEventListener }
- procedure DispatchEvent(aEvent: IutlEvent);
+ public { IEventListener }
+ procedure DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);
public
- function RegisterListener(const aListener: IutlEventListener): Boolean;
- function UnregisterListener(const aListener: IutlEventListener): Boolean;
+ function RegisterListener (const aListener: IutlEventListener): Boolean;
+ function UnregisterListener(const aListener: IutlEventListener): Boolean;
procedure DispatchEvents;
@@ -101,38 +114,50 @@ type
implementation
-uses
-{$IFDEF LOG_DEBUG}
- uutlLogger,
-{$ENDIF}
- uutlTiming;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlEventList/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlEventList.TComparer.EqualityCompare(constref i1, i2: T): Boolean;
+begin
+ result := (TMethod(i1).Data = TMethod(i2).Data)
+ and (TMethod(i1).Code = TMethod(i2).Code);
+end;
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlEventList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlEventList.TComparer.Compare(constref i1, i2: T): Integer;
+var
+ m1, m2: TMethod;
+begin
+ m1 := TMethod(i1);
+ m2 := TMethod(i2);
+ if (m1.Data < m2.Data) then
+ result := -1
+ else if (m1.Data > m2.Data) then
+ result := 1
+ else if (m1.Code < m2.Code) then
+ result := -1
+ else if (m1.Code > m2.Code) then
+ result := 1
+ else
+ result := 0;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventList.Create;
begin
- inherited Create(true);
+ inherited Create(TComparer.Create, true);
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlEventListenerSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlEvent.Create(const aSender: TObject; const aEventType: TutlEventType);
+function TutlEventListenerSet.TComparer.EqualityCompare(constref i1, i2: IutlEventListener): Boolean;
begin
- inherited Create;
- fSender := aSender;
- fEventType := aEventType;
- fTimestamp := GetMicroTime / 1000000;
-{$IFDEF LOG_DEBUG}
- utlLogger.Debug(self, 'dispatch event (Sender=%s[%p]; EventType=%0.10d; Timestamp=%10.5f)', [ fSender.ClassName, Pointer(fSender), fEventType, fTimestamp ]);
-{$ENDIF}
+ result := (i1 = i2);
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlEventListenerSet.TComparer/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEventListenerSet.TComparer.Compare(const i1, i2: IutlEventListener): Integer;
+function TutlEventListenerSet.TComparer.Compare(constref i1, i2: IutlEventListener): Integer;
begin
if (Pointer(i1) < Pointer(i2)) then
result := -1
@@ -145,39 +170,12 @@ end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventListenerSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEventListenerSet.GetEmpty: Boolean;
-begin
- result := (GetCount = 0);
-end;
-
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEventListenerSet.DispatchEvent(aEvent: IutlEvent);
+procedure TutlEventListenerSet.DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);
var
l: IutlEventListener;
begin
for l in self do
- l.DispatchEvent(aEvent);
-end;
-
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEventListenerSet.RegisterListener(const aListener: IutlEventListener): Boolean;
-var
- i: Integer;
-begin
- result := (SearchItem(0, List.Count-1, aListener, i) < 0);
- if result then
- InsertIntern(i, aListener);
-end;
-
-/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEventListenerSet.UnregisterListener(const aListener: IutlEventListener): Boolean;
-var
- i, tmp: Integer;
-begin
- i := SearchItem(0, List.Count-1, aListener, tmp);
- result := (i >= 0);
- if result then
- DeleteIntern(i);
+ l.DispatchEvent(aSender, aEvent);
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -189,41 +187,56 @@ end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventListenerCallback//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEventListenerCallback.DispatchEvent(aEvent: IutlEvent);
+procedure TutlEventListenerCallback.DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);
begin
- fCallback(aEvent);
+ fHandler(aSender, aEvent);
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlEventListenerCallback.Create(const aCallback: TCallback);
+constructor TutlEventListenerCallback.Create(const aHandler: TutlEventHandler);
begin
inherited Create;
- if not Assigned(aCallback) then
- raise EArgumentException.Create('aCallback is not assigned');
- fCallback := aCallback;
+ if not Assigned(aHandler) then
+ raise EArgumentNilException.Create('aHandler is not assigned');
+ fHandler := aHandler;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlEventListenerAsync.TEventList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlEventListenerAsync.TEventList.Release(var aItem: TEventPair; const aFreeItem: Boolean);
+begin
+ aItem.first := nil;
+ aItem.second := nil;
+ inherited Release(aItem, aFreeItem);
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventListenerAsync/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlEventListenerAsync.PopEvent: IutlEvent;
+function TutlEventListenerAsync.PopEventPair(out aPair: TEventPair): Boolean;
begin
fEventLock.Enter;
try
- if (fEvents.Count > 0)
- then result := fEvents.PopFirst(false)
- else result := nil;
+ result := not fEvents.IsEmpty;
+ if result
+ then aPair := fEvents.PopFirst(false)
+ else FillByte(aPair, SizeOf(aPair), 0);
finally
fEventLock.Leave;
end;
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEventListenerAsync.DispatchEvent(aEvent: IutlEvent);
+procedure TutlEventListenerAsync.DispatchEvent(constref aSender: TObject; constref aEvent: IutlEventArgs);
+var
+ p: TEventPair;
begin
+ p.first := aSender;
+ p.second := aEvent;
fEventLock.Enter;
try
- fEvents.Add(aEvent);
+ fEvents.Add(p);
finally
fEventLock.Leave;
end;
@@ -234,7 +247,7 @@ function TutlEventListenerAsync.RegisterListener(const aListener: IutlEventListe
begin
fListenerLock.Enter;
try
- result := fListener.RegisterListener(aListener);
+ result := fListener.Add(aListener);
finally
fListenerLock.Leave;
end;
@@ -245,7 +258,7 @@ function TutlEventListenerAsync.UnregisterListener(const aListener: IutlEventLis
begin
fListenerLock.Enter;
try
- result := fListener.UnregisterListener(aListener);
+ result := fListener.Remove(aListener);
finally
fListenerLock.Leave;
end;
@@ -254,19 +267,16 @@ end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventListenerAsync.DispatchEvents;
var
- e: IutlEvent;
+ p: TEventPair;
begin
- repeat
- e := PopEvent;
- if Assigned(e) then begin
- fListenerLock.Enter;
- try
- fListener.DispatchEvent(e);
- finally
- fListenerLock.Leave;
- end;
+ while PopEventPair(p) do begin
+ fListenerLock.Enter;
+ try
+ fListener.DispatchEvent(p.first, p.second);
+ finally
+ fListenerLock.Leave;
end;
- until not Assigned(e);
+ end;
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -275,7 +285,7 @@ begin
inherited Create;
fEventLock := TCriticalSection.Create;
fListenerLock := TCriticalSection.Create;
- fEvents := TutlEventList.Create;
+ fEvents := TEventList.Create(true);
fListener := TutlEventListenerSet.Create;
end;
diff --git a/uutlEventManager.pas b/uutlEventManager.pas
index 408c7e3..82f82ff 100644
--- a/uutlEventManager.pas
+++ b/uutlEventManager.pas
@@ -14,15 +14,24 @@ uses
type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TutlEventType = byte;
+ TutlEventTypes = set of TutlEventType;
TutlMouseButtons = set of TMouseButton;
- TutlWinControlEvent = class(TutlEvent)
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TutlWinControlEvent = class(TutlEventArgs)
private
- function GetControl: TControl;
+ fControl: TControl;
+ fEventType: TutlEventType;
+ fTimestamp: Single;
public
- property Control: TControl read GetControl;
+ property Control: TControl read fControl;
+ property EventType: TutlEventType read fEventType;
+ property Timestamp: Single read fTimestamp;
+
constructor Create(
- const aSender: TControl;
+ const aControl: TControl;
const aEventType: TutlEventType);
end;
@@ -183,7 +192,7 @@ type
procedure HandlerDeactivate (Sender: TObject);
protected
- procedure RecordEvent(const aEvent: IutlEvent); virtual;
+ procedure RecordEvent(const aEvent: IutlEventArgs); virtual;
function CreateMouseEvent(
aSender: TObject;
@@ -209,7 +218,7 @@ type
property Mouse: TMouseState read fMouse;
property Window: TWindowState read fWindow;
- procedure DispatchEvent(aEvent: IutlEvent); override;
+ procedure DispatchEvent(aEvent: IutlEventArgs); override;
procedure AttachEvents(const aControl: TWinControl; const aTypes: TutlEventTypes);
end;
@@ -217,7 +226,7 @@ implementation
uses
LCLIntf, Forms,
- uutlKeyCodes;
+ uutlKeyCodes, uutlCommon;
type
TWinControlVisibilityClass = class(TWinControl)
@@ -247,11 +256,12 @@ begin
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlWinControlEvent.Create(
- const aSender: TControl;
- const aEventType: TutlEventType);
+constructor TutlWinControlEvent.Create(const aControl: TControl; const aEventType: TutlEventType);
begin
- inherited Create(aSender, aEventType);
+ inherited Create;
+ fControl := aControl;
+ fEventType := aEventType;
+ fTimestamp := GetMicroTime / 1000000;
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -400,7 +410,7 @@ begin
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlWinControlEventManager.RecordEvent(const aEvent: IutlEvent);
+procedure TutlWinControlEventManager.RecordEvent(const aEvent: IutlEventArgs);
var
me: TutlMouseEvent;
ke: TutlKeyEvent;
@@ -526,7 +536,7 @@ begin
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlWinControlEventManager.DispatchEvent(aEvent: IutlEvent);
+procedure TutlWinControlEventManager.DispatchEvent(aEvent: IutlEventArgs);
begin
RecordEvent(aEvent);
inherited DispatchEvent(aEvent);
diff --git a/uutlExceptions.pas b/uutlExceptions.pas
deleted file mode 100644
index e0a0d5a..0000000
--- a/uutlExceptions.pas
+++ /dev/null
@@ -1,110 +0,0 @@
-unit uutlExceptions;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes, SysUtils;
-
-type
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- EutlException = class(Exception);
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- EutlInvalidOperation = class(Exception);
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- EutlNotSupported = class(Exception);
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- EutlOutOfRange = class(EutlException)
- private
- fMin: Integer;
- fMax: Integer;
- fIndex: Integer;
-
- public
- property Min: Integer read fMin;
- property Max: Integer read fMax;
- property Index: Integer read fIndex;
-
- constructor Create(const aIndex, aMin, aMax: Integer);
- constructor Create(const aMsg: String; const aIndex, aMin, aMax: Integer);
- end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- EutlArgument = class(EutlException)
- private
- fArgument: String;
-
- public
- property Argument: String read fArgument;
-
- constructor Create(const aArgument: String);
- constructor Create(const aMsg, aArgument: string);
- end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- EutlArgumentNil = class(EutlArgument)
- public
- constructor Create(const aArgument: String);
- constructor Create(const aMsg, aArgument: string);
- end;
-
-implementation
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//EutlOutOfRange////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EutlOutOfRange.Create(const aIndex, aMin, aMax: Integer);
-begin
- Create('', aIndex, aMin, aMax);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EutlOutOfRange.Create(const aMsg: String; const aIndex, aMin, aMax: Integer);
-var
- s: String;
-begin
- fIndex := aIndex;
- fMin := aMin;
- fMax := aMax;
- s := Format('index (%d) out of range (%d:%d)', [fIndex, fMin, fMax]);
- if (aMsg <> '') then
- s := s + ': ' + aMsg;
- inherited Create(s);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//EutlArgument//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EutlArgument.Create(const aArgument: String);
-begin
- inherited Create(aArgument + ' is not valid');
- fArgument := aArgument;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EutlArgument.Create(const aMsg, aArgument: string);
-begin
- inherited Create(aMsg);
- fArgument := aArgument;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//EutlArgumentNil///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EutlArgumentNil.Create(const aArgument: String);
-begin
- inherited Create('argument nil: ' + aArgument, aArgument);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor EutlArgumentNil.Create(const aMsg, aArgument: string);
-begin
- inherited Create(aMsg, aArgument);
-end;
-
-end.
-
diff --git a/uutlFilter.pas b/uutlFilter.pas
index 7cba638..d551a51 100644
--- a/uutlFilter.pas
+++ b/uutlFilter.pas
@@ -1,7 +1,9 @@
unit uutlFilter;
{$mode objfpc}{$H+}
-{$modeswitch nestedprocvars}
+{$IFDEF UTL_NESTED_PROCVARS}
+ {$modeswitch nestedprocvars}
+{$ENDIF}
interface
@@ -13,9 +15,11 @@ type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlFilterEvent = function(constref i: T): Boolean;
generic TutlFilterEventO = function(constref i: T): Boolean of object;
+ {$IFDEF UTL_NESTED_PROCVARS}
generic TutlFilterEventN = function(constref i: T): Boolean is nested;
+ {$ENDIF}
- generic TutlCalbackFilter = class(
+ generic TutlCallbackFilter = class(
TInterfacedObject,
specialize IutlFilter)
@@ -25,29 +29,36 @@ type
public type
TFilterEvent = specialize TutlFilterEvent;
TFilterEventO = specialize TutlFilterEventO;
+ {$IFDEF UTL_NESTED_PROCVARS}
TFilterEventN = specialize TutlFilterEventN;
+ {$ENDIF}
strict private
fType: TFilterEventType;
fEvent: TFilterEvent;
fEventO: TFilterEventO;
+ {$IFDEF UTL_NESTED_PROCVARS}
fEventN: TFilterEventN;
+ {$ENDIF}
public
function Filter(constref i: T): Boolean;
- { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks }
- constructor Create(const aEvent: TFilterEvent); overload;
- constructor Create(const aEvent: TFilterEventO); overload;
- constructor Create(const aEvent: TFilterEventN); overload;
+ constructor Create(constref aEvent: TFilterEvent); overload;
+ constructor Create(constref aEvent: TFilterEventO); overload;
+ {$IFDEF UTL_NESTED_PROCVARS}
+ constructor Create(constref aEvent: TFilterEventN); overload;
+ {$ENDIF}
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlSelectEvent = function(constref i: Tin): Tout;
generic TutlSelectEventO = function(constref i: Tin): Tout of object;
+ {$IFDEF UTL_NESTED_PROCVARS}
generic TutlSelectEventN = function(constref i: Tin): Tout is nested;
+ {$ENDIF}
- generic TutlCalbackSelector = class(
+ generic TutlCallbackSelector = class(
TInterfacedObject,
specialize IutlSelector)
@@ -57,42 +68,49 @@ type
public type
TSelectEvent = specialize TutlSelectEvent ;
TSelectEventO = specialize TutlSelectEventO;
+ {$IFDEF UTL_NESTED_PROCVARS}
TSelectEventN = specialize TutlSelectEventN;
+ {$ENDIF}
strict private
fType: TSelectEventType;
fEvent: TSelectEvent;
fEventO: TSelectEventO;
+ {$IFDEF UTL_NESTED_PROCVARS}
fEventN: TSelectEventN;
+ {$ENDIF}
public
function Select(constref i: Tin): Tout;
- { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks }
- constructor Create(const aEvent: TSelectEvent); overload;
- constructor Create(const aEvent: TSelectEventO); overload;
- constructor Create(const aEvent: TSelectEventN); overload;
+ constructor Create(constref aEvent: TSelectEvent); overload;
+ constructor Create(constref aEvent: TSelectEventO); overload;
+ {$IFDEF UTL_NESTED_PROCVARS}
+ constructor Create(constref aEvent: TSelectEventN); overload;
+ {$ENDIF}
end;
implementation
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlCalbackFilter/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlCallbackFilter/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCalbackFilter.Filter(constref i: T): Boolean;
+function TutlCallbackFilter.Filter(constref i: T): Boolean;
begin
result := false;
case fType of
fetNormal: result := fEvent (i);
fetObject: result := fEventO(i);
+ {$IFDEF UTL_NESTED_PROCVARS}
fetNested: result := fEventN(i);
+ {$ENDIF}
else
raise Exception.Create('invalid or unknown callback type');
end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCalbackFilter.Create(const aEvent: TFilterEvent);
+constructor TutlCallbackFilter.Create(constref aEvent: TFilterEvent);
begin
inherited Create;
fType := fetNormal;
@@ -100,7 +118,7 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCalbackFilter.Create(const aEvent: TFilterEventO);
+constructor TutlCallbackFilter.Create(constref aEvent: TFilterEventO);
begin
inherited Create;
fType := fetObject;
@@ -108,29 +126,33 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCalbackFilter.Create(const aEvent: TFilterEventN);
+{$IFDEF UTL_NESTED_PROCVARS}
+constructor TutlCallbackFilter.Create(constref aEvent: TFilterEventN);
begin
inherited Create;
fType := fetNested;
fEventN := aEvent;
end;
+{$ENDIF}
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlCalbackSelector///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlCallbackSelector///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlCalbackSelector.Select(constref i: Tin): Tout;
+function TutlCallbackSelector.Select(constref i: Tin): Tout;
begin
case fType of
setNormal: result := fEvent (i);
setObject: result := fEventO(i);
+ {$IFDEF UTL_NESTED_PROCVARS}
setNested: result := fEventN(i);
+ {$ENDIF}
else
raise Exception.Create('invalid or unknown callback type');
end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCalbackSelector.Create(const aEvent: TSelectEvent);
+constructor TutlCallbackSelector.Create(constref aEvent: TSelectEvent);
begin
inherited Create;
fType := setNormal;
@@ -138,7 +160,7 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCalbackSelector.Create(const aEvent: TSelectEventO);
+constructor TutlCallbackSelector.Create(constref aEvent: TSelectEventO);
begin
inherited Create;
fType := setObject;
@@ -146,12 +168,14 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCalbackSelector.Create(const aEvent: TSelectEventN);
+{$IFDEF UTL_NESTED_PROCVARS}
+constructor TutlCallbackSelector.Create(constref aEvent: TSelectEventN);
begin
inherited Create;
fType := setNested;
fEventN := aEvent;
end;
+{$ENDIF}
end.
diff --git a/uutlGenerics.pas b/uutlGenerics.pas
index 7df71eb..380a1c9 100644
--- a/uutlGenerics.pas
+++ b/uutlGenerics.pas
@@ -11,8 +11,11 @@ uses
type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlQueue = class(
- specialize TutlArrayContainer,
- specialize IutlEnumerable)
+ specialize TutlArrayContainer
+ , specialize IEnumerable
+ {$IFDEF UTL_ENUMERATORS}
+ , specialize IutlEnumerable
+ {$ENDIF})
strict private
fCount: Integer;
@@ -24,9 +27,13 @@ type
procedure SetCount(const aValue: Integer); override;
procedure SetCapacity(const aValue: integer); override;
- public { IutlEnumerable }
+ public { IEnumerable }
function GetEnumerator: specialize IEnumerator;
+
+ {$IFDEF UTL_ENUMERATORS}
+ public { IutlEnumerable }
function GetUtlEnumerator: specialize IutlEnumerator;
+ {$ENDIF}
public
property Count: Integer read GetCount;
@@ -49,8 +56,11 @@ type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlStack = class(
- specialize TutlArrayContainer,
- specialize IutlEnumerable)
+ specialize TutlArrayContainer
+ , specialize IEnumerable
+ {$IFDEF UTL_ENUMERATORS}
+ , specialize IutlEnumerable
+ {$ENDIF})
strict private
fCount: Integer;
@@ -59,9 +69,13 @@ type
function GetCount: Integer; override;
procedure SetCount(const aValue: Integer); override;
- public { IutlEnumerable }
+ public { IEnumerable }
function GetEnumerator: specialize IEnumerator;
+
+ {$IFDEF UTL_ENUMERATORS}
+ public { IUtlEnumerable }
function GetUtlEnumerator: specialize IutlEnumerator;
+ {$ENDIF}
public
property Count: Integer read GetCount;
@@ -82,39 +96,11 @@ type
destructor Destroy; override;
end;
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlArray = class(
- TutlInterfaceNoRefCount,
- specialize IutlReadOnlyArray,
- specialize IutlArray)
-
- public type
- TData = array of T;
-
- strict private
- fData: TData;
-
- public { IutlArray }
- function GetCount: Integer;
- procedure SetCount(const aValue: Integer);
- function GetItem(const aIndex: Integer): T;
- procedure SetItem(const aIndex: Integer; aItem: T);
-
- property Count: Integer read GetCount write SetCount;
- property Items[const aIndex: Integer]: T read GetItem write SetItem; default;
-
- public
- property Data: TData read fData write fData;
-
- constructor Create;
- constructor Create(const aData: TData);
- end;
-
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlSimpleList = class(
- specialize TutlListBase,
- specialize IutlReadOnlyArray,
- specialize IutlArray)
+ specialize TutlListBase
+ , specialize IutlReadOnlyArray
+ , specialize IutlArray)
strict private
function GetFirst: T;
@@ -172,8 +158,8 @@ type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlCustomHashSet = class(
- specialize TutlListBase,
- specialize IutlReadOnlyArray)
+ specialize TutlListBase
+ , specialize IutlReadOnlyArray)
private type
TBinarySearch = specialize TutlBinarySearch;
@@ -203,7 +189,7 @@ type
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlHastSet = class(
+ generic TutlHashSet = class(
specialize TutlCustomHashSet)
public type
@@ -215,8 +201,10 @@ type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlCustomMap = class(
- TutlInterfaceNoRefCount,
- specialize IutlEnumerable)
+ TutlInterfaceNoRefCount
+ {$IFDEF UTL_ENUMERATORS}
+ , specialize IutlEnumerable
+ {$ENDIF})
public type
////////////////////////////////////////////////////////////////////////////////////////////////
@@ -242,8 +230,8 @@ type
////////////////////////////////////////////////////////////////////////////////////////////////
IComparer = specialize IutlComparer;
TKeyValuePairComparer = class(
- TInterfacedObject,
- THashSet.IComparer)
+ TInterfacedObject
+ , THashSet.IComparer)
strict private
fComparer: IComparer;
@@ -261,16 +249,22 @@ type
////////////////////////////////////////////////////////////////////////////////////////////////
TKeyCollection = class(
- TutlInterfaceNoRefCount,
- specialize IutlEnumerable,
- specialize IutlReadOnlyArray)
+ TutlInterfaceNoRefCount
+ , specialize IutlReadOnlyArray
+ {$IFDEF UTL_ENUMERATORS}
+ , specialize IutlEnumerable
+ {$ENDIF})
strict private
fHashSet: THashSet;
- public { IutlEnumerable }
+ public { IEnumerable }
function GetEnumerator: specialize IEnumerator;
+
+ {$IFDEF UTL_ENUMERATORS}
+ public { IutlEnumerable }
function GetUtlEnumerator: specialize IutlEnumerator;
+ {$ENDIF}
public { IutlReadOnlyArray }
function GetCount: Integer;
@@ -285,16 +279,22 @@ type
////////////////////////////////////////////////////////////////////////////////////////////////
TKeyValuePairCollection = class(
- TutlInterfaceNoRefCount,
- specialize IutlEnumerable,
- specialize IutlReadOnlyArray