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) + 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; @@ -329,9 +329,13 @@ type procedure SetCanShrink (const aValue: Boolean); inline; procedure SetCanExpand (const aValue: Boolean); inline; - public { IutlEnumerable } + public { IEnumerable } function GetEnumerator: specialize IEnumerator; + + {$IFDEF UTL_ENUMERATORS} + public { IutlEnumerable } function GetUtlEnumerator: specialize IutlEnumerator; + {$ENDIF} public property Values [aKey: TKey]: TValue read GetValue write SetValue; default; @@ -408,9 +412,6 @@ type implementation -uses - uutlExceptions; - //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlQueue///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -422,7 +423,7 @@ end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlQueue.SetCount(const aValue: Integer); begin - raise EutlNotSupported.Create('SetCount not supported'); + raise ENotSupportedException.Create('SetCount not supported'); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -431,7 +432,7 @@ var cnt: Integer; begin if (aValue < Count) then - raise EutlArgument.Create('can not reduce capacity below count', 'Capacity'); + raise EArgumentException.Create('can not reduce capacity below count'); if (aValue < Capacity) then begin // is shrinking if (fReadPos <= fWritePos) then begin // ReadPos Before WritePos -> Move To Begin @@ -458,14 +459,18 @@ end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlQueue.GetEnumerator: specialize IEnumerator; begin - result := GetUtlEnumerator; + result := nil; // TODO + raise ENotSupportedException.Create('not yet supported'); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{$IFDEF UTL_ENUMERATORS} function TutlQueue.GetUtlEnumerator: specialize IutlEnumerator; begin - // TODO + result := nil; // TODO + raise ENotSupportedException.Create('not yet supported'); end; +{$ENDIF} //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlQueue.Enqueue(constref aItem: T); @@ -490,7 +495,7 @@ var p: PT; begin if IsEmpty then - raise EutlInvalidOperation.Create('queue is empty'); + raise EInvalidOperation.Create('queue is empty'); p := GetInternalItem(fReadPos); if aFreeItem then FillByte(result{%H-}, SizeOf(result), 0) @@ -504,7 +509,7 @@ end; function TutlQueue.Peek: T; begin if IsEmpty then - raise EutlInvalidOperation.Create('queue is empty'); + raise EInvalidOperation.Create('queue is empty'); result := GetInternalItem(fReadPos)^; end; @@ -553,20 +558,24 @@ end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStack.SetCount(const aValue: Integer); begin - raise EutlNotSupported.Create('SetCount not supported'); + raise ENotSupportedException.Create('SetCount not supported'); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStack.GetEnumerator: specialize IEnumerator; begin - // TODO + result := nil; // TODO + raise ENotSupportedException.Create('not yet supported'); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{$IFDEF UTL_ENUMERATORS} function TutlStack.GetUtlEnumerator: specialize IutlEnumerator; begin - // TODO + result := nil; // TODO + raise ENotSupportedException.Create('not yet supported'); end; +{$ENDIF} //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStack.Push(constref aItem: T); @@ -589,7 +598,7 @@ var p: PT; begin if IsEmpty then - raise EutlInvalidOperation.Create('stack is empty'); + raise EInvalidOperation.Create('stack is empty'); p := GetInternalItem(fCount-1); if aFreeItem then FillByte(result{%H-}, SizeOf(result), 0) @@ -602,7 +611,7 @@ end; function TutlStack.Peek: T; begin if IsEmpty then - raise EutlInvalidOperation.Create('stack is empty'); + raise EInvalidOperation.Create('stack is empty'); result := GetInternalItem(fCount-1)^; end; @@ -637,57 +646,13 @@ begin inherited Destroy; end; -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlArray///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlArray.GetCount: Integer; -begin - result := Length(fData); -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlArray.SetCount(const aValue: Integer); -begin - SetLength(fData, aValue); -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlArray.GetItem(const aIndex: Integer): T; -begin - if (aIndex < 0) or (aIndex >= Count) then - raise EutlOutOfRange.Create(aIndex, 0, Count-1); - result := fData[aIndex]; -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlArray.SetItem(const aIndex: Integer; aItem: T); -begin - if (aIndex < 0) or (aIndex >= Count) then - raise EutlOutOfRange.Create(aIndex, 0, Count-1); - fData[aIndex] := aItem; -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlArray.Create; -begin - inherited Create; - SetLength(fData, 0); -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlArray.Create(const aData: TData); -begin - inherited Create; - fData := aData; -end; - //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlSimpleList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlSimpleList.GetFirst: T; begin if IsEmpty then - raise EutlInvalidOperation.Create('list is empty'); + raise EInvalidOperation.Create('list is empty'); result := GetInternalItem(0)^; end; @@ -695,7 +660,7 @@ end; function TutlSimpleList.GetLast: T; begin if IsEmpty then - raise EutlInvalidOperation.Create('list is empty'); + raise EInvalidOperation.Create('list is empty'); result := GetInternalItem(Count-1)^; end; @@ -719,9 +684,9 @@ var p1, p2: PT; begin if (aIndex1 < 0) or (aIndex1 >= Count) then - raise EutlOutOfRange.Create(aIndex1, 0, Count-1); + raise EOutOfRangeException.Create(aIndex1, 0, Count-1); if (aIndex2 < 0) or (aIndex2 >= Count) then - raise EutlOutOfRange.Create(aIndex2, 0, Count-1); + raise EOutOfRangeException.Create(aIndex2, 0, Count-1); p1 := GetInternalItem(aIndex1); p2 := GetInternalItem(aIndex2); System.Move(p1^, tmp{%H-}, SizeOf(T)); @@ -737,9 +702,9 @@ var cur, new: PT; begin if (aCurrentIndex < 0) or (aCurrentIndex >= Count) then - raise EutlOutOfRange.Create(aCurrentIndex, 0, Count-1); + raise EOutOfRangeException.Create(aCurrentIndex, 0, Count-1); if (aNewIndex < 0) or (aNewIndex >= Count) then - raise EutlOutOfRange.Create(aNewIndex, 0, Count-1); + raise EOutOfRangeException.Create(aNewIndex, 0, Count-1); if (aCurrentIndex = aNewIndex) then exit; cur := GetInternalItem(aCurrentIndex); @@ -834,7 +799,7 @@ end; constructor TutlCustomList.Create(const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean); begin if not Assigned(aEqualityComparer) then - raise EutlArgumentNil.Create('aEqualityComparer'); + raise EArgumentNilException.Create('aEqualityComparer'); inherited Create(aOwnsItems); fEqualityComparer := aEqualityComparer; end; @@ -859,14 +824,14 @@ end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlCustomHashSet.SetCount(const aValue: Integer); begin - raise EutlNotSupported.Create('SetCount not supported'); + raise ENotSupportedException.Create('SetCount not supported'); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlCustomHashSet.SetItem(const aIndex: Integer; aValue: T); begin if not fComparer.EqualityCompare(GetItem(aIndex), aValue) then - EutlInvalidOperation.Create('values are not equal'); + EInvalidOperation.Create('values are not equal'); inherited SetItem(aIndex, aValue); end; @@ -928,7 +893,7 @@ end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlHastSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlHastSet.Create(const aOwnsItems: Boolean); +constructor TutlHashSet.Create(const aOwnsItems: Boolean); begin inherited Create(TComparer.Create, aOwnsItems); end; @@ -968,7 +933,7 @@ end; constructor TutlCustomMap.TKeyValuePairComparer.Create(aComparer: IComparer); begin if not Assigned(aComparer) then - raise EutlArgumentNil.Create('aComparer'); + raise EArgumentNilException.Create('aComparer'); inherited Create; fComparer := aComparer; end; @@ -985,14 +950,18 @@ end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyCollection.GetEnumerator: specialize IEnumerator; begin - result := GetUtlEnumerator; + result := nil; // TODO + raise ENotSupportedException.Create('not yet supported'); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{$IFDEF UTL_ENUMERATORS} function TutlCustomMap.TKeyCollection.GetUtlEnumerator: specialize IutlEnumerator; begin - // TODO + result := nil; // TODO + raise ENotSupportedException.Create('not yet supported'); end; +{$ENDIF} //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyCollection.GetCount: Integer; @@ -1018,14 +987,18 @@ end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyValuePairCollection.GetEnumerator: specialize IEnumerator; begin - result := GetUtlEnumerator; + result := nil; // TODO + raise ENotSupportedException.Create('not yet supported'); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{$IFDEF UTL_ENUMERATORS} function TutlCustomMap.TKeyValuePairCollection.GetUtlEnumerator: specialize IutlEnumerator; begin - // TODO + result := nil; // TODO + raise ENotSupportedException.Create('not yet supported'); end; +{$ENDIF} //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.TKeyValuePairCollection.GetCount: Integer; @@ -1108,7 +1081,7 @@ begin i := fHashSetRef.IndexOf(kvp); if (i < 0) then begin if not fAutoCreate then - raise EutlInvalidOperation.Create('key not found'); + raise EInvalidOperation.Create('key not found'); fHashSetRef.Add(kvp); end else fHashSetRef[i] := kvp; @@ -1145,20 +1118,24 @@ end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlCustomMap.GetEnumerator: specialize IEnumerator; begin - result := GetUtlEnumerator; + result := nil; // TODO + raise ENotSupportedException.Create('not yet supported'); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{$IFDEF UTL_ENUMERATORS} function TutlCustomMap.GetUtlEnumerator: specialize IutlEnumerator; begin - // TODO + result := nil; // TODO + raise ENotSupportedException.Create('not yet supported'); end; +{$ENDIF} //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlCustomMap.Add(constref aKey: TKey; constref aValue: TValue); begin if not TryAdd(aKey, aValue) then - raise EutlInvalidOperation.Create('key already exists'); + raise EInvalidOperation.Create('key already exists'); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -1205,7 +1182,7 @@ var begin kvp.Key := aKey; if not fHashSetRef.Remove(kvp) then - raise EutlInvalidOperation.Create('key not found'); + raise EInvalidOperation.Create('key not found'); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -1227,7 +1204,7 @@ constructor TutlCustomMap.Create( const aOwnsValues: Boolean); begin if not Assigned(aHashSet) then - EutlArgumentNil.Create('aHashSet'); + EArgumentNilException.Create('aHashSet'); inherited Create; diff --git a/uutlInterfaces.pas b/uutlInterfaces.pas index ca580e5..5171a51 100644 --- a/uutlInterfaces.pas +++ b/uutlInterfaces.pas @@ -5,7 +5,8 @@ unit uutlInterfaces; interface uses - Classes, SysUtils; + Classes, SysUtils, + uutlTypes; type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -31,20 +32,36 @@ type end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// - generic TGenericArray = array of T; generic IutlEnumerator = interface(specialize IEnumerator) - function GetEnumerator: specialize IutlEnumerator; - - function Count: Integer; + // TODO: Aggregate, Join - function Reverse: specialize IutlEnumerator; - function Skip (const aCount: Integer): specialize IutlEnumerator; - function Take (const aCount: Integer): specialize IutlEnumerator; - - function Where (const aComparer: specialize IutlFilter): specialize IutlEnumerator; - // TODO generic function Select (const aSelector: specialize IutlSelector): specialize IutlEnumerator; + function GetEnumerator: specialize IutlEnumerator; - function ToArray: specialize TGenericArray; + // the following functions will execute the query + function Count (): Integer; + function Any (): Boolean; + function ToArray (): specialize TutlArray; + function Contains (constref aElement: T; aComparer: specialize IutlEqualityComparer): Boolean; + + // the following functions will describe the query and do not execute any code in the enumerated items + function Skip (aCount: Integer): specialize IutlEnumerator; + function Take (aCount: Integer): specialize IutlEnumerator; + function Concat (aEnumerator: specialize IutlEnumerator): specialize IutlEnumerator; + function Reverse (): specialize IutlEnumerator; + {$IFDEF UTL_ADVANCED_ENUMERATORS} + function Sort (aComparer: specialize IutlComparer): specialize IutlEnumerator; + function Where (aFilter: specialize IutlFilter): specialize IutlEnumerator; + function Distinct (aComparer: specialize IutlComparer): specialize IutlEnumerator; + function Intersect (aEnumerator: specialize IutlEnumerator; aComparer: specialize IutlComparer): specialize IutlEnumerator; + function Union (aEnumerator: specialize IutlEnumerator; aComparer: specialize IutlComparer): specialize IutlEnumerator; + function Without (aEnumerator: specialize IutlEnumerator; aComparer: specialize IutlComparer): specialize IutlEnumerator; + + // TODO: interfaces do not support generic functions yet + // generic function Select (aSelector: specialize IutlSelector): specialize IutlEnumerator; + // generic function SelectMany(aSelector: specialize IutlSelector>): specialize IutlEnumerator; + // generic function Aggregate (constref aSeed: S; aAggregator: specialize IutlAggregator): S; + // generic function Zip (aEnumerator: specialize IutlEnumerator): specialize IutlEnumerator>; + {$ENDIF} end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -57,7 +74,7 @@ type end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// - generic IutlReadOnlyArray = interface(IUnknown) + generic IutlReadOnlyArray = interface(specialize {$IFDEF UTL_ADVANCED_ENUMERATORS}IutlEnumerable{$ELSE}IEnumerable{$ENDIF}) ['{B0938B6F-4E0D-45E3-A813-056AD4C0A2F2}'] function GetCount: Integer; function GetItem(const aIndex: Integer): T; diff --git a/uutlLinq.pas b/uutlLinq.pas new file mode 100644 index 0000000..59763b5 --- /dev/null +++ b/uutlLinq.pas @@ -0,0 +1,436 @@ +unit uutlLinq; + +{$mode objfpc}{$H+} +{$IFDEF UTL_NESTED_PROCVARS} + {$modeswitch nestedprocvars} +{$ENDIF} + +interface + +{$IFDEF UTL_ENUMERATORS} +uses + Classes, SysUtils, + uutlTypes, uutlInterfaces, uutlComparer, uutlFilter; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic function utlCount( + constref aEnumerator: specialize IutlEnumerator): Integer; inline; + + generic function utlAny( + constref aEnumerator: specialize IutlEnumerator): Boolean; inline; + + generic function utlToArray( + constref aEnumerator: specialize IutlEnumerator): specialize TutlArray; inline; + + generic function utlContains( + constref aEnumerator: specialize IutlEnumerator; + constref aElement: T): Boolean; inline; overload; + + generic function utlContains( + constref aEnumerator: specialize IutlEnumerator; + constref aElement: T; + constref aComparer: specialize IutlEqualityComparer): Boolean; inline; overload; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic function utlSkip( + constref aEnumerator: specialize IutlEnumerator; + const aSkip: Integer): specialize IutlEnumerator; inline; + + generic function utlTake( + constref aEnumerator: specialize IutlEnumerator; + const aTake: Integer): specialize IutlEnumerator; inline; + + generic function utlConcat( + constref aEnumerator1, aEnumerator2: specialize IutlEnumerator): specialize IutlEnumerator; inline; overload; + + generic function utlConcat( + constref aEnumerators: specialize TutlArray>): specialize IutlEnumerator; inline; overload; + + generic function utlReverse( + constref aEnumerator: specialize IutlEnumerator): specialize IutlEnumerator; inline; + + {$IFDEF UTL_ADVANCED_ENUMERATORS} + generic function utlSort( + constref aEnumerator: specialize IutlEnumerator): specialize IutlEnumerator; inline; overload; + + generic function utlSort( + constref aEnumerator: specialize IutlEnumerator; + constref aComparer: specialize IutlComparer): specialize IutlEnumerator; inline; overload; + + generic function utlWhere( + constref aEnumerator: specialize IutlEnumerator; + constref aFilter: specialize IutlFilter): specialize IutlEnumerator; inline; overload; + + generic function utlWhere( + constref aEnumerator: specialize IutlEnumerator; + constref aFilter: specialize TutlFilterEvent): specialize IutlEnumerator; inline; overload; + + generic function utlWhereO( + constref aEnumerator: specialize IutlEnumerator; + constref aFilter: specialize TutlFilterEventO): specialize IutlEnumerator; inline; overload; + + {$IFDEF UTL_NESTED_PROCVARS} + generic function utlWhereN( + constref aEnumerator: specialize IutlEnumerator; + constref aFilter: specialize TutlFilterEventN): specialize IutlEnumerator; inline; overload; + {$ENDIF} + + generic function utlDistinct( + constref aEnumerator: specialize IutlEnumerator): specialize IutlEnumerator; inline; overload; + + generic function utlDistinct( + constref aEnumerator: specialize IutlEnumerator; + constref aComparer: specialize IutlComparer): specialize IutlEnumerator; inline; overload; + + generic function utlIntersect( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator): specialize IutlEnumerator; inline; overload; + + generic function utlIntersect( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator; + constref aComparer: specialize IutlComparer): specialize IutlEnumerator; inline; overload; + + generic function utlUnion( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator): specialize IutlEnumerator; inline; overload; + + generic function utlUnion( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator; + constref aComparer: specialize IutlComparer): specialize IutlEnumerator; inline; overload; + + generic function utlWithout( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator): specialize IutlEnumerator; inline; overload; + + generic function utlWithout( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator; + constref aComparer: specialize IutlComparer): specialize IutlEnumerator; inline; overload; + + generic function utlSelect( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize IutlSelector): specialize IutlEnumerator; inline; overload; + + generic function utlSelect( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEvent): specialize IutlEnumerator; inline; overload; + + generic function utlSelectO( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEventO): specialize IutlEnumerator; inline; overload; + + {$IFDEF UTL_NESTED_PROCVARS} + generic function utlSelectN( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEventN): specialize IutlEnumerator; inline; overload; + {$ENDIF} + + generic function utlSelectMany( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize IutlSelector>): specialize IutlEnumerator; inline; overload; + + generic function utlSelectMany( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEvent>): specialize IutlEnumerator; inline; overload; + + generic function utlSelectManyO( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEventO>): specialize IutlEnumerator; inline; overload; + + {$IFDEF UTL_NESTED_PROCVARS} + generic function utlSelectManyN( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEventN>): specialize IutlEnumerator; inline; overload; + {$ENDIF} + + generic function utlZip( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator): specialize IutlEnumerator>; + {$ENDIF} +{$ENDIF} + +implementation + +{$IFDEF UTL_ENUMERATORS} +uses + uutlEnumerator; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//utlLinq/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlCount( + constref aEnumerator: specialize IutlEnumerator): Integer; +begin + result := aEnumerator.Count; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlAny( + constref aEnumerator: specialize IutlEnumerator): Boolean; +begin + result := aEnumerator.Any; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlToArray( + constref aEnumerator: specialize IutlEnumerator): specialize TutlArray; +begin + result := aEnumerator.ToArray; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlContains( + constref aEnumerator: specialize IutlEnumerator; + constref aElement: T): Boolean; +begin + result := aEnumerator.Contains(aElement, specialize TutlEqualityComparer.Create); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlContains( + constref aEnumerator: specialize IutlEnumerator; + constref aElement: T; + constref aComparer: specialize IutlEqualityComparer): Boolean; +begin + result := aEnumerator.Contains(aElement, aComparer); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlSkip( + constref aEnumerator: specialize IutlEnumerator; + const aSkip: Integer): specialize IutlEnumerator; +begin + result := aEnumerator.Skip(aSkip); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlTake( + constref aEnumerator: specialize IutlEnumerator; + const aTake: Integer): specialize IutlEnumerator; +begin + result := aEnumerator.Take(aTake); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlConcat( + constref aEnumerator1, aEnumerator2: specialize IutlEnumerator): specialize IutlEnumerator; +type + TConcatEnumerator = specialize TutlConcatEnumerator; +begin + result := TConcatEnumerator.Create(TConcatEnumerator.TEnumerators.Create(aEnumerator1, aEnumerator2)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlConcat( + constref aEnumerators: specialize TutlArray>): specialize IutlEnumerator; +type + TConcatEnumerator = specialize TutlConcatEnumerator; +begin + result := TConcatEnumerator.Create(aEnumerators); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlReverse( + constref aEnumerator: specialize IutlEnumerator): specialize IutlEnumerator; +begin + result := aEnumerator.Reverse; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{$IFDEF UTL_ADVANCED_ENUMERATORS} +generic function utlSort( + constref aEnumerator: specialize IutlEnumerator): specialize IutlEnumerator; +begin + result := aEnumerator.Sort(specialize TutlComparer.Create); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlSort( + constref aEnumerator: specialize IutlEnumerator; + constref aComparer: specialize IutlComparer): specialize IutlEnumerator; +begin + result := aEnumerator.Sort(aComparer); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlWhere( + constref aEnumerator: specialize IutlEnumerator; + constref aFilter: specialize IutlFilter): specialize IutlEnumerator; +begin + result := aEnumerator.Where(aFilter); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlWhere( + constref aEnumerator: specialize IutlEnumerator; + constref aFilter: specialize TutlFilterEvent): specialize IutlEnumerator; +begin + result := aEnumerator.Where(specialize TutlCallbackFilter.Create(aFilter)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlWhereO( + constref aEnumerator: specialize IutlEnumerator; + constref aFilter: specialize TutlFilterEventO): specialize IutlEnumerator; +begin + result := aEnumerator.Where(specialize TutlCallbackFilter.Create(aFilter)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{$IFDEF UTL_NESTED_PROCVARS} +generic function utlWhereN( + constref aEnumerator: specialize IutlEnumerator; + constref aFilter: specialize TutlFilterEventN): specialize IutlEnumerator; +begin + result := aEnumerator.Where(specialize TutlCallbackFilter.Create(aFilter)); +end; +{$ENDIF} + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlDistinct( + constref aEnumerator: specialize IutlEnumerator): specialize IutlEnumerator; +begin + result := aEnumerator.Distinct(specialize TutlComparer.Create); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlDistinct( + constref aEnumerator: specialize IutlEnumerator; + constref aComparer: specialize IutlComparer): specialize IutlEnumerator; +begin + result := aEnumerator.Distinct(aComparer); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlIntersect( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator): specialize IutlEnumerator; +begin + result := aEnumerator1.Intersect(aEnumerator2, specialize TutlComparer.Create); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlIntersect( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator; + constref aComparer: specialize IutlComparer): specialize IutlEnumerator; +begin + result := aEnumerator1.Intersect(aEnumerator2, aComparer); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlUnion( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator): specialize IutlEnumerator; +begin + result := aEnumerator1.Union(aEnumerator2, specialize TutlComparer.Create); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlUnion( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator; + constref aComparer: specialize IutlComparer): specialize IutlEnumerator; +begin + result := aEnumerator1.Union(aEnumerator2, aComparer); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlWithout( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator): specialize IutlEnumerator; +begin + result := aEnumerator1.Without(aEnumerator2, specialize TutlComparer.Create); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlWithout( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator; + constref aComparer: specialize IutlComparer): specialize IutlEnumerator; +begin + result := aEnumerator1.Without(aEnumerator2, aComparer); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlSelect( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize IutlSelector): specialize IutlEnumerator; +begin + result := specialize TutlSelectEnumerator.Create(aEnumerator, aSelector); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlSelect( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEvent): specialize IutlEnumerator; +begin + result := specialize TutlSelectEnumerator.Create(aEnumerator, specialize TutlCallbackSelector.Create(aSelector)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlSelectO( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEventO): specialize IutlEnumerator; +begin + result := specialize TutlSelectEnumerator.Create(aEnumerator, specialize TutlCallbackSelector.Create(aSelector)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{$IFDEF UTL_NESTED_PROCVARS} +generic function utlSelectN( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEventN): specialize IutlEnumerator; +begin + result := specialize TutlSelectEnumerator.Create(aEnumerator, specialize TutlCallbackSelector.Create(aSelector)); +end; +{$ENDIF} + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlSelectMany( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize IutlSelector>): specialize IutlEnumerator; +begin + result := specialize TutlSelectManyEnumerator.Create(aEnumerator, aSelector); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlSelectMany( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEvent>): specialize IutlEnumerator; +begin + result := specialize TutlSelectManyEnumerator.Create(aEnumerator, specialize TutlCallbackSelector>.Create(aSelector)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlSelectManyO( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEventO>): specialize IutlEnumerator; +begin + result := specialize TutlSelectManyEnumerator.Create(aEnumerator, specialize TutlCallbackSelector>.Create(aSelector)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{$IFDEF UTL_NESTED_PROCVARS} +generic function utlSelectManyN( + constref aEnumerator: specialize IutlEnumerator; + constref aSelector: specialize TutlSelectEventN>): specialize IutlEnumerator; +begin + result := specialize TutlSelectManyEnumerator.Create(aEnumerator, specialize TutlCallbackSelector>.Create(aSelector)); +end; +{$ENDIF} + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +generic function utlZip( + constref aEnumerator1: specialize IutlEnumerator; + constref aEnumerator2: specialize IutlEnumerator): specialize IutlEnumerator>; +begin + result := specialize TutlZipEnumerator.Create(aEnumerator1, aEnumerator2); +end; +{$ENDIF} +{$ENDIF} + +end. + diff --git a/uutlListBase.pas b/uutlListBase.pas index 58bf46b..891ce51 100644 --- a/uutlListBase.pas +++ b/uutlListBase.pas @@ -6,13 +6,15 @@ interface uses Classes, SysUtils, - uutlArrayContainer, uutlInterfaces; + uutlArrayContainer + {$IFDEF UTL_ADVANCED_ENUMERATORS}, uutlInterfaces{$ENDIF}; type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlListBase = class( - specialize TutlArrayContainer, - specialize IutlEnumerable) + specialize TutlArrayContainer + , specialize IEnumerable + {$IFDEF UTL_ADVANCED_ENUMERATORS}, specialize IutlEnumerable{$ENDIF}) strict private fCount: Integer; @@ -26,9 +28,13 @@ type procedure InsertIntern(const aIndex: Integer; constref aValue: T); virtual; procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); virtual; - public { IutlEnumerable } + public { IEnumerable } function GetEnumerator: specialize IEnumerator; + + {$IFDEF UTL_ADVANCED_ENUMERATORS} + public { IutlEnumerable } function GetUtlEnumerator: specialize IutlEnumerator; + {$ENDIF} public property Count; @@ -38,7 +44,7 @@ type property CanExpand; property OwnsItems; - procedure Clear; + procedure Clear; virtual; procedure ShrinkToFit; constructor Create(const aOwnsItems: Boolean); @@ -48,7 +54,7 @@ type implementation uses - uutlExceptions; + uutlEnumerator, uutlCommon; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlListBase////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -70,7 +76,7 @@ end; function TutlListBase.GetItem(const aIndex: Integer): T; begin if (aIndex < 0) or (aIndex >= Count) then - raise EutlOutOfRange.Create(aIndex, 0, Count-1); + raise EOutOfRangeException.Create(aIndex, 0, Count-1); result := GetInternalItem(aIndex)^; end; @@ -80,7 +86,7 @@ var p: PT; begin if (aIndex < 0) or (aIndex >= Count) then - raise EutlOutOfRange.Create(aIndex, 0, Count-1); + raise EOutOfRangeException.Create(aIndex, 0, Count-1); p := GetInternalItem(aIndex); Release(p^, true); p^ := aValue; @@ -92,7 +98,7 @@ var p: PT; begin if (aIndex < 0) or (aIndex > fCount) then - raise EutlOutOfRange.Create(aIndex, 0, fCount); + raise EOutOfRangeException.Create(aIndex, 0, fCount); if (fCount = Capacity) then Expand; p := GetInternalItem(aIndex); @@ -108,7 +114,7 @@ var p: PT; begin if (aIndex < 0) or (aIndex >= fCount) then - raise EutlOutOfRange.Create(aIndex, 0, fCount-1); + raise EOutOfRangeException.Create(aIndex, 0, fCount-1); dec(fCount); p := GetInternalItem(aIndex); Release(p^, aFreeItem); @@ -121,14 +127,16 @@ end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlListBase.GetEnumerator: specialize IEnumerator; begin - result := GetUtlEnumerator; + result := specialize TutlMemoryEnumerator.Create(GetInternalItem(0), Count); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{$IFDEF UTL_ADVANCED_ENUMERATORS} function TutlListBase.GetUtlEnumerator: specialize IutlEnumerator; begin - // TODO + result := specialize TutlMemoryEnumerator.Create(GetInternalItem(0), Count); end; +{$ENDIF} //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlListBase.Clear; diff --git a/uutlLogger.pas b/uutlLogger.pas index 55047f5..80a5353 100644 --- a/uutlLogger.pas +++ b/uutlLogger.pas @@ -44,7 +44,7 @@ type procedure WriteLog(const aLogger: TutlLogger; const aTime:TDateTime; const aLevel:TutlLogLevel; const aSender: string; const aMessage: String); end; - TutlLogConsumerList = specialize TutlInterfaceList; + TutlLogConsumerList = specialize TutlList; { TutlLogger } @@ -431,7 +431,7 @@ begin fConsumersLock.Acquire; try for ll:= low(ll) to high(ll) do begin - fConsumers[ll]:= TutlLogConsumerList.Create; + fConsumers[ll]:= TutlLogConsumerList.Create(true); end; finally fConsumersLock.Release; diff --git a/uutlObservable.pas b/uutlObservable.pas new file mode 100644 index 0000000..bab42dd --- /dev/null +++ b/uutlObservable.pas @@ -0,0 +1,288 @@ +unit uutlObservable; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + uutlGenerics, uutlInterfaces, uutlEvent, uutlComparer; + +type +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlObservableEventType = ( + oetAdd, + oetRemove, + oetReplace, + oetClear + ); + + TutlObservableEventArgs = class(TutlEventArgs) + private + fEventType: TutlObservableEventType; + + public + property EventType: TutlObservableEventType read fEventType; + + constructor Create(const aEventType: TutlObservableEventType); + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlObservableItemEventArgs = class(TutlObservableEventArgs) + private + fItem: T; + + public + property Item: T read fItem; + + constructor Create(const aEventType: TutlObservableEventType; constref aItem: T); + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlObservableReplaceEventArgs = class(TutlObservableEventArgs) + private + fOldItem: T; + fNewItem: T; + + public + property OldItem: T read fOldItem; + property NewItem: T read fNewItem; + + constructor Create(const aEventType: TutlObservableEventType; constref aOldItem: T; constref aNewItem: T); + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlObservableCustomList = class( + specialize TutlCustomList + , specialize IutlObservable) + + private type + TEventHandlerList = specialize TutlEventList; + + public type + TItemEventArgs = class(specialize TutlObservableItemEventArgs) + private + fIndex: Integer; + public + property Index: Integer read fIndex; + constructor Create(const aEventType: TutlObservableEventType; const aIndex: Integer; constref aItem: T); + end; + + TReplaceEventArgs = class(specialize TutlObservableReplaceEventArgs) + private + fIndex: Integer; + public + property Index: Integer read fIndex; + constructor Create(const aEventType: TutlObservableEventType; const aIndex: Integer; constref aOldItem: T; constref aNewItem: T); + end; + + private + fEventHandler: TEventHandlerList; + + protected + procedure InsertIntern(const aIndex: Integer; constref aValue: T); override; + procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); override; + + procedure DoAddItem (const aIndex: Integer; constref aItem: T); virtual; + procedure DoRemoveItem(const aIndex: Integer; constref aItem: T); virtual; + procedure DoChangeItem(const aIndex: Integer; constref aOldItem: T; constref aNewItem: T); virtual; + procedure DoClear (); virtual; + + public { IutlObservable } + procedure RegisterEventHandler (const aHandler: TutlEventHandler); + procedure UnregisterEventHandler(const aHandler: TutlEventHandler); + + protected + procedure SetItem(const aIndex: Integer; aValue: T); override; + + public + procedure Clear; override; + + constructor Create( + aEqualityComparer: IEqualityComparer; + aOwnsObjects: Boolean = true); + destructor Destroy; override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlObservableList = class(specialize TutlObservableCustomList) + public type + TEqualityComparer = specialize TutlEqualityComparer; + + public + constructor Create(const aOwnsObjects: Boolean); + end; + +implementation + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlObservableEventArgs/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlObservableEventArgs.Create(const aEventType: TutlObservableEventType); +begin + inherited Create; + fEventType := aEventType; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlObservableItemEventArgs/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlObservableItemEventArgs.Create(const aEventType: TutlObservableEventType; constref aItem: T); +begin + inherited Create(aEventType); + fItem := aItem; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlObservableChangeEventArgs///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlObservableReplaceEventArgs.Create(const aEventType: TutlObservableEventType; constref aOldItem: T; constref aNewItem: T); +begin + inherited Create(aEventType); + fOldItem := aOldItem; + fNewItem := aNewItem; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlObservableCustomList.TChangeEventArgs///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlObservableCustomList.TReplaceEventArgs.Create( + const aEventType: TutlObservableEventType; + const aIndex: Integer; + constref aOldItem: T; + constref aNewItem: T); +begin + inherited Create(aEventType, aOldItem, aNewItem); + fIndex := aIndex; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlObservableCustomList.TItemEventArgs/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlObservableCustomList.TItemEventArgs.Create( + const aEventType: TutlObservableEventType; + const aIndex: Integer; + constref aItem: T); +begin + inherited Create(aEventType, aItem); + fIndex := aIndex; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlObservableCustomList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.InsertIntern(const aIndex: Integer; constref aValue: T); +begin + inherited InsertIntern(aIndex, aValue); + DoAddItem(aIndex, aValue); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); +begin + DoRemoveItem(aIndex, GetItem(aIndex)); + inherited DeleteIntern(aIndex, aFreeItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.DoAddItem(const aIndex: Integer; constref aItem: T); +var + args: IutlEventArgs; + e: TutlEventHandler; +begin + if not Assigned(fEventHandler) or fEventHandler.IsEmpty then + exit; + args := TItemEventArgs.Create(oetAdd, aIndex, aItem); + for e in fEventHandler do + e(self, args); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.DoRemoveItem(const aIndex: Integer; constref aItem: T); +var + args: IutlEventArgs; + e: TutlEventHandler; +begin + if not Assigned(fEventHandler) or fEventHandler.IsEmpty then + exit; + args := TItemEventArgs.Create(oetRemove, aIndex, aItem); + for e in fEventHandler do + e(self, args); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.DoChangeItem(const aIndex: Integer; constref aOldItem: T; constref aNewItem: T); +var + args: IutlEventArgs; + e: TutlEventHandler; +begin + if not Assigned(fEventHandler) or fEventHandler.IsEmpty then + exit; + args := TReplaceEventArgs.Create(oetReplace, aIndex, aOldItem, aNewItem); + for e in fEventHandler do + e(self, args); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.DoClear; +var + args: IutlEventArgs; + e: TutlEventHandler; +begin + if not Assigned(fEventHandler) or fEventHandler.IsEmpty then + exit; + args := TutlObservableEventArgs.Create(oetClear); + for e in fEventHandler do + e(self, args); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.RegisterEventHandler(const aHandler: TutlEventHandler); +begin + fEventHandler.Add(aHandler); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.UnregisterEventHandler(const aHandler: TutlEventHandler); +begin + fEventHandler.Remove(aHandler); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.SetItem(const aIndex: Integer; aValue: T); +begin + DoChangeItem(aIndex, GetItem(aIndex), aValue); + inherited SetItem(aIndex, aValue); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlObservableCustomList.Clear; +begin + DoClear(); + inherited Clear; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlObservableCustomList.Create(aEqualityComparer: IEqualityComparer; aOwnsObjects: Boolean); +begin + fEventHandler := TEventHandlerList.Create; + inherited Create(aEqualityComparer, aOwnsObjects); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlObservableCustomList.Destroy; +begin + inherited Destroy; + FreeAndNil(fEventHandler); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlObservableList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlObservableList.Create(const aOwnsObjects: Boolean); +begin + inherited Create(TEqualityComparer.Create, aOwnsObjects); +end; + +end. + diff --git a/uutlStreamHelper.pas b/uutlStreamHelper.pas index f98c1c2..4267477 100644 --- a/uutlStreamHelper.pas +++ b/uutlStreamHelper.pas @@ -11,196 +11,230 @@ unit uutlStreamHelper; interface uses - SysUtils, Classes, Contnrs, syncobjs; + SysUtils, Classes, syncobjs, + uutlGenerics; type +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TutlFourCC = string[4]; - - { TutlStreamUtility } - TutlStreamUtility = class + private type + TPositionStack = specialize TutlStack; + private - FStream: TStream; - FOwnsStream: boolean; - FPositions: TStack; - protected + fStream: TStream; + fOwnsStream: Boolean; + fPositions: TPositionStack; + public - constructor Create(BaseStream: TStream; OwnsStream: Boolean=false); - destructor Destroy; override; property Stream: TStream read FStream; + procedure Push; procedure Pop; procedure Drop; - end; - { TutlStreamReader } + constructor Create(const aBaseStream: TStream; const aOwnsStream: Boolean); + destructor Destroy; override; + end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TutlStreamReader = class(TutlStreamUtility) protected - function ReadBuffer(Var Buffer; Size: int64): int64; + function ReadBuffer(var Buffer; Size: int64): int64; + public - function ReadFourCC: TutlFourCC; - function CheckFourCC(Correct: TutlFourCC): boolean; - function ReadByte: Byte; - function ReadWord: Word; - function ReadCardinal: Cardinal; - function ReadInteger: Integer; - function ReadInt64: Int64; - function ReadSingle: Single; - function ReadDouble: Double; - function ReadAnsiString: AnsiString; - function ReadLine: AnsiString; - function IsEOF: boolean; + function ReadFourCC: TutlFourCC; inline; + function CheckFourCC (constref Correct: TutlFourCC): boolean; inline; + function ReadByte: Byte; inline; + function ReadWord: Word; inline; + function ReadCardinal: Cardinal; inline; + function ReadInteger: Integer; inline; + function ReadInt64: Int64; inline; + function ReadSingle: Single; inline; + function ReadDouble: Double; inline; + function ReadAnsiString: AnsiString; inline; + function ReadLine: AnsiString; + function IsEOF: boolean; inline; end; - { TutlStreamWriter } - +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TutlStreamWriter = class(TutlStreamUtility) protected procedure WriteBuffer(var Data; Size: int64); + public - procedure WriteFourCC(FCC: TutlFourCC); - procedure WriteByte(A: Byte); - procedure WriteWord(A: Word); - procedure WriteCardinal(A: Cardinal); - procedure WriteInteger(A: Integer); - procedure WriteInt64(A: Int64); - procedure WriteSingle(A: Single); - procedure WriteDouble(A: Double); - procedure WriteAnsiString(A: AnsiString); - procedure WriteAnsiBytes(A: AnsiString); - procedure WriteLine(A: AnsiString); + procedure WriteFourCC (FCC: TutlFourCC); inline; + procedure WriteByte (A: Byte); inline; + procedure WriteWord (A: Word); inline; + procedure WriteCardinal (A: Cardinal); inline; + procedure WriteInteger (A: Integer); inline; + procedure WriteInt64 (A: Int64); inline; + procedure WriteSingle (A: Single); inline; + procedure WriteDouble (A: Double); inline; + procedure WriteAnsiString (A: AnsiString); inline; + procedure WriteAnsiBytes (A: AnsiString); inline; + procedure WriteLine (A: AnsiString); inline; end; - { TutlPagedBufferStream } +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlStreamHelper = class + private + class function ReadBuffer (constref aStream: TStream; var Buffer; Size: int64): int64; + class procedure WriteBuffer (constref aStream: TStream; var Data; Size: int64); + + public + class function ReadFourCC (constref aStream: TStream): TutlFourCC; inline; + class function CheckFourCC (constref aStream: TStream; Correct: TutlFourCC): boolean; inline; + class function ReadByte (constref aStream: TStream): Byte; inline; + class function ReadWord (constref aStream: TStream): Word; inline; + class function ReadCardinal (constref aStream: TStream): Cardinal; inline; + class function ReadInteger (constref aStream: TStream): Integer; inline; + class function ReadInt64 (constref aStream: TStream): Int64; inline; + class function ReadSingle (constref aStream: TStream): Single; inline; + class function ReadDouble (constref aStream: TStream): Double; inline; + class function ReadAnsiString (constref aStream: TStream): AnsiString; inline; + class function ReadLine (constref aStream: TStream): AnsiString; + class function IsEOF (constref aStream: TStream): boolean; inline; + + public + class procedure WriteFourCC (constref aStream: TStream; FCC: TutlFourCC); inline; + class procedure WriteByte (constref aStream: TStream; A: Byte); inline; + class procedure WriteWord (constref aStream: TStream; A: Word); inline; + class procedure WriteCardinal (constref aStream: TStream; A: Cardinal); inline; + class procedure WriteInteger (constref aStream: TStream; A: Integer); inline; + class procedure WriteInt64 (constref aStream: TStream; A: Int64); inline; + class procedure WriteSingle (constref aStream: TStream; A: Single); inline; + class procedure WriteDouble (constref aStream: TStream; A: Double); inline; + class procedure WriteAnsiString (constref aStream: TStream; A: AnsiString); inline; + class procedure WriteAnsiBytes (constref aStream: TStream; A: AnsiString); inline; + class procedure WriteLine (constref aStream: TStream; A: AnsiString); inline; + end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TutlPagedBufferStream = class(TOwnerStream) public const DEFAULT_BUFLEN = 4096*16; + private FVirtualSize, FVirtualPosition: Int64; FBuffer: TBytes; FBufferStart: Int64; FBufferModified: boolean; + protected - function GetSize: Int64; override; + function GetSize: Int64; override; procedure SetSize(const NewSize: Int64); override; procedure ReMapBuffer; procedure FlushBuffer; + public - constructor Create(const BaseStream: TStream; const BufferSize: Cardinal = DEFAULT_BUFLEN; const aOwnsStream: Boolean = false); - destructor Destroy; override; function Read(var Buffer; Count: Integer): Integer; override; function Write(const Buffer; Count: Integer): Integer; override; function Seek(Offset: Integer; Origin: Word): Integer; override; - end; - { TutlFIFOStream } + constructor Create(const BaseStream: TStream; const BufferSize: Cardinal = DEFAULT_BUFLEN; const aOwnsStream: Boolean = false); + destructor Destroy; override; + end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TutlFIFOStream = class(TStream) - private const MAX_PAGE_SIZE = 4096; + private const + MAX_PAGE_SIZE = 4096; + private type PPage = ^TPage; TPage = record Next: PPage; Data: packed array[0..MAX_PAGE_SIZE-1] of byte; end; + private fLockFree: boolean; fPageFirst, fPageLast: PPage; fReadPtr, fWritePtr: Cardinal; fTotalSize: Int64; fDataLock: TCriticalSection; + protected function GetSize: Int64; override; + public - constructor Create(const aLockFree: boolean = false); - destructor Destroy; override; - function Read(var Buffer; Count: Longint): Longint; override; - function Reserve(var Buffer; Count: Longint): Longint; - function Discard(Count: Longint): Longint; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const {%H-}Offset: Int64; {%H-}Origin: TSeekOrigin): Int64; override; overload; + property LockFree: boolean read fLockFree; + + function Read (var Buffer; Count: Longint): Longint; override; + function Reserve (var Buffer; Count: Longint): Longint; + function Discard (Count: Longint): Longint; + function Write (const Buffer; Count: Longint): Longint; override; + function Seek (const {%H-}Offset: Int64; {%H-}Origin: TSeekOrigin): Int64; override; overload; + procedure BeginOperation; procedure EndOperation; procedure Clear; - property LockFree: boolean read fLockFree; + + constructor Create(const aLockFree: boolean = false); + destructor Destroy; override; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TutlBase64Decoder = class(TStringStream) public const CODE64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; PADDING_CHARACTER = '='; - protected + public function Read(var Buffer; Count: Longint): Longint; override; - function Decode(const aOutput: TStream): boolean; + function Decode(const aOutput: TStream): Boolean; + constructor Create; end; implementation -uses RtlConsts, uutlExceptions, Math; - -type - TPositionData = class - Position: Int64; - constructor Create(Pos: Int64); - end; - -constructor TPositionData.Create(Pos: Int64); -begin - inherited Create; - Position:= Pos; -end; - -{ TutlStreamUtility } +uses + RtlConsts, Math; -constructor TutlStreamUtility.Create(BaseStream: TStream; OwnsStream: Boolean); +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlStreamUtility///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlStreamUtility.Pop; begin - inherited Create; - FStream:= BaseStream; - FOwnsStream:= OwnsStream; - FPositions:= TStack.Create; + FStream.Position := fPositions.Pop; end; -destructor TutlStreamUtility.Destroy; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlStreamUtility.Drop; begin - if FOwnsStream then - FreeAndNil(FStream) - else - FStream:= nil; - while FPositions.AtLeast(1) do - TPositionData(FPositions.Pop).Free; - FreeAndNil(FPositions); - inherited; + fPositions.Pop; end; -procedure TutlStreamUtility.Pop; -var - p: TPositionData; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlStreamUtility.Push; begin - p:= TPositionData(FPositions.Pop); - FStream.Position:= p.Position; - p.Free; + FPositions.Push(FStream.Position); end; -procedure TutlStreamUtility.Drop; -var - p: TPositionData; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlStreamUtility.Create(const aBaseStream: TStream; const aOwnsStream: Boolean); begin - p:= TPositionData(FPositions.Pop); - if Assigned(p) then - p.Free; + inherited Create; + fStream := aBaseStream; + fOwnsStream := aOwnsStream; + fPositions := TPositionStack.Create(true); end; -procedure TutlStreamUtility.Push; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlStreamUtility.Destroy; begin - FPositions.Push(TPositionData.Create(FStream.Position)); + if FOwnsStream + then FreeAndNil(fStream) + else fStream:= nil; + FreeAndNil(FPositions); + inherited; end; -{ TutlStreamReader } - +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlStreamReader////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.ReadBuffer(var Buffer; Size: int64): int64; begin if (FStream.Position + Size > FStream.Size) then @@ -208,269 +242,376 @@ begin Result:= FStream.Read(Buffer, Size); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.ReadFourCC: TutlFourCC; begin SetLength(Result, 4); ReadBuffer(Result[1], 4); end; -function TutlStreamReader.CheckFourCC(Correct: TutlFourCC): boolean; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlStreamReader.CheckFourCC(constref Correct: TutlFourCC): boolean; begin - Result:= ReadFourCC=Correct; + Result := ReadFourCC=Correct; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.ReadByte: Byte; begin ReadBuffer(Result{%H-}, Sizeof(Result)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.ReadWord: Word; begin ReadBuffer(Result{%H-}, Sizeof(Result)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.ReadCardinal: Cardinal; begin ReadBuffer(Result{%H-}, Sizeof(Result)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.ReadInteger: Integer; begin ReadBuffer(Result{%H-}, Sizeof(Result)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.ReadInt64: Int64; begin ReadBuffer(Result{%H-}, Sizeof(Result)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.ReadSingle: Single; begin ReadBuffer(Result{%H-}, Sizeof(Result)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.ReadDouble: Double; begin ReadBuffer(Result{%H-}, Sizeof(Result)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.ReadAnsiString: AnsiString; begin SetLength(Result, ReadCardinal); ReadBuffer(Result[1], Length(Result)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.ReadLine: AnsiString; -const - READ_LENGTH = 80; -var - rp, rl: integer; - cp: PAnsiChar; - bpos: Int64; - r: integer; - EOF: Boolean; - - procedure ReadSome; - begin - SetLength(Result, rl + READ_LENGTH); - r:= FStream.Read(Result[rl + 1], READ_LENGTH); - inc(rl, r); - EOF:= r <> READ_LENGTH; - cp:= @Result[rp]; - end; - begin - Result:= ''; - rl:= 0; - bpos:= FStream.Position; - repeat - rp:= rl + 1; - ReadSome; - while rp <= rl do begin - if cp^ in [#10, #13] then begin - inc(bpos, rp); - // never a second char after #10 - if cp^ = #13 then begin - if (rp = rl) and not EOF then begin - ReadSome; - end; - if (rp <= rl) then begin - inc(cp); - if cp^ = #10 then - inc(bpos); - end; - end; - FStream.Position:= bpos; - SetLength(Result, rp-1); - Exit; - end; - inc(cp); - inc(rp); - end; - until EOF; - SetLength(Result, rl); + result := TutlStreamHelper.ReadLine(fStream); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlStreamReader.IsEOF: boolean; begin - Result:= FStream.Position = FStream.Size; + Result := FStream.Position = FStream.Size; end; - -{ TutlStreamWriter } - +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlStreamWriter////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteBuffer(var Data; Size: int64); begin FStream.Write(Data, Size); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteFourCC(FCC: TutlFourCC); begin WriteBuffer(FCC[1], 4); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteByte(A: Byte); begin WriteBuffer(A, SizeOf(a)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteWord(A: Word); begin WriteBuffer(A, SizeOf(a)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteCardinal(A: Cardinal); begin WriteBuffer(A, SizeOf(a)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteInteger(A: Integer); begin WriteBuffer(A, SizeOf(a)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteInt64(A: Int64); begin WriteBuffer(A, SizeOf(a)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteSingle(A: Single); begin WriteBuffer(A, SizeOf(a)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteDouble(A: Double); begin WriteBuffer(A, SizeOf(a)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteAnsiString(A: AnsiString); begin WriteCardinal(Length(A)); WriteBuffer(A[1], Length(a)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteAnsiBytes(A: AnsiString); begin WriteBuffer(A[1], Length(A)); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlStreamWriter.WriteLine(A: AnsiString); begin WriteAnsiBytes(A + sLineBreak); end; -{ TutlPagedBufferStream } +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlStreamHelper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlStreamHelper.ReadBuffer(constref aStream: TStream; var Buffer; Size: int64): int64; +begin + if (aStream.Position + Size > aStream.Size) then + raise EInvalidOperation.Create('stream is to small'); + Result := aStream.Read(Buffer, Size); +end; -constructor TutlPagedBufferStream.Create(const BaseStream: TStream; const BufferSize: Cardinal; - const aOwnsStream: Boolean); +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteBuffer(constref aStream: TStream; var Data; Size: int64); begin - inherited Create(BaseStream); - SourceOwner:= aOwnsStream; - SetLength(FBuffer, BufferSize); - FVirtualPosition:= 0; - FVirtualSize:= Source.Size; - FBufferStart:= -1; - ReMapBuffer; + aStream.Write(Data, Size); end; -destructor TutlPagedBufferStream.Destroy; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlStreamHelper.ReadFourCC(constref aStream: TStream): TutlFourCC; begin - FlushBuffer; - SetLength(FBuffer, 0); - inherited; + SetLength(Result, 4); + ReadBuffer(aStream, Result[1], 4); end; -function TutlPagedBufferStream.Seek(Offset: Integer; Origin: Word): Integer; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlStreamHelper.CheckFourCC(constref aStream: TStream; Correct: TutlFourCC): boolean; begin - case Origin of - soFromBeginning: FVirtualPosition := Offset; - soFromCurrent: Inc(FVirtualPosition, Offset); - soFromEnd: FVirtualPosition := Size + Offset; - end; - ReMapBuffer; - Result := FVirtualPosition; + result := (ReadFourCC(aStream) = Correct); end; -function TutlPagedBufferStream.GetSize: Int64; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlStreamHelper.ReadByte(constref aStream: TStream): Byte; begin - Result:= FVirtualSize; + ReadBuffer(aStream, result{%H-}, SizeOf(result)); end; -procedure TutlPagedBufferStream.SetSize(const NewSize: Int64); +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlStreamHelper.ReadWord(constref aStream: TStream): Word; begin - FVirtualSize:= NewSize; - Source.Size:= NewSize; - if Position > FVirtualSize then - Position:= FVirtualSize; + ReadBuffer(aStream, result{%H-}, SizeOf(result)); end; -function TutlPagedBufferStream.Write(const Buffer; Count: Integer): Integer; -var - bw, c: Int64; - bp: Pointer; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlStreamHelper.ReadCardinal(constref aStream: TStream): Cardinal; begin - bw:= 0; - bp:= @Buffer; - while (bw < Count) do begin - ReMapBuffer; - // Wie viel Daten können wir schreiben? - c:= Min(Count - bw, Length(FBuffer) - (FVirtualPosition-FBufferStart)); + ReadBuffer(aStream, result{%H-}, SizeOf(result)); +end; - // das schreiben und buffer weiterschieben - Move(bp^, FBuffer[FVirtualPosition-FBufferStart], c); - Inc(Bp, c); - Inc(bw, c); - Inc(FVirtualPosition, c); - if FVirtualPosition > FVirtualSize then - FVirtualSize:= FVirtualPosition; - end; - if bw > 0 then - FBufferModified:= true; - Result:= bw; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlStreamHelper.ReadInteger(constref aStream: TStream): Integer; +begin + ReadBuffer(aStream, result{%H-}, SizeOf(result)); end; -function TutlPagedBufferStream.Read(var Buffer; Count: Integer): Integer; -var - br, c: Int64; - bp: Pointer; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlStreamHelper.ReadInt64(constref aStream: TStream): Int64; begin - br:= 0; - bp:= @Buffer; - while (br < Count) and (FVirtualPosition READ_LENGTH; + cp:= @Result[rp]; end; - Result:= br; + +begin + Result := ''; + rl := 0; + bpos := aStream.Position; + repeat + rp := rl + 1; + ReadSome; + while rp <= rl do begin + if cp^ in [#10, #13] then begin + inc(bpos, rp); + // never a second char after #10 + if cp^ = #13 then begin + if (rp = rl) and not EOF then begin + ReadSome; + end; + if (rp <= rl) then begin + inc(cp); + if cp^ = #10 then + inc(bpos); + end; + end; + aStream.Position := bpos; + SetLength(Result, rp-1); + Exit; + end; + inc(cp); + inc(rp); + end; + until EOF; + SetLength(Result, rl); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlStreamHelper.IsEOF(constref aStream: TStream): boolean; +begin + Result := aStream.Position = aStream.Size; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteFourCC(constref aStream: TStream; FCC: TutlFourCC); +begin + WriteBuffer(aStream, FCC[1], 4); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteByte(constref aStream: TStream; A: Byte); +begin + WriteBuffer(aStream, a, SizeOf(a)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteWord(constref aStream: TStream; A: Word); +begin + WriteBuffer(aStream, a, SizeOf(a)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteCardinal(constref aStream: TStream; A: Cardinal); +begin + WriteBuffer(aStream, a, SizeOf(a)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteInteger(constref aStream: TStream; A: Integer); +begin + WriteBuffer(aStream, a, SizeOf(a)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteInt64(constref aStream: TStream; A: Int64); +begin + WriteBuffer(aStream, a, SizeOf(a)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteSingle(constref aStream: TStream; A: Single); +begin + WriteBuffer(aStream, a, SizeOf(a)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteDouble(constref aStream: TStream; A: Double); +begin + WriteBuffer(aStream, a, SizeOf(a)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteAnsiString(constref aStream: TStream; A: AnsiString); +begin + WriteCardinal(aStream, Length(A)); + WriteBuffer(aStream, A[1], Length(a)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteAnsiBytes(constref aStream: TStream; A: AnsiString); +begin + WriteBuffer(aStream, A[1], Length(a)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlStreamHelper.WriteLine(constref aStream: TStream; A: AnsiString); +begin + WriteAnsiBytes(aStream, A + sLineBreak); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlPagedBufferStream///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlPagedBufferStream.GetSize: Int64; +begin + Result:= FVirtualSize; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlPagedBufferStream.SetSize(const NewSize: Int64); +begin + FVirtualSize:= NewSize; + Source.Size:= NewSize; + if Position > FVirtualSize then + Position:= FVirtualSize; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlPagedBufferStream.ReMapBuffer; var newbs: Int64; @@ -490,6 +631,7 @@ begin end; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlPagedBufferStream.FlushBuffer; var towrite: Int64; @@ -503,34 +645,98 @@ begin Source.WriteBuffer(FBuffer[0], towrite); end; -{ TutlFIFOStream } +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlPagedBufferStream.Read(var Buffer; Count: Integer): Integer; +var + br, c: Int64; + bp: Pointer; +begin + br:= 0; + bp:= @Buffer; + while (br < Count) and (FVirtualPosition FVirtualSize then + FVirtualSize:= FVirtualPosition; + end; + if bw > 0 then + FBufferModified:= true; + Result:= bw; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlPagedBufferStream.Seek(Offset: Integer; Origin: Word): Integer; begin - inherited Create; - fDataLock:= TCriticalSection.Create; - fTotalSize:= 0; - New(fPageFirst); - fPageFirst^.Next:= nil; - fPageLast:= fPageFirst; - fReadPtr:= 0; - fWritePtr:= 0; - fLockFree:= aLockFree; + case Origin of + soFromBeginning: FVirtualPosition := Offset; + soFromCurrent: Inc(FVirtualPosition, Offset); + soFromEnd: FVirtualPosition := Size + Offset; + end; + ReMapBuffer; + Result := FVirtualPosition; end; -destructor TutlFIFOStream.Destroy; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlPagedBufferStream.Create( + const BaseStream: TStream; + const BufferSize: Cardinal; + const aOwnsStream: Boolean); begin - Clear; - Dispose(fPageFirst); - FreeAndNil(fDataLock); - inherited Destroy; + inherited Create(BaseStream); + SourceOwner:= aOwnsStream; + SetLength(FBuffer, BufferSize); + FVirtualPosition:= 0; + FVirtualSize:= Source.Size; + FBufferStart:= -1; + ReMapBuffer; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlPagedBufferStream.Destroy; +begin + FlushBuffer; + SetLength(FBuffer, 0); + inherited; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlFIFOStream//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlFIFOStream.GetSize: Int64; begin Result:= fTotalSize; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlFIFOStream.Read(var Buffer; Count: Longint): Longint; begin BeginOperation; @@ -542,6 +748,7 @@ begin end; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlFIFOStream.Reserve(var Buffer; Count: Longint): Longint; var pbuf: PByteArray; @@ -574,6 +781,7 @@ begin end; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlFIFOStream.Discard(Count: Longint): Longint; var mx: LongInt; @@ -605,6 +813,7 @@ begin end; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlFIFOStream.Write(const Buffer; Count: Longint): Longint; var mx: LongInt; @@ -635,24 +844,28 @@ begin end; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlFIFOStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; begin Result:= 0; raise EStreamError.CreateFmt(SStreamInvalidSeek,[ClassName]); end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlFIFOStream.BeginOperation; begin if not fLockFree then fDataLock.Acquire; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlFIFOStream.EndOperation; begin if not fLockFree then fDataLock.Release; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlFIFOStream.Clear; var p: PPage; @@ -672,13 +885,38 @@ begin end; end; -{ TutlBase64Decoder } +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlFIFOStream.Create(const aLockFree: boolean); +begin + inherited Create; + fDataLock:= TCriticalSection.Create; + fTotalSize:= 0; + New(fPageFirst); + fPageFirst^.Next:= nil; + fPageLast:= fPageFirst; + fReadPtr:= 0; + fWritePtr:= 0; + fLockFree:= aLockFree; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlFIFOStream.Destroy; +begin + Clear; + Dispose(fPageFirst); + FreeAndNil(fDataLock); + inherited Destroy; +end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlBase64Decoder///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlBase64Decoder.{%H-}Read(var Buffer; Count: Longint): Longint; begin ReadNotImplemented; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlBase64Decoder.Decode(const aOutput: TStream): boolean; var a: Integer; @@ -709,10 +947,10 @@ begin Result:= true; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlBase64Decoder.Create; begin inherited Create(''); end; - end. diff --git a/uutlSyncObjs.pas b/uutlSyncObjs.pas index a4ab98d..b145f26 100644 --- a/uutlSyncObjs.pas +++ b/uutlSyncObjs.pas @@ -5,71 +5,209 @@ unit uutlSyncObjs; interface uses - Classes, SysUtils, syncobjs; + Classes, SysUtils, syncobjs, + uutlGenerics; type +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlCheckSynchronizeEvent = class(TObject) + private + fEvent: TEvent; + + function WaitMainThread(const aTimeout: Cardinal): TWaitResult; + + public const + MAIN_WAIT_GRANULARITY = 10; + + public + procedure SetEvent; + procedure ResetEvent; + function WaitFor(const aTimeout: Cardinal): TWaitResult; + + constructor Create( + const aEventAttributes: PSecurityAttributes; + const aManualReset: Boolean; + const aInitialState: Boolean; + const aName: string); + destructor Destroy; override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlEventList = class(specialize TutlSimpleList) + public + function AddEvent( + const aEventAttributes: PSecurityAttributes; + const aManualReset: Boolean; + const aInitialState: Boolean; + const aName: String): TutlCheckSynchronizeEvent; + function AddDefaultEvent: TutlCheckSynchronizeEvent; + function WaitAll(const aTimeout: Cardinal): TWaitResult; + + constructor Create; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TAutoResetEvent = class(TEvent) public - constructor Create(aInitial: boolean = false); + constructor Create(const aInitial: boolean = false); end; // aliased to stay in LCL naming scheme for TSimpleEvent TutlAutoResetEvent = TAutoResetEvent; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TutlSpinLock = class private fLock: DWord; fLockReused: integer; + public - constructor Create; - destructor Destroy; override; procedure Enter; procedure Leave; + + constructor Create; + destructor Destroy; override; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic IutlLock = interface(IUnknown) function LockedObject: T; end; - generic TutlLock = class(TInterfacedObject, specialize IutlLock) +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlLock = class( + TInterfacedObject, + specialize IutlLock) private fLock: TCriticalSection; fObject: T; + public - function LockedObject: T; + function LockedObject: T; inline; + constructor Create(const aLock: TCriticalSection; const aObject: T); destructor Destroy; override; end; implementation -{ TAutoResetEvent } +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCheckSynchronizeEvent///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCheckSynchronizeEvent.WaitMainThread(const aTimeout: Cardinal): TWaitResult; +var + timeout: qword; +begin + timeout:= GetTickCount64 + aTimeout; + repeat + result := fEvent.WaitFor(TutlCheckSynchronizeEvent.MAIN_WAIT_GRANULARITY); + CheckSynchronize(); + until (result <> wrTimeout) or ((GetTickCount64 > timeout) and (aTimeout <> INFINITE)); +end; -constructor TAutoResetEvent.Create(aInitial: boolean); +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlCheckSynchronizeEvent.SetEvent; begin - inherited Create(Nil, false, aInitial, ''); + fEvent.SetEvent; end; -{ TutlSpinLock } +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlCheckSynchronizeEvent.ResetEvent; +begin + fEvent.ResetEvent; +end; -constructor TutlSpinLock.Create; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCheckSynchronizeEvent.WaitFor(const aTimeout: Cardinal): TWaitResult; +begin + if (GetCurrentThreadId = MainThreadID) then + result := WaitMainThread(aTimeout) + else + result := fEvent.WaitFor(aTimeout); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlCheckSynchronizeEvent.Create( + const aEventAttributes: PSecurityAttributes; + const aManualReset: Boolean; + const aInitialState: Boolean; + const aName: string); begin inherited Create; - fLock:= 0; - fLockReused:= 0; + fEvent := TEvent.Create(aEventAttributes, aManualReset, aInitialState, aName); end; -destructor TutlSpinLock.Destroy; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlCheckSynchronizeEvent.Destroy; begin - Enter; + FreeAndNil(fEvent); inherited Destroy; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlEventList///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventList.AddEvent( + const aEventAttributes: PSecurityAttributes; + const aManualReset: Boolean; + const aInitialState: Boolean; + const aName: String): TutlCheckSynchronizeEvent; +begin + result := TutlCheckSynchronizeEvent.Create(aEventAttributes, aManualReset, aInitialState, aName); + Add(result); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventList.AddDefaultEvent: TutlCheckSynchronizeEvent; +begin + result := AddEvent(nil, true, false, ''); + result.ResetEvent; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventList.WaitAll(const aTimeout: Cardinal): TWaitResult; +var + i: integer; + timeout, tick: qword; +begin + timeout := GetTickCount64 + aTimeout; + for i := 0 to Count-1 do begin + if (aTimeout <> INFINITE) then begin + tick := GetTickCount64; + if (tick >= timeout) then begin + result := wrTimeout; + exit; + end else + result := Items[i].WaitFor(timeout - tick); + end else + result := Items[i].WaitFor(INFINITE); + if result <> wrSignaled then + exit; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventList.Create; +begin + inherited Create(true); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TAutoResetEvent/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TAutoResetEvent.Create(const aInitial: boolean); +begin + inherited Create(Nil, false, aInitial, ''); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlSpinLock////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlSpinLock.Enter; var - ti: dword; + ti: DWord; begin - ti:= ThreadID; - if ti = InterlockedCompareExchange(fLock, ti, ti) then begin + ti := ThreadID; + if (ti = InterlockedCompareExchange(fLock, ti, ti)) then begin { The lock is already held by this thread. This means it cannot be modified by a concurrent operation (assuming Enter/Leave bracket correctly), and we can act non-atomar on other variables. @@ -80,13 +218,14 @@ begin end; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlSpinLock.Leave; var ti: DWord; begin - ti:= ThreadID; + ti := ThreadID; // Unlock only if we hold the lock - if ti = InterlockedCompareExchange(fLock, ti, ti) then begin + if (ti = InterlockedCompareExchange(fLock, ti, ti)) then begin // our lock, but we haven't yet done anything (note the above is essentially a threadsafe CMP if successful) if fLockReused = 0 then InterLockedExchange(fLock, 0) // normal lock @@ -95,21 +234,41 @@ begin end; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlSpinLock.Create; +begin + inherited Create; + fLock := 0; + fLockReused := 0; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlSpinLock.Destroy; +begin + Enter; + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlLock////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlLock.LockedObject: T; begin result := fObject; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlLock.Create(const aLock: TCriticalSection; const aObject: T); begin inherited Create; if not Assigned(aLock) then raise EArgumentNilException.Create('aLock'); + fObject := aObject; fLock := aLock; fLock.Enter; - fObject := aObject; end; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TutlLock.Destroy; begin fLock.Leave; diff --git a/uutlTypes.pas b/uutlTypes.pas new file mode 100644 index 0000000..a36c72d --- /dev/null +++ b/uutlTypes.pas @@ -0,0 +1,23 @@ +unit uutlTypes; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlArray = array of T; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlPair = packed record + first: T1; + second: T2; + end; + +implementation + +end. + diff --git a/uutlXmlHelper.pas b/uutlXmlHelper.pas index b04d47e..ca790c2 100644 --- a/uutlXmlHelper.pas +++ b/uutlXmlHelper.pas @@ -153,10 +153,7 @@ type public class function Create(const aElement: TDOMElement): IutlXmlHelper; - end; -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// - TutlXmlHelperImpl = class public class function SetString (const aNode: TDOMNode; const aValue: String): TDOMNode; overload; class function SetString (const aNode: TDOMNode; const aValue: WideString): TDOMNode; overload; @@ -200,10 +197,10 @@ function TutlNodeEnumerator.MoveNext: Boolean; begin repeat inc(fIndex) - until (fIndex >= fParent.ChildNodes.Count) + until (fIndex {%H-}>= fParent.ChildNodes.Count) or ( (fName = '') or (fName = fParent.ChildNodes[fIndex].NodeName)); - result := (fIndex < fParent.ChildNodes.Count); + result := (fIndex {%H-}< fParent.ChildNodes.Count); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -232,79 +229,79 @@ end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetString(const aValue: String); begin - TutlXmlHelperImpl.SetString(fElement, aValue); + TutlXmlHelper.SetString(fElement, aValue); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetString(const aValue: WideString); begin - TutlXmlHelperImpl.SetString(fElement, aValue); + TutlXmlHelper.SetString(fElement, aValue); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetString(const aValue: UnicodeString); begin - TutlXmlHelperImpl.SetString(fElement, aValue); + TutlXmlHelper.SetString(fElement, aValue); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetInt(const aValue: Integer); begin - TutlXmlHelperImpl.SetInt(fElement, aValue); + TutlXmlHelper.SetInt(fElement, aValue); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetFloat(const aValue: Double); begin - TutlXmlHelperImpl.SetFloat(fElement, aValue); + TutlXmlHelper.SetFloat(fElement, aValue); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetBool(const aValue: Boolean); begin - TutlXmlHelperImpl.SetBool(fElement, aValue); + TutlXmlHelper.SetBool(fElement, aValue); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetString(const aDefault: String): String; begin - result := TutlXmlHelperImpl.GetString(fElement, aDefault); + result := TutlXmlHelper.GetString(fElement, aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetStringW(const aDefault: WideString): WideString; begin - result := TutlXmlHelperImpl.GetStringW(fElement, aDefault); + result := TutlXmlHelper.GetStringW(fElement, aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetStringU(const aDefault: UnicodeString): UnicodeString; begin - result := TutlXmlHelperImpl.GetStringU(fElement, aDefault); + result := TutlXmlHelper.GetStringU(fElement, aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetInt(const aDefault: Int64): Int64; begin - result := TutlXmlHelperImpl.GetInt(fElement, aDefault); + result := TutlXmlHelper.GetInt(fElement, aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetFloat(const aDefault: Double): Double; begin - result := TutlXmlHelperImpl.GetFloat(fElement, aDefault); + result := TutlXmlHelper.GetFloat(fElement, aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetBool(const aDefault: Boolean): Boolean; begin - result := TutlXmlHelperImpl.GetBool(fElement, aDefault); + result := TutlXmlHelper.GetBool(fElement, aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetAttribString(const aName: DOMString; const aValue: String); begin - fElement.SetAttributeNode(TutlXmlHelperImpl.SetString( + fElement.SetAttributeNode(TutlXmlHelper.SetString( fElement.OwnerDocument.CreateAttribute(aName), aValue) as TDOMAttr); end; @@ -312,7 +309,7 @@ end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetAttribString(const aName: DOMString; const aValue: WideString); begin - fElement.SetAttributeNode(TutlXmlHelperImpl.SetString( + fElement.SetAttributeNode(TutlXmlHelper.SetString( fElement.OwnerDocument.CreateAttribute(aName), aValue) as TDOMAttr); end; @@ -320,7 +317,7 @@ end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetAttribString(const aName: DOMString; const aValue: UnicodeString); begin - fElement.SetAttributeNode(TutlXmlHelperImpl.SetString( + fElement.SetAttributeNode(TutlXmlHelper.SetString( fElement.OwnerDocument.CreateAttribute(aName), aValue) as TDOMAttr); end; @@ -328,7 +325,7 @@ end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetAttribInt(const aName: DOMString; const aValue: Integer); begin - fElement.SetAttributeNode(TutlXmlHelperImpl.SetInt( + fElement.SetAttributeNode(TutlXmlHelper.SetInt( fElement.OwnerDocument.CreateAttribute(aName), aValue) as TDOMAttr); end; @@ -336,7 +333,7 @@ end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetAttribFloat(const aName: DOMString; const aValue: Double); begin - fElement.SetAttributeNode(TutlXmlHelperImpl.SetFloat( + fElement.SetAttributeNode(TutlXmlHelper.SetFloat( fElement.OwnerDocument.CreateAttribute(aName), aValue) as TDOMAttr); end; @@ -344,7 +341,7 @@ end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.SetAttribBool(const aName: DOMString; const aValue: Boolean); begin - fElement.SetAttributeNode(TutlXmlHelperImpl.SetBool( + fElement.SetAttributeNode(TutlXmlHelper.SetBool( fElement.OwnerDocument.CreateAttribute(aName), aValue) as TDOMAttr); end; @@ -352,67 +349,67 @@ end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetAttribString(const aName: DOMString; const aDefault: String): String; begin - result := TutlXmlHelperImpl.GetString(fElement.Attributes.GetNamedItem(aName), aDefault); + result := TutlXmlHelper.GetString(fElement.Attributes.GetNamedItem(aName), aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetAttribStringW(const aName: DOMString; const aDefault: WideString): WideString; begin - result := TutlXmlHelperImpl.GetStringW(fElement.Attributes.GetNamedItem(aName), aDefault); + result := TutlXmlHelper.GetStringW(fElement.Attributes.GetNamedItem(aName), aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetAttribStringU(const aName: DOMString; const aDefault: UnicodeString): UnicodeString; begin - result := TutlXmlHelperImpl.GetStringU(fElement.Attributes.GetNamedItem(aName), aDefault); + result := TutlXmlHelper.GetStringU(fElement.Attributes.GetNamedItem(aName), aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetAttribInt(const aName: DOMString; const aDefault: Int64): Int64; begin - result := TutlXmlHelperImpl.GetInt(fElement.Attributes.GetNamedItem(aName), aDefault); + result := TutlXmlHelper.GetInt(fElement.Attributes.GetNamedItem(aName), aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetAttribFloat(const aName: DOMString; const aDefault: Double): Double; begin - result := TutlXmlHelperImpl.GetFloat(fElement.Attributes.GetNamedItem(aName), aDefault); + result := TutlXmlHelper.GetFloat(fElement.Attributes.GetNamedItem(aName), aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.GetAttribBool(const aName: DOMString; const aDefault: Boolean): Boolean; begin - result := TutlXmlHelperImpl.GetBool(fElement.Attributes.GetNamedItem(aName), aDefault); + result := TutlXmlHelper.GetBool(fElement.Attributes.GetNamedItem(aName), aDefault); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.Nodes(const aName: DOMString): IutlNodeEnumerator; begin - result := TutlXmlHelperImpl.Nodes(fElement, aName); + result := TutlXmlHelper.Nodes(fElement, aName); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.PrependNode(const aName: DOMString): TDOMElement; begin - result := TutlXmlHelperImpl.PrependNode(fElement, aName); + result := TutlXmlHelper.PrependNode(fElement, aName); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlXmlHelper.AppendNode(const aName: DOMString): TDOMElement; begin - result := TutlXmlHelperImpl.AppendNode(fElement, aName); + result := TutlXmlHelper.AppendNode(fElement, aName); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.PrependText(const aText: DOMString); begin - TutlXmlHelperImpl.PrependText(fElement, aText); + TutlXmlHelper.PrependText(fElement, aText); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlXmlHelper.AppendText(const aText: DOMString); begin - TutlXmlHelperImpl.AppendText(fElement, aText); + TutlXmlHelper.AppendText(fElement, aText); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -436,9 +433,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlXmlHelperImpl////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.SetString(const aNode: TDOMNode; const aValue: String): TDOMNode; +class function TutlXmlHelper.SetString(const aNode: TDOMNode; const aValue: String): TDOMNode; begin result := aNode; if Assigned(aNode) then @@ -446,7 +441,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.SetString(const aNode: TDOMNode; const aValue: WideString): TDOMNode; +class function TutlXmlHelper.SetString(const aNode: TDOMNode; const aValue: WideString): TDOMNode; begin result := aNode; if Assigned(aNode) then @@ -454,7 +449,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.SetString(const aNode: TDOMNode; const aValue: UnicodeString): TDOMNode; +class function TutlXmlHelper.SetString(const aNode: TDOMNode; const aValue: UnicodeString): TDOMNode; begin result := aNode; if Assigned(aNode) then @@ -462,7 +457,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.SetInt(const aNode: TDOMNode; const aValue: Integer): TDOMNode; +class function TutlXmlHelper.SetInt(const aNode: TDOMNode; const aValue: Integer): TDOMNode; begin result := aNode; if Assigned(aNode) then @@ -470,7 +465,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.SetFloat(const aNode: TDOMNode; const aValue: Double): TDOMNode; +class function TutlXmlHelper.SetFloat(const aNode: TDOMNode; const aValue: Double): TDOMNode; begin result := aNode; if Assigned(aNode) then @@ -478,7 +473,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.SetBool(const aNode: TDOMNode; const aValue: Boolean): TDOMNode; +class function TutlXmlHelper.SetBool(const aNode: TDOMNode; const aValue: Boolean): TDOMNode; begin result := aNode; if Assigned(aNode) then begin @@ -489,7 +484,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.GetString(const aNode: TDOMNode; const aDefault: String): String; +class function TutlXmlHelper.GetString(const aNode: TDOMNode; const aDefault: String): String; begin if not Assigned(aNode) or ( not aNode.HasChildNodes @@ -499,7 +494,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.GetStringW(const aNode: TDOMNode; const aDefault: WideString): WideString; +class function TutlXmlHelper.GetStringW(const aNode: TDOMNode; const aDefault: WideString): WideString; begin if not Assigned(aNode) or ( not aNode.HasChildNodes @@ -509,7 +504,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.GetStringU(const aNode: TDOMNode; const aDefault: UnicodeString): UnicodeString; +class function TutlXmlHelper.GetStringU(const aNode: TDOMNode; const aDefault: UnicodeString): UnicodeString; begin if not Assigned(aNode) or ( not aNode.HasChildNodes @@ -519,7 +514,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.GetInt(const aNode: TDOMNode; const aDefault: Int64): Int64; +class function TutlXmlHelper.GetInt(const aNode: TDOMNode; const aDefault: Int64): Int64; begin if not Assigned(aNode) or ( not aNode.HasChildNodes @@ -529,7 +524,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.GetFloat(const aNode: TDOMNode; const aDefault: Double): Double; +class function TutlXmlHelper.GetFloat(const aNode: TDOMNode; const aDefault: Double): Double; begin if not Assigned(aNode) or ( not aNode.HasChildNodes @@ -539,7 +534,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.GetBool(const aNode: TDOMNode; const aDefault: Boolean): Boolean; +class function TutlXmlHelper.GetBool(const aNode: TDOMNode; const aDefault: Boolean): Boolean; var s: String; begin @@ -561,13 +556,13 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.Nodes(const aElement: TDOMElement; const aName: DOMString): IutlNodeEnumerator; +class function TutlXmlHelper.Nodes(const aElement: TDOMElement; const aName: DOMString): IutlNodeEnumerator; begin result := TutlNodeEnumerator.Create(aElement, aName); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.PrependNode(const aElement: TDOMElement; const aName: DOMString): TDOMElement; +class function TutlXmlHelper.PrependNode(const aElement: TDOMElement; const aName: DOMString): TDOMElement; begin result := aElement.OwnerDocument.CreateElement(aName); if aElement.HasChildNodes @@ -576,14 +571,14 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlXmlHelperImpl.AppendNode(const aElement: TDOMElement; const aName: DOMString): TDOMElement; +class function TutlXmlHelper.AppendNode(const aElement: TDOMElement; const aName: DOMString): TDOMElement; begin result := aElement.OwnerDocument.CreateElement(aName); aElement.AppendChild(result); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class procedure TutlXmlHelperImpl.PrependText(const aElement: TDOMElement; const aText: DOMString); +class procedure TutlXmlHelper.PrependText(const aElement: TDOMElement; const aText: DOMString); var n: TDOMNode; begin n := aElement.OwnerDocument.CreateTextNode(aText); @@ -593,7 +588,7 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class procedure TutlXmlHelperImpl.AppendText(const aElement: TDOMElement; const aText: DOMString); +class procedure TutlXmlHelper.AppendText(const aElement: TDOMElement; const aText: DOMString); begin aElement.AppendChild(aElement.OwnerDocument.CreateTextNode(aText)); end;