@@ -37,7 +37,7 @@ | |||
<PackageName Value="FCL"/> | |||
</Item3> | |||
</RequiredPackages> | |||
<Units Count="21"> | |||
<Units Count="35"> | |||
<Unit0> | |||
<Filename Value="tests.lpr"/> | |||
<IsPartOfProject Value="True"/> | |||
@@ -55,73 +55,129 @@ | |||
<IsPartOfProject Value="True"/> | |||
</Unit3> | |||
<Unit4> | |||
<Filename Value="..\uutlExceptions.pas"/> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit4> | |||
<Unit5> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<Filename Value="uutlListTest.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit5> | |||
<Unit6> | |||
<Filename Value="uutlListTest.pas"/> | |||
<Filename Value="uutlQueueTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit6> | |||
<Unit7> | |||
<Filename Value="uutlQueueTests.pas"/> | |||
<Filename Value="uutlStackTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit7> | |||
<Unit8> | |||
<Filename Value="uutlStackTests.pas"/> | |||
<Filename Value="uTestHelper.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit8> | |||
<Unit9> | |||
<Filename Value="uTestHelper.pas"/> | |||
<Filename Value="..\uutlComparer.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit9> | |||
<Unit10> | |||
<Filename Value="_uutlInterfaces.pas"/> | |||
<Filename Value="..\uutlAlgorithm.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit10> | |||
<Unit11> | |||
<Filename Value="..\uutlComparer.pas"/> | |||
<Filename Value="uutlHashSetTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit11> | |||
<Unit12> | |||
<Filename Value="..\uutlAlgorithm.pas"/> | |||
<Filename Value="uutlAlgorithmTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit12> | |||
<Unit13> | |||
<Filename Value="uutlHashSetTests.pas"/> | |||
<Filename Value="uutlMapTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit13> | |||
<Unit14> | |||
<Filename Value="uutlArrayTests.pas"/> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit14> | |||
<Unit15> | |||
<Filename Value="uutlAlgorithmTests.pas"/> | |||
<Filename Value="uutlEnumeratorTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit15> | |||
<Unit16> | |||
<Filename Value="uutlMapTests.pas"/> | |||
<Filename Value="..\uutlFilter.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit16> | |||
<Unit17> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Filename Value="..\uutlInterfaces.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit17> | |||
<Unit18> | |||
<Filename Value="uutlEnumeratorTests.pas"/> | |||
<Filename Value="..\uutlLinq.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit18> | |||
<Unit19> | |||
<Filename Value="..\uutlFilter.pas"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit19> | |||
<Unit20> | |||
<Filename Value="..\uutlInterfaces.pas"/> | |||
<Filename Value="..\uutlTypes.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit20> | |||
<Unit21> | |||
<Filename Value="..\uutlSyncObjs.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit21> | |||
<Unit22> | |||
<Filename Value="..\uutlLogger.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit22> | |||
<Unit23> | |||
<Filename Value="..\uutlXmlHelper.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit23> | |||
<Unit24> | |||
<Filename Value="..\uutlStreamHelper.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit24> | |||
<Unit25> | |||
<Filename Value="..\uutlCompression.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit25> | |||
<Unit26> | |||
<Filename Value="..\uutlEmbeddedProfiler.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit26> | |||
<Unit27> | |||
<Filename Value="..\uutlKeyCodes.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit27> | |||
<Unit28> | |||
<Filename Value="..\uutlMCF.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit28> | |||
<Unit29> | |||
<Filename Value="..\uutlSScanf.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit29> | |||
<Unit30> | |||
<Filename Value="..\uutlThreads.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit30> | |||
<Unit31> | |||
<Filename Value="..\uutlEvent.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit31> | |||
<Unit32> | |||
<Filename Value="..\uutlEventManager.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit32> | |||
<Unit33> | |||
<Filename Value="..\uutlObservable.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit33> | |||
<Unit34> | |||
<Filename Value="uutlObservableListTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
</Unit34> | |||
</Units> | |||
</ProjectOptions> | |||
<CompilerOptions> | |||
@@ -150,6 +206,12 @@ | |||
<CompilerMessages> | |||
<IgnoredMessages idx5024="True"/> | |||
</CompilerMessages> | |||
<OtherDefines Count="4"> | |||
<Define0 Value="UTL_ADVANCED_ENUMERATORS"/> | |||
<Define1 Value="UTL_NESTED_PROCVARS"/> | |||
<Define2 Value="UTL_DELPHI_GENERICS"/> | |||
<Define3 Value="UTL_ENUMERATORS"/> | |||
</OtherDefines> | |||
</Other> | |||
</CompilerOptions> | |||
<Debugging> | |||
@@ -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} | |||
@@ -4,402 +4,605 @@ | |||
<PathDelim Value="\"/> | |||
<Version Value="9"/> | |||
<BuildModes Active="Default"/> | |||
<Units Count="34"> | |||
<Units Count="60"> | |||
<Unit0> | |||
<Filename Value="tests.lpr"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="3"/> | |||
<CursorPos X="5" Y="15"/> | |||
<UsageCount Value="30"/> | |||
<Loaded Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="23" Y="10"/> | |||
<UsageCount Value="70"/> | |||
</Unit0> | |||
<Unit1> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="1"/> | |||
<TopLine Value="1045"/> | |||
<CursorPos X="25" Y="1060"/> | |||
<UsageCount Value="30"/> | |||
<CursorPos X="26" Y="504"/> | |||
<UsageCount Value="70"/> | |||
<Loaded Value="True"/> | |||
</Unit1> | |||
<Unit2> | |||
<Filename Value="..\uutlArrayContainer.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="24"/> | |||
<CursorPos X="14" Y="38"/> | |||
<UsageCount Value="30"/> | |||
<TopLine Value="96"/> | |||
<CursorPos X="50" Y="115"/> | |||
<UsageCount Value="70"/> | |||
</Unit2> | |||
<Unit3> | |||
<Filename Value="..\uutlCommon.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="3"/> | |||
<CursorPos X="29" Y="8"/> | |||
<UsageCount Value="30"/> | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="351"/> | |||
<CursorPos X="12" Y="356"/> | |||
<UsageCount Value="70"/> | |||
</Unit3> | |||
<Unit4> | |||
<Filename Value="..\uutlExceptions.pas"/> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="9"/> | |||
<CursorPos X="35" Y="14"/> | |||
<UsageCount Value="30"/> | |||
<TopLine Value="85"/> | |||
<CursorPos Y="104"/> | |||
<UsageCount Value="70"/> | |||
</Unit4> | |||
<Unit5> | |||
<Filename Value="..\uutlListBase.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="4"/> | |||
<CursorPos X="23" Y="9"/> | |||
<UsageCount Value="30"/> | |||
<Loaded Value="True"/> | |||
</Unit5> | |||
<Unit6> | |||
<Filename Value="uutlListTest.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="357"/> | |||
<CursorPos X="7" Y="376"/> | |||
<UsageCount Value="30"/> | |||
</Unit6> | |||
<Unit7> | |||
<UsageCount Value="70"/> | |||
</Unit5> | |||
<Unit6> | |||
<Filename Value="uutlQueueTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<UsageCount Value="30"/> | |||
</Unit7> | |||
<Unit8> | |||
<UsageCount Value="70"/> | |||
</Unit6> | |||
<Unit7> | |||
<Filename Value="uutlStackTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="3" Y="9"/> | |||
<UsageCount Value="30"/> | |||
</Unit8> | |||
<Unit9> | |||
<UsageCount Value="70"/> | |||
</Unit7> | |||
<Unit8> | |||
<Filename Value="uTestHelper.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<CursorPos X="3" Y="12"/> | |||
<UsageCount Value="30"/> | |||
<UsageCount Value="70"/> | |||
</Unit8> | |||
<Unit9> | |||
<Filename Value="..\uutlComparer.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="4"/> | |||
<CursorPos X="90" Y="6"/> | |||
<UsageCount Value="60"/> | |||
<Loaded Value="True"/> | |||
</Unit9> | |||
<Unit10> | |||
<Filename Value="_uutlInterfaces.pas"/> | |||
<Filename Value="..\uutlAlgorithm.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="42" Y="6"/> | |||
<UsageCount Value="30"/> | |||
<TopLine Value="115"/> | |||
<CursorPos Y="132"/> | |||
<UsageCount Value="70"/> | |||
</Unit10> | |||
<Unit11> | |||
<Filename Value="..\uutlComparer.pas"/> | |||
<Filename Value="uutlHashSetTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="6"/> | |||
<CursorPos X="25" Y="13"/> | |||
<UsageCount Value="30"/> | |||
<Loaded Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="32" Y="13"/> | |||
<UsageCount Value="70"/> | |||
</Unit11> | |||
<Unit12> | |||
<Filename Value="..\uutlAlgorithm.pas"/> | |||
<Filename Value="uutlAlgorithmTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="43"/> | |||
<CursorPos X="33" Y="55"/> | |||
<UsageCount Value="30"/> | |||
<TopLine Value="72"/> | |||
<CursorPos X="43" Y="87"/> | |||
<UsageCount Value="69"/> | |||
</Unit12> | |||
<Unit13> | |||
<Filename Value="uutlHashSetTests.pas"/> | |||
<Filename Value="uutlMapTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<UsageCount Value="30"/> | |||
<TopLine Value="206"/> | |||
<CursorPos X="66" Y="221"/> | |||
<UsageCount Value="68"/> | |||
</Unit13> | |||
<Unit14> | |||
<Filename Value="uutlArrayTests.pas"/> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="118"/> | |||
<CursorPos X="29" Y="137"/> | |||
<UsageCount Value="29"/> | |||
<EditorIndex Value="6"/> | |||
<CursorPos X="3" Y="10"/> | |||
<UsageCount Value="67"/> | |||
<Loaded Value="True"/> | |||
</Unit14> | |||
<Unit15> | |||
<Filename Value="uutlAlgorithmTests.pas"/> | |||
<Filename Value="uutlEnumeratorTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos Y="77"/> | |||
<UsageCount Value="29"/> | |||
<TopLine Value="69"/> | |||
<CursorPos X="3" Y="64"/> | |||
<UsageCount Value="67"/> | |||
<Loaded Value="True"/> | |||
</Unit15> | |||
<Unit16> | |||
<Filename Value="..\..\Utils\uutlGenerics2.pas"/> | |||
<IsVisibleTab Value="True"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="1902"/> | |||
<CursorPos Y="1905"/> | |||
<UsageCount Value="11"/> | |||
<Filename Value="..\uutlFilter.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="5"/> | |||
<TopLine Value="17"/> | |||
<CursorPos X="13" Y="159"/> | |||
<UsageCount Value="63"/> | |||
<Loaded Value="True"/> | |||
</Unit16> | |||
<Unit17> | |||
<Filename Value="..\..\Utils\uutlCommon2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="9"/> | |||
<CursorPos X="15" Y="26"/> | |||
<UsageCount Value="11"/> | |||
<Filename Value="..\uutlInterfaces.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="3"/> | |||
<TopLine Value="68"/> | |||
<CursorPos X="47" Y="72"/> | |||
<UsageCount Value="63"/> | |||
<Loaded Value="True"/> | |||
</Unit17> | |||
<Unit18> | |||
<Filename Value="..\..\Utils\uutlExceptions.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<Filename Value="..\uutlLinq.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<IsVisibleTab Value="True"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="77"/> | |||
<CursorPos X="3" Y="18"/> | |||
<UsageCount Value="9"/> | |||
<TopLine Value="31"/> | |||
<CursorPos X="3" Y="52"/> | |||
<UsageCount Value="54"/> | |||
<Loaded Value="True"/> | |||
</Unit18> | |||
<Unit19> | |||
<Filename Value="..\..\Utils\tests\uutlInterfaces2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="49"/> | |||
<CursorPos X="35" Y="60"/> | |||
<UsageCount Value="11"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<IsVisibleTab Value="True"/> | |||
<EditorIndex Value="2"/> | |||
<TopLine Value="252"/> | |||
<CursorPos X="70" Y="270"/> | |||
<UsageCount Value="54"/> | |||
<Loaded Value="True"/> | |||
</Unit19> | |||
<Unit20> | |||
<Filename Value="..\..\Utils\uutlComparer.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="84"/> | |||
<CursorPos X="28" Y="28"/> | |||
<UsageCount Value="11"/> | |||
<Filename Value="..\uutlTypes.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="7"/> | |||
<UsageCount Value="54"/> | |||
<Loaded Value="True"/> | |||
</Unit20> | |||
<Unit21> | |||
<Filename Value="..\..\Utils\uutlAlgorithm2.pas"/> | |||
<Filename Value="..\uutlSyncObjs.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="66"/> | |||
<CursorPos X="5" Y="93"/> | |||
<UsageCount Value="11"/> | |||
<TopLine Value="241"/> | |||
<CursorPos X="20" Y="263"/> | |||
<UsageCount Value="48"/> | |||
</Unit21> | |||
<Unit22> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\objpas.pp"/> | |||
<Filename Value="..\uutlLogger.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="62"/> | |||
<CursorPos X="5" Y="77"/> | |||
<UsageCount Value="13"/> | |||
<TopLine Value="419"/> | |||
<CursorPos X="55" Y="434"/> | |||
<UsageCount Value="46"/> | |||
</Unit22> | |||
<Unit23> | |||
<Filename Value="..\..\Utils\uutlInterfaces.pas"/> | |||
<Filename Value="..\uutlXmlHelper.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="31"/> | |||
<CursorPos X="22" Y="45"/> | |||
<UsageCount Value="12"/> | |||
<TopLine Value="188"/> | |||
<CursorPos X="26" Y="203"/> | |||
<UsageCount Value="47"/> | |||
</Unit23> | |||
<Unit24> | |||
<Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlAlgorithm.pas"/> | |||
<Filename Value="..\uutlStreamHelper.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="48"/> | |||
<CursorPos X="45" Y="56"/> | |||
<UsageCount Value="11"/> | |||
<TopLine Value="216"/> | |||
<CursorPos X="10" Y="241"/> | |||
<UsageCount Value="46"/> | |||
</Unit24> | |||
<Unit25> | |||
<Filename Value="uutlMapTests.pas"/> | |||
<Filename Value="..\uutlCompression.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="65"/> | |||
<CursorPos X="60" Y="75"/> | |||
<UsageCount Value="28"/> | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="46"/> | |||
</Unit25> | |||
<Unit26> | |||
<Filename Value="..\..\Utils\uutlEnumerator2.pas"/> | |||
<Filename Value="..\uutlEmbeddedProfiler.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="126"/> | |||
<CursorPos X="22" Y="128"/> | |||
<UsageCount Value="10"/> | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="46"/> | |||
</Unit26> | |||
<Unit27> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Filename Value="..\uutlKeyCodes.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<TopLine Value="76"/> | |||
<CursorPos X="39" Y="90"/> | |||
<UsageCount Value="27"/> | |||
<Loaded Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="46"/> | |||
</Unit27> | |||
<Unit28> | |||
<Filename Value="uutlEnumeratorTests.pas"/> | |||
<Filename Value="..\uutlMCF.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="2"/> | |||
<TopLine Value="247"/> | |||
<CursorPos X="29" Y="262"/> | |||
<UsageCount Value="27"/> | |||
<Loaded Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="46"/> | |||
</Unit28> | |||
<Unit29> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
<Filename Value="..\uutlSScanf.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="90"/> | |||
<CursorPos X="16" Y="97"/> | |||
<UsageCount Value="10"/> | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="46"/> | |||
</Unit29> | |||
<Unit30> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\TestFramework.pas"/> | |||
<Filename Value="..\uutlThreads.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="2964"/> | |||
<CursorPos Y="2979"/> | |||
<UsageCount Value="9"/> | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="46"/> | |||
</Unit30> | |||
<Unit31> | |||
<Filename Value="..\uutlFilter.pas"/> | |||
<Filename Value="..\uutlEvent.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="7"/> | |||
<TopLine Value="19"/> | |||
<CursorPos X="40" Y="62"/> | |||
<UsageCount Value="23"/> | |||
<Loaded Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="54" Y="9"/> | |||
<UsageCount Value="45"/> | |||
</Unit31> | |||
<Unit32> | |||
<Filename Value="..\uutlInterfaces.pas"/> | |||
<Filename Value="..\uutlEventManager.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<IsVisibleTab Value="True"/> | |||
<EditorIndex Value="5"/> | |||
<CursorPos X="21" Y="10"/> | |||
<UsageCount Value="23"/> | |||
<Loaded Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="246"/> | |||
<CursorPos X="39" Y="264"/> | |||
<UsageCount Value="45"/> | |||
</Unit32> | |||
<Unit33> | |||
<Filename Value="..\uutlObservable.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="134"/> | |||
<CursorPos X="13" Y="147"/> | |||
<UsageCount Value="45"/> | |||
</Unit33> | |||
<Unit34> | |||
<Filename Value="uutlObservableListTests.pas"/> | |||
<IsPartOfProject Value="True"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="24"/> | |||
<CursorPos X="76" Y="130"/> | |||
<UsageCount Value="37"/> | |||
</Unit34> | |||
<Unit35> | |||
<Filename Value="..\uutlExceptions.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="21" Y="3"/> | |||
<UsageCount Value="32"/> | |||
</Unit35> | |||
<Unit36> | |||
<Filename Value="_uutlInterfaces.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="42" Y="6"/> | |||
<UsageCount Value="33"/> | |||
</Unit36> | |||
<Unit37> | |||
<Filename Value="uutlArrayTests.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="9"/> | |||
<CursorPos X="25" Y="38"/> | |||
<UsageCount Value="32"/> | |||
</Unit37> | |||
<Unit38> | |||
<Filename Value="..\uutlGenerics2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="1902"/> | |||
<CursorPos Y="1905"/> | |||
<UsageCount Value="7"/> | |||
</Unit38> | |||
<Unit39> | |||
<Filename Value="..\uutlCommon2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="9"/> | |||
<CursorPos X="15" Y="26"/> | |||
<UsageCount Value="7"/> | |||
</Unit39> | |||
<Unit40> | |||
<Filename Value="uutlInterfaces2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="49"/> | |||
<CursorPos X="35" Y="60"/> | |||
<UsageCount Value="7"/> | |||
</Unit40> | |||
<Unit41> | |||
<Filename Value="..\uutlAlgorithm2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="66"/> | |||
<CursorPos X="5" Y="93"/> | |||
<UsageCount Value="7"/> | |||
</Unit41> | |||
<Unit42> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\objpas.pp"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="63"/> | |||
<CursorPos X="16" Y="78"/> | |||
<UsageCount Value="11"/> | |||
</Unit42> | |||
<Unit43> | |||
<Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlAlgorithm.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="48"/> | |||
<CursorPos X="45" Y="56"/> | |||
<UsageCount Value="7"/> | |||
</Unit43> | |||
<Unit44> | |||
<Filename Value="..\uutlEnumerator2.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="126"/> | |||
<CursorPos X="22" Y="128"/> | |||
<UsageCount Value="6"/> | |||
</Unit44> | |||
<Unit45> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="64"/> | |||
<CursorPos Y="105"/> | |||
<UsageCount Value="14"/> | |||
</Unit45> | |||
<Unit46> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\TestFramework.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="2963"/> | |||
<CursorPos Y="2979"/> | |||
<UsageCount Value="10"/> | |||
</Unit46> | |||
<Unit47> | |||
<Filename Value="..\internal_uutlInterfaces.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos Y="11"/> | |||
<UsageCount Value="10"/> | |||
</Unit33> | |||
<UsageCount Value="6"/> | |||
</Unit47> | |||
<Unit48> | |||
<Filename Value="..\uutlUtils.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="46" Y="3"/> | |||
<UsageCount Value="7"/> | |||
</Unit48> | |||
<Unit49> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\classes\classesh.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="118"/> | |||
<CursorPos X="3" Y="143"/> | |||
<UsageCount Value="13"/> | |||
</Unit49> | |||
<Unit50> | |||
<Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlCommon.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="474"/> | |||
<CursorPos X="16" Y="500"/> | |||
<UsageCount Value="9"/> | |||
</Unit50> | |||
<Unit51> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\ascdef.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="202"/> | |||
<CursorPos X="10" Y="217"/> | |||
<UsageCount Value="8"/> | |||
</Unit51> | |||
<Unit52> | |||
<Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlSyncObjs.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="1"/> | |||
<TopLine Value="64"/> | |||
<CursorPos X="13" Y="76"/> | |||
<UsageCount Value="14"/> | |||
</Unit52> | |||
<Unit53> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\sysutilh.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="97"/> | |||
<CursorPos X="19" Y="112"/> | |||
<UsageCount Value="14"/> | |||
</Unit53> | |||
<Unit54> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\func.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="244"/> | |||
<CursorPos X="10" Y="259"/> | |||
<UsageCount Value="9"/> | |||
</Unit54> | |||
<Unit55> | |||
<Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlXmlHelper.pas"/> | |||
<EditorIndex Value="-1"/> | |||
<CursorPos X="29" Y="30"/> | |||
<UsageCount Value="8"/> | |||
</Unit55> | |||
<Unit56> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\packages\fcl-base\src\contnrs.pp"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="136"/> | |||
<CursorPos X="3" Y="151"/> | |||
<UsageCount Value="9"/> | |||
</Unit56> | |||
<Unit57> | |||
<Filename Value="..\uutlEmbeddedProfiler.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<WindowIndex Value="-1"/> | |||
<TopLine Value="-1"/> | |||
<CursorPos X="-1" Y="-1"/> | |||
<UsageCount Value="19"/> | |||
</Unit57> | |||
<Unit58> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\inc\objpash.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="181"/> | |||
<CursorPos X="10" Y="196"/> | |||
<UsageCount Value="12"/> | |||
</Unit58> | |||
<Unit59> | |||
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\osutilsh.inc"/> | |||
<EditorIndex Value="-1"/> | |||
<TopLine Value="40"/> | |||
<CursorPos X="3" Y="62"/> | |||
<UsageCount Value="12"/> | |||
</Unit59> | |||
</Units> | |||
<OtherDefines Count="4"> | |||
<Define0 Value="UTL_ADVANCED_ENUMERATORS"/> | |||
<Define1 Value="UTL_NESTED_PROCVARS"/> | |||
<Define2 Value="UTL_DELPHI_GENERICS"/> | |||
<Define3 Value="UTL_ENUMERATORS"/> | |||
</OtherDefines> | |||
<JumpHistory Count="30" HistoryIndex="29"> | |||
<Position1> | |||
<Filename Value="..\uutlFilter.pas"/> | |||
<Caret Line="52" Column="24" TopLine="29"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="784" Column="21" TopLine="773"/> | |||
</Position1> | |||
<Position2> | |||
<Filename Value="..\uutlFilter.pas"/> | |||
<Caret Line="71" Column="17" TopLine="58"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="139" Column="35" TopLine="120"/> | |||
</Position2> | |||
<Position3> | |||
<Filename Value="..\uutlFilter.pas"/> | |||
<Caret Line="78" TopLine="63"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="159" Column="46" TopLine="143"/> | |||
</Position3> | |||
<Position4> | |||
<Filename Value="..\uutlFilter.pas"/> | |||
<Caret Line="69" Column="43" TopLine="55"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="832" Column="39" TopLine="810"/> | |||
</Position4> | |||
<Position5> | |||
<Filename Value="..\uutlFilter.pas"/> | |||
<Caret Line="144" Column="11" TopLine="123"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="838" Column="20" TopLine="811"/> | |||
</Position5> | |||
<Position6> | |||
<Filename Value="..\uutlFilter.pas"/> | |||
<Caret Line="60" Column="58" TopLine="43"/> | |||
<Filename Value="..\uutlLinq.pas"/> | |||
<Caret Line="432" Column="38" TopLine="402"/> | |||
</Position6> | |||
<Position7> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="156" Column="82" TopLine="133"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="829" Column="57" TopLine="813"/> | |||
</Position7> | |||
<Position8> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="478" Column="12" TopLine="453"/> | |||
<Caret Line="915" Column="28" TopLine="899"/> | |||
</Position8> | |||
<Position9> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="151" Column="30" TopLine="136"/> | |||
<Caret Line="299" Column="42" TopLine="292"/> | |||
</Position9> | |||
<Position10> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="476" Column="44" TopLine="453"/> | |||
<Caret Line="914" Column="32" TopLine="899"/> | |||
</Position10> | |||
<Position11> | |||
<Filename Value="uutlEnumeratorTests.pas"/> | |||
<Caret Line="26" Column="37" TopLine="9"/> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="935" Column="28" TopLine="920"/> | |||
</Position11> | |||
<Position12> | |||
<Filename Value="uutlEnumeratorTests.pas"/> | |||
<Caret Line="273" Column="19" TopLine="244"/> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="305" Column="64" TopLine="284"/> | |||
</Position12> | |||
<Position13> | |||
<Filename Value="uutlEnumeratorTests.pas"/> | |||
<Caret Line="263" Column="75" TopLine="248"/> | |||
<Filename Value="..\uutlLinq.pas"/> | |||
<Caret Line="413" Column="15" TopLine="401"/> | |||
</Position13> | |||
<Position14> | |||
<Filename Value="uutlEnumeratorTests.pas"/> | |||
<Caret Line="253" Column="35" TopLine="248"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="689" Column="8" TopLine="669"/> | |||
</Position14> | |||
<Position15> | |||
<Filename Value="uutlEnumeratorTests.pas"/> | |||
<Caret Line="262" Column="29" TopLine="247"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="821" Column="61" TopLine="808"/> | |||
</Position15> | |||
<Position16> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="158" Column="41" TopLine="137"/> | |||
<Caret Line="947" TopLine="873"/> | |||
</Position16> | |||
<Position17> | |||
<Filename Value="..\uutlInterfaces.pas"/> | |||
<Caret Line="44" Column="39" TopLine="29"/> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="12" Column="11"/> | |||
</Position17> | |||
<Position18> | |||
<Filename Value="..\uutlInterfaces.pas"/> | |||
<Caret Line="48" Column="51" TopLine="28"/> | |||
<Filename Value="uutlEnumeratorTests.pas"/> | |||
<Caret Line="64" Column="3" TopLine="69"/> | |||
</Position18> | |||
<Position19> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="37" Column="39" TopLine="22"/> | |||
<Filename Value="..\uutlInterfaces.pas"/> | |||
<Caret Line="89" Column="15" TopLine="69"/> | |||
</Position19> | |||
<Position20> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="90" Column="39" TopLine="77"/> | |||
<Filename Value="..\uutlLinq.pas"/> | |||
<Caret Line="10" Column="25"/> | |||
</Position20> | |||
<Position21> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="343" Column="27" TopLine="338"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="63" Column="24" TopLine="51"/> | |||
</Position21> | |||
<Position22> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="344" Column="11" TopLine="338"/> | |||
<Filename Value="..\uutlLinq.pas"/> | |||
<Caret Line="242" Column="34" TopLine="227"/> | |||
</Position22> | |||
<Position23> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="348" Column="19" TopLine="338"/> | |||
<Filename Value="..\uutlLinq.pas"/> | |||
<Caret Line="432" Column="9" TopLine="405"/> | |||
</Position23> | |||
<Position24> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="393" Column="20" TopLine="373"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="265" Column="51" TopLine="256"/> | |||
</Position24> | |||
<Position25> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="1369" Column="30" TopLine="1347"/> | |||
<Filename Value="..\uutlLinq.pas"/> | |||
<Caret Line="395" Column="36" TopLine="381"/> | |||
</Position25> | |||
<Position26> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="9" Column="92"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="59" Column="12" TopLine="121"/> | |||
</Position26> | |||
<Position27> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="401" Column="48" TopLine="377"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="269" Column="34" TopLine="258"/> | |||
</Position27> | |||
<Position28> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="1352" Column="15" TopLine="1337"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="852" TopLine="824"/> | |||
</Position28> | |||
<Position29> | |||
<Filename Value="..\uutlEnumerator.pas"/> | |||
<Caret Line="90" Column="39" TopLine="76"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="27" Column="38" TopLine="12"/> | |||
</Position29> | |||
<Position30> | |||
<Filename Value="..\uutlGenerics.pas"/> | |||
<Caret Line="1060" Column="25" TopLine="1045"/> | |||
<Filename Value="uutlLinqTests.pas"/> | |||
<Caret Line="82" Column="49" TopLine="67"/> | |||
</Position30> | |||
</JumpHistory> | |||
</ProjectSession> | |||
<Debugging> | |||
<Watches Count="1"> | |||
<Item1> | |||
<Expression Value="fCurrentSkip"/> | |||
<Expression Value="(aArray+2)^"/> | |||
</Item1> | |||
</Watches> | |||
</Debugging> | |||
@@ -19,7 +19,7 @@ type | |||
implementation | |||
uses | |||
uutlGenerics, uutlAlgorithm; | |||
uutlTypes, uutlGenerics, uutlAlgorithm; | |||
type | |||
TIntArray = specialize TutlArray<Integer>; | |||
@@ -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]); | |||
@@ -1,151 +0,0 @@ | |||
unit uutlArrayTests; | |||
{$mode objfpc}{$H+} | |||
interface | |||
uses | |||
Classes, SysUtils, TestFramework, | |||
uutlGenerics; | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TIntArray = specialize TutlArray<Integer>; | |||
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. | |||
@@ -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}<Integer>; | |||
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<Integer>; | |||
TIntArrEnumerator = specialize TutlArrayEnumerator<Integer>; | |||
TFloatArrEnumerator = specialize TutlArrayEnumerator<Single>; | |||
TIntArrayEnumerator = specialize TutlArrayEnumerator<Integer>; | |||
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<Integer>.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<Integer>.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<Integer>.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<Integer>.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<Integer>.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<Integer>.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<Integer>.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<Integer>.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<Single>; | |||
begin | |||
e := specialize TutlSelectEnumerator<Integer, Single>.Create( | |||
CreateArrayEnumerator(5), | |||
specialize TutlCalbackSelector<Integer, Single>.Create(@ConvertToFloat)); | |||
fEnumerator, | |||
specialize TutlCallbackSelector<Integer, Single>.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. | |||
@@ -10,7 +10,7 @@ uses | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TIntSet = specialize TutlHastSet<Integer>; | |||
TIntSet = specialize TutlHashSet<Integer>; | |||
TutlHastSetTests = class(TTestCase) | |||
private | |||
fIntSet: TIntSet; | |||
@@ -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<Integer>; | |||
TStringArrEnumerator = specialize TutlArrayEnumerator<String>; | |||
TCallbackObject = class(TInterfacedObject, | |||
specialize IutlFilter<Integer>, | |||
specialize IutlSelector<Integer, Single>) | |||
public | |||
function Filter(constref i: Integer): Boolean; | |||
function Select(constref i: Integer): Single; | |||
end; | |||
TSelectManyObject = class(TInterfacedObject, | |||
specialize IutlSelector<Integer, specialize IutlEnumerator<Single>>) | |||
public | |||
function Select(constref i: Integer): specialize IutlEnumerator<Single>; | |||
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<Single>; | |||
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<Single>.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<Single>; | |||
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<Integer>(e)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlLinqTests.proc_Any; | |||
begin | |||
AssertFalse(specialize utlAny<Integer>(CreateArrayEnumerator(0))); | |||
AssertTrue (specialize utlAny<Integer>(CreateArrayEnumerator(1))); | |||
AssertTrue (specialize utlAny<Integer>(CreateArrayEnumerator(2))); | |||
AssertTrue (specialize utlAny<Integer>(CreateArrayEnumerator(9))); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlLinqTests.proc_Contains; | |||
begin | |||
AssertFalse(specialize utlContains<Integer>(CreateArrayEnumerator(10), 11)); | |||
AssertFalse(specialize utlContains<Integer>(CreateArrayEnumerator(10), -1)); | |||
AssertTrue (specialize utlContains<Integer>(CreateArrayEnumerator(10), 4)); | |||
AssertTrue (specialize utlContains<Integer>(CreateArrayEnumerator(10), 6)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlLinqTests.proc_Contains_WithComparer; | |||
begin | |||
AssertFalse(specialize utlContains<Integer>(CreateArrayEnumerator(10), 11, specialize TutlEqualityComparer<Integer>.Create)); | |||
AssertFalse(specialize utlContains<Integer>(CreateArrayEnumerator(10), -1, specialize TutlEqualityComparer<Integer>.Create)); | |||
AssertTrue (specialize utlContains<Integer>(CreateArrayEnumerator(10), 4, specialize TutlEqualityComparer<Integer>.Create)); | |||
AssertTrue (specialize utlContains<Integer>(CreateArrayEnumerator(10), 6, specialize TutlEqualityComparer<Integer>.Create)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlLinqTests.proc_ToArray; | |||
var | |||
arr: array of Integer; | |||
begin | |||
arr := specialize utlToArray<Integer>(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<Integer>(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<Integer>(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<Integer>(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<Integer>( | |||
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<Integer>( | |||
specialize TutlArray<specialize IutlEnumerator<Integer>>.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<Integer>(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<Integer>(CreateArrayEnumerator([1, 5, 3, 6, 7, 9, 2]), specialize TutlComparer<Integer>.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<Integer>(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<Integer>(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<Integer>(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<Integer>(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<Integer>(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<Integer>(CreateArrayEnumerator([1, 4, 3, 6, 1, 3, 4, 7 ]), specialize TutlComparer<Integer>.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<Integer>( | |||
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<Integer>( | |||
CreateArrayEnumerator([ 1, 2, 3, 4, 5, 6, 7 ]), | |||
CreateArrayEnumerator([ 3, 5, 4, 3 ]), | |||
specialize TutlComparer<Integer>.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<Integer>( | |||
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<Integer>( | |||
CreateArrayEnumerator([ 2, 4, 5, 7 ]), | |||
CreateArrayEnumerator([ 3, 5, 4, 3, 8 ]), | |||
specialize TutlComparer<Integer>.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<Integer>( | |||
CreateArrayEnumerator([ 1, 2, 3, 4, 5, 6, 7 ]), | |||
CreateArrayEnumerator([ 3, 5, 4, 3 ]), | |||
specialize TutlComparer<Integer>.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<Integer>( | |||
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<Single>; | |||
begin | |||
e := specialize utlSelect<Integer, Single>( | |||
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<Single>; | |||
begin | |||
e := specialize utlSelect<Integer, Single>( | |||
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<Single>; | |||
begin | |||
o := TCallbackObject.Create; | |||
try | |||
e := specialize utlSelectO<Integer, Single>( | |||
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<Single>; | |||
begin | |||
e := specialize utlSelectN<Integer, Single>( | |||
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<Single>; | |||
begin | |||
e := specialize utlSelectMany<Integer, Single>( | |||
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<Single>; | |||
begin | |||
e := specialize utlSelectMany<Integer, Single>( | |||
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<Single>; | |||
begin | |||
o := TSelectManyObject.Create; | |||
try | |||
e := specialize utlSelectManyO<Integer, Single>( | |||
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<Single>; | |||
begin | |||
result := TestManySelector(i); | |||
end; | |||
var | |||
e: specialize IutlEnumerator<Single>; | |||
begin | |||
e := specialize utlSelectManyN<Integer, Single>( | |||
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<specialize TutlPair<Integer, String>>; | |||
begin | |||
e := specialize utlZip<Integer, String>( | |||
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. | |||
@@ -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; | |||
@@ -0,0 +1,140 @@ | |||
unit uutlObservableListTests; | |||
{$mode objfpc}{$H+} | |||
interface | |||
uses | |||
Classes, SysUtils, TestFramework, | |||
uutlGenerics, uutlObservable, uutlEvent; | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TObservableIntList = specialize TutlObservableList<Integer>; | |||
TEventArgList = specialize TutlList<IutlEventArgs>; | |||
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. | |||
@@ -12,8 +12,9 @@ type | |||
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlBinarySearch<T> = class | |||
public type | |||
IReadOnlyArray = specialize IutlReadOnlyArray<T>; | |||
IComparer = specialize IutlComparer<T>; | |||
IReadOnlyArray = specialize IutlReadOnlyArray<T>; | |||
IComparer = specialize IutlComparer<T>; | |||
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<T>; | |||
IComparer = specialize IutlComparer<T>; | |||
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. | |||
@@ -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 | |||
@@ -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<TFilterEntry>; | |||
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. | |||
@@ -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<T> = function(constref i1, i2: T): Boolean; | |||
generic TutlEqualityCompareEventO<T> = function(constref i1, i2: T): Boolean of object; | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
generic TutlEqualityCompareEventN<T> = function(constref i1, i2: T): Boolean is nested; | |||
{$ENDIF} | |||
generic TutlCalbackEqualityComparer<T> = class( | |||
TInterfacedObject, | |||
@@ -34,21 +38,26 @@ type | |||
public type | |||
TCompareEvent = specialize TutlEqualityCompareEvent<T>; | |||
TCompareEventO = specialize TutlEqualityCompareEventO<T>; | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
TCompareEventN = specialize TutlEqualityCompareEventN<T>; | |||
{$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<T> = function(constref i1, i2: T): Integer; | |||
generic TutlCompareEventO<T> = function(constref i1, i2: T): Integer of object; | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
generic TutlCompareEventN<T> = function(constref i1, i2: T): Integer is nested; | |||
{$ENDIF} | |||
generic TutlCallbackComparer<T> = class( | |||
TInterfacedObject, | |||
@@ -77,22 +88,27 @@ type | |||
public type | |||
TCompareEvent = specialize TutlCompareEvent<T>; | |||
TCompareEventO = specialize TutlCompareEventO<T>; | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
TCompareEventN = specialize TutlCompareEventN<T>; | |||
{$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. | |||
@@ -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<IutlEvent>) | |||
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<T> = interface(specialize {$IFDEF UTL_ADVANCED_ENUMERATORS}IutlEnumerable{$ELSE}IEnumerable{$ENDIF}<T>) | |||
['{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<T> = class(specialize TutlCustomHashSet<T>) | |||
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<TNotifyEvent>; | |||
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
IutlEventListener = interface(IUnknown) | |||
['{BC45E26B-96F7-4151-87F1-C330C8C668E5}'] | |||
procedure DispatchEvent(aEvent: IutlEvent); | |||
end; | |||
TutlEventListenerSet = class( | |||
specialize TutlCustomHashSet<IutlEventListener> | |||
, IutlEventListener) | |||
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
TutlEventListenerSet = class(specialize TutlHashSetBase<IutlEventListener>) | |||
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<TObject, IutlEventArgs>; | |||
TEventList = class(specialize TutlSimpleList<TEventPair>) | |||
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; | |||
@@ -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); | |||
@@ -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. | |||
@@ -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<T> = function(constref i: T): Boolean; | |||
generic TutlFilterEventO<T> = function(constref i: T): Boolean of object; | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
generic TutlFilterEventN<T> = function(constref i: T): Boolean is nested; | |||
{$ENDIF} | |||
generic TutlCalbackFilter<T> = class( | |||
generic TutlCallbackFilter<T> = class( | |||
TInterfacedObject, | |||
specialize IutlFilter<T>) | |||
@@ -25,29 +29,36 @@ type | |||
public type | |||
TFilterEvent = specialize TutlFilterEvent<T>; | |||
TFilterEventO = specialize TutlFilterEventO<T>; | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
TFilterEventN = specialize TutlFilterEventN<T>; | |||
{$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 <Tin, Tout> = function(constref i: Tin): Tout; | |||
generic TutlSelectEventO<Tin, Tout> = function(constref i: Tin): Tout of object; | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
generic TutlSelectEventN<Tin, Tout> = function(constref i: Tin): Tout is nested; | |||
{$ENDIF} | |||
generic TutlCalbackSelector<Tin, Tout> = class( | |||
generic TutlCallbackSelector<Tin, Tout> = class( | |||
TInterfacedObject, | |||
specialize IutlSelector<Tin, Tout>) | |||
@@ -57,42 +68,49 @@ type | |||
public type | |||
TSelectEvent = specialize TutlSelectEvent <Tin, Tout>; | |||
TSelectEventO = specialize TutlSelectEventO<Tin, Tout>; | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
TSelectEventN = specialize TutlSelectEventN<Tin, Tout>; | |||
{$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. | |||
@@ -11,8 +11,11 @@ uses | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlQueue<T> = class( | |||
specialize TutlArrayContainer<T>, | |||
specialize IutlEnumerable<T>) | |||
specialize TutlArrayContainer<T> | |||
, specialize IEnumerable<T> | |||
{$IFDEF UTL_ENUMERATORS} | |||
, specialize IutlEnumerable<T> | |||
{$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<T>; | |||
{$IFDEF UTL_ENUMERATORS} | |||
public { IutlEnumerable } | |||
function GetUtlEnumerator: specialize IutlEnumerator<T>; | |||
{$ENDIF} | |||
public | |||
property Count: Integer read GetCount; | |||
@@ -49,8 +56,11 @@ type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlStack<T> = class( | |||
specialize TutlArrayContainer<T>, | |||
specialize IutlEnumerable<T>) | |||
specialize TutlArrayContainer<T> | |||
, specialize IEnumerable<T> | |||
{$IFDEF UTL_ENUMERATORS} | |||
, specialize IutlEnumerable<T> | |||
{$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<T>; | |||
{$IFDEF UTL_ENUMERATORS} | |||
public { IUtlEnumerable } | |||
function GetUtlEnumerator: specialize IutlEnumerator<T>; | |||
{$ENDIF} | |||
public | |||
property Count: Integer read GetCount; | |||
@@ -82,39 +96,11 @@ type | |||
destructor Destroy; override; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlArray<T> = class( | |||
TutlInterfaceNoRefCount, | |||
specialize IutlReadOnlyArray<T>, | |||
specialize IutlArray<T>) | |||
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<T> = class( | |||
specialize TutlListBase<T>, | |||
specialize IutlReadOnlyArray<T>, | |||
specialize IutlArray<T>) | |||
specialize TutlListBase<T> | |||
, specialize IutlReadOnlyArray<T> | |||
, specialize IutlArray<T>) | |||
strict private | |||
function GetFirst: T; | |||
@@ -172,8 +158,8 @@ type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlCustomHashSet<T> = class( | |||
specialize TutlListBase<T>, | |||
specialize IutlReadOnlyArray<T>) | |||
specialize TutlListBase<T> | |||
, specialize IutlReadOnlyArray<T>) | |||
private type | |||
TBinarySearch = specialize TutlBinarySearch<T>; | |||
@@ -203,7 +189,7 @@ type | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlHastSet<T> = class( | |||
generic TutlHashSet<T> = class( | |||
specialize TutlCustomHashSet<T>) | |||
public type | |||
@@ -215,8 +201,10 @@ type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlCustomMap<TKey, TValue> = class( | |||
TutlInterfaceNoRefCount, | |||
specialize IutlEnumerable<TValue>) | |||
TutlInterfaceNoRefCount | |||
{$IFDEF UTL_ENUMERATORS} | |||
, specialize IutlEnumerable<TValue> | |||
{$ENDIF}) | |||
public type | |||
//////////////////////////////////////////////////////////////////////////////////////////////// | |||
@@ -242,8 +230,8 @@ type | |||
//////////////////////////////////////////////////////////////////////////////////////////////// | |||
IComparer = specialize IutlComparer<TKey>; | |||
TKeyValuePairComparer = class( | |||
TInterfacedObject, | |||
THashSet.IComparer) | |||
TInterfacedObject | |||
, THashSet.IComparer) | |||
strict private | |||
fComparer: IComparer; | |||
@@ -261,16 +249,22 @@ type | |||
//////////////////////////////////////////////////////////////////////////////////////////////// | |||
TKeyCollection = class( | |||
TutlInterfaceNoRefCount, | |||
specialize IutlEnumerable<TKey>, | |||
specialize IutlReadOnlyArray<TKey>) | |||
TutlInterfaceNoRefCount | |||
, specialize IutlReadOnlyArray<TKey> | |||
{$IFDEF UTL_ENUMERATORS} | |||
, specialize IutlEnumerable<TKey> | |||
{$ENDIF}) | |||
strict private | |||
fHashSet: THashSet; | |||
public { IutlEnumerable } | |||
public { IEnumerable } | |||
function GetEnumerator: specialize IEnumerator<TKey>; | |||
{$IFDEF UTL_ENUMERATORS} | |||
public { IutlEnumerable } | |||
function GetUtlEnumerator: specialize IutlEnumerator<TKey>; | |||
{$ENDIF} | |||
public { IutlReadOnlyArray } | |||
function GetCount: Integer; | |||
@@ -285,16 +279,22 @@ type | |||
//////////////////////////////////////////////////////////////////////////////////////////////// | |||
TKeyValuePairCollection = class( | |||
TutlInterfaceNoRefCount, | |||
specialize IutlEnumerable<TKeyValuePair>, | |||
specialize IutlReadOnlyArray<TKeyValuePair>) | |||
TutlInterfaceNoRefCount | |||
, specialize IutlReadOnlyArray<TKeyValuePair> | |||
{$IFDEF UTL_ENUMERATORS} | |||
, specialize IutlEnumerable<TKeyValuePair> | |||
{$ENDIF}) | |||
strict private | |||
fHashSet: THashSet; | |||
public { IutlEnumerable } | |||
public { IEnumerable } | |||
function GetEnumerator: specialize IEnumerator<TKeyValuePair>; | |||
{$IFDEF UTL_ENUMERATORS} | |||
public { IutlEnumerable } | |||
function GetUtlEnumerator: specialize IutlEnumerator<TKeyValuePair>; | |||
{$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<TValue>; | |||
{$IFDEF UTL_ENUMERATORS} | |||
public { IutlEnumerable } | |||
function GetUtlEnumerator: specialize IutlEnumerator<TValue>; | |||
{$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<T>; | |||
begin | |||
result := GetUtlEnumerator; | |||
result := nil; // TODO | |||
raise ENotSupportedException.Create('not yet supported'); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
{$IFDEF UTL_ENUMERATORS} | |||
function TutlQueue.GetUtlEnumerator: specialize IutlEnumerator<T>; | |||
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<T>; | |||
begin | |||
// TODO | |||
result := nil; // TODO | |||
raise ENotSupportedException.Create('not yet supported'); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
{$IFDEF UTL_ENUMERATORS} | |||
function TutlStack.GetUtlEnumerator: specialize IutlEnumerator<T>; | |||
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<TKey>; | |||
begin | |||
result := GetUtlEnumerator; | |||
result := nil; // TODO | |||
raise ENotSupportedException.Create('not yet supported'); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
{$IFDEF UTL_ENUMERATORS} | |||
function TutlCustomMap.TKeyCollection.GetUtlEnumerator: specialize IutlEnumerator<TKey>; | |||
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<TKeyValuePair>; | |||
begin | |||
result := GetUtlEnumerator; | |||
result := nil; // TODO | |||
raise ENotSupportedException.Create('not yet supported'); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
{$IFDEF UTL_ENUMERATORS} | |||
function TutlCustomMap.TKeyValuePairCollection.GetUtlEnumerator: specialize IutlEnumerator<TKeyValuePair>; | |||
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<TValue>; | |||
begin | |||
result := GetUtlEnumerator; | |||
result := nil; // TODO | |||
raise ENotSupportedException.Create('not yet supported'); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
{$IFDEF UTL_ENUMERATORS} | |||
function TutlCustomMap.GetUtlEnumerator: specialize IutlEnumerator<TValue>; | |||
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; | |||
@@ -5,7 +5,8 @@ unit uutlInterfaces; | |||
interface | |||
uses | |||
Classes, SysUtils; | |||
Classes, SysUtils, | |||
uutlTypes; | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
@@ -31,20 +32,36 @@ type | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TGenericArray<T> = array of T; | |||
generic IutlEnumerator<T> = interface(specialize IEnumerator<T>) | |||
function GetEnumerator: specialize IutlEnumerator<T>; | |||
function Count: Integer; | |||
// TODO: Aggregate, Join | |||
function Reverse: specialize IutlEnumerator<T>; | |||
function Skip (const aCount: Integer): specialize IutlEnumerator<T>; | |||
function Take (const aCount: Integer): specialize IutlEnumerator<T>; | |||
function Where (const aComparer: specialize IutlFilter<T>): specialize IutlEnumerator<T>; | |||
// TODO generic function Select<S> (const aSelector: specialize IutlSelector<T, S>): specialize IutlEnumerator<S>; | |||
function GetEnumerator: specialize IutlEnumerator<T>; | |||
function ToArray: specialize TGenericArray<T>; | |||
// the following functions will execute the query | |||
function Count (): Integer; | |||
function Any (): Boolean; | |||
function ToArray (): specialize TutlArray<T>; | |||
function Contains (constref aElement: T; aComparer: specialize IutlEqualityComparer<T>): Boolean; | |||
// the following functions will describe the query and do not execute any code in the enumerated items | |||
function Skip (aCount: Integer): specialize IutlEnumerator<T>; | |||
function Take (aCount: Integer): specialize IutlEnumerator<T>; | |||
function Concat (aEnumerator: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; | |||
function Reverse (): specialize IutlEnumerator<T>; | |||
{$IFDEF UTL_ADVANCED_ENUMERATORS} | |||
function Sort (aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; | |||
function Where (aFilter: specialize IutlFilter<T>): specialize IutlEnumerator<T>; | |||
function Distinct (aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; | |||
function Intersect (aEnumerator: specialize IutlEnumerator<T>; aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; | |||
function Union (aEnumerator: specialize IutlEnumerator<T>; aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; | |||
function Without (aEnumerator: specialize IutlEnumerator<T>; aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; | |||
// TODO: interfaces do not support generic functions yet | |||
// generic function Select<S> (aSelector: specialize IutlSelector<T, S>): specialize IutlEnumerator<S>; | |||
// generic function SelectMany<S>(aSelector: specialize IutlSelector<T, specialize IutlEnumerator<S>>): specialize IutlEnumerator<S>; | |||
// generic function Aggregate<S> (constref aSeed: S; aAggregator: specialize IutlAggregator<T, S>): S; | |||
// generic function Zip<S> (aEnumerator: specialize IutlEnumerator<S>): specialize IutlEnumerator<specialize Pair<T, S>>; | |||
{$ENDIF} | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
@@ -57,7 +74,7 @@ type | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic IutlReadOnlyArray<T> = interface(IUnknown) | |||
generic IutlReadOnlyArray<T> = interface(specialize {$IFDEF UTL_ADVANCED_ENUMERATORS}IutlEnumerable{$ELSE}IEnumerable{$ENDIF}<T>) | |||
['{B0938B6F-4E0D-45E3-A813-056AD4C0A2F2}'] | |||
function GetCount: Integer; | |||
function GetItem(const aIndex: Integer): T; | |||
@@ -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<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): Integer; inline; | |||
generic function utlAny<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): Boolean; inline; | |||
generic function utlToArray<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): specialize TutlArray<T>; inline; | |||
generic function utlContains<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aElement: T): Boolean; inline; overload; | |||
generic function utlContains<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aElement: T; | |||
constref aComparer: specialize IutlEqualityComparer<T>): Boolean; inline; overload; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlSkip<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
const aSkip: Integer): specialize IutlEnumerator<T>; inline; | |||
generic function utlTake<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
const aTake: Integer): specialize IutlEnumerator<T>; inline; | |||
generic function utlConcat<T>( | |||
constref aEnumerator1, aEnumerator2: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlConcat<T>( | |||
constref aEnumerators: specialize TutlArray<specialize IutlEnumerator<T>>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlReverse<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; inline; | |||
{$IFDEF UTL_ADVANCED_ENUMERATORS} | |||
generic function utlSort<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlSort<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlWhere<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aFilter: specialize IutlFilter<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlWhere<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aFilter: specialize TutlFilterEvent<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlWhereO<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aFilter: specialize TutlFilterEventO<T>): specialize IutlEnumerator<T>; inline; overload; | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
generic function utlWhereN<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aFilter: specialize TutlFilterEventN<T>): specialize IutlEnumerator<T>; inline; overload; | |||
{$ENDIF} | |||
generic function utlDistinct<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlDistinct<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlIntersect<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlIntersect<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>; | |||
constref aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlUnion<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlUnion<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>; | |||
constref aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlWithout<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlWithout<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>; | |||
constref aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; inline; overload; | |||
generic function utlSelect<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize IutlSelector<T, S>): specialize IutlEnumerator<S>; inline; overload; | |||
generic function utlSelect<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEvent<T, S>): specialize IutlEnumerator<S>; inline; overload; | |||
generic function utlSelectO<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEventO<T, S>): specialize IutlEnumerator<S>; inline; overload; | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
generic function utlSelectN<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEventN<T, S>): specialize IutlEnumerator<S>; inline; overload; | |||
{$ENDIF} | |||
generic function utlSelectMany<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize IutlSelector<T, specialize IutlEnumerator<S>>): specialize IutlEnumerator<S>; inline; overload; | |||
generic function utlSelectMany<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEvent<T, specialize IutlEnumerator<S>>): specialize IutlEnumerator<S>; inline; overload; | |||
generic function utlSelectManyO<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEventO<T, specialize IutlEnumerator<S>>): specialize IutlEnumerator<S>; inline; overload; | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
generic function utlSelectManyN<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEventN<T, specialize IutlEnumerator<S>>): specialize IutlEnumerator<S>; inline; overload; | |||
{$ENDIF} | |||
generic function utlZip<T, S>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<S>): specialize IutlEnumerator<specialize TutlPair<T, S>>; | |||
{$ENDIF} | |||
{$ENDIF} | |||
implementation | |||
{$IFDEF UTL_ENUMERATORS} | |||
uses | |||
uutlEnumerator; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//utlLinq/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlCount<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): Integer; | |||
begin | |||
result := aEnumerator.Count; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlAny<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): Boolean; | |||
begin | |||
result := aEnumerator.Any; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlToArray<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): specialize TutlArray<T>; | |||
begin | |||
result := aEnumerator.ToArray; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlContains<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aElement: T): Boolean; | |||
begin | |||
result := aEnumerator.Contains(aElement, specialize TutlEqualityComparer<T>.Create); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlContains<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aElement: T; | |||
constref aComparer: specialize IutlEqualityComparer<T>): Boolean; | |||
begin | |||
result := aEnumerator.Contains(aElement, aComparer); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlSkip<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
const aSkip: Integer): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator.Skip(aSkip); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlTake<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
const aTake: Integer): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator.Take(aTake); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlConcat<T>( | |||
constref aEnumerator1, aEnumerator2: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; | |||
type | |||
TConcatEnumerator = specialize TutlConcatEnumerator<T>; | |||
begin | |||
result := TConcatEnumerator.Create(TConcatEnumerator.TEnumerators.Create(aEnumerator1, aEnumerator2)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlConcat<T>( | |||
constref aEnumerators: specialize TutlArray<specialize IutlEnumerator<T>>): specialize IutlEnumerator<T>; | |||
type | |||
TConcatEnumerator = specialize TutlConcatEnumerator<T>; | |||
begin | |||
result := TConcatEnumerator.Create(aEnumerators); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlReverse<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator.Reverse; | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
{$IFDEF UTL_ADVANCED_ENUMERATORS} | |||
generic function utlSort<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator.Sort(specialize TutlComparer<T>.Create); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlSort<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator.Sort(aComparer); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlWhere<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aFilter: specialize IutlFilter<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator.Where(aFilter); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlWhere<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aFilter: specialize TutlFilterEvent<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator.Where(specialize TutlCallbackFilter<T>.Create(aFilter)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlWhereO<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aFilter: specialize TutlFilterEventO<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator.Where(specialize TutlCallbackFilter<T>.Create(aFilter)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
generic function utlWhereN<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aFilter: specialize TutlFilterEventN<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator.Where(specialize TutlCallbackFilter<T>.Create(aFilter)); | |||
end; | |||
{$ENDIF} | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlDistinct<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator.Distinct(specialize TutlComparer<T>.Create); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlDistinct<T>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator.Distinct(aComparer); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlIntersect<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator1.Intersect(aEnumerator2, specialize TutlComparer<T>.Create); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlIntersect<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>; | |||
constref aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator1.Intersect(aEnumerator2, aComparer); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlUnion<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator1.Union(aEnumerator2, specialize TutlComparer<T>.Create); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlUnion<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>; | |||
constref aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator1.Union(aEnumerator2, aComparer); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlWithout<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator1.Without(aEnumerator2, specialize TutlComparer<T>.Create); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlWithout<T>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<T>; | |||
constref aComparer: specialize IutlComparer<T>): specialize IutlEnumerator<T>; | |||
begin | |||
result := aEnumerator1.Without(aEnumerator2, aComparer); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlSelect<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize IutlSelector<T, S>): specialize IutlEnumerator<S>; | |||
begin | |||
result := specialize TutlSelectEnumerator<T, S>.Create(aEnumerator, aSelector); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlSelect<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEvent<T, S>): specialize IutlEnumerator<S>; | |||
begin | |||
result := specialize TutlSelectEnumerator<T, S>.Create(aEnumerator, specialize TutlCallbackSelector<T, S>.Create(aSelector)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlSelectO<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEventO<T, S>): specialize IutlEnumerator<S>; | |||
begin | |||
result := specialize TutlSelectEnumerator<T, S>.Create(aEnumerator, specialize TutlCallbackSelector<T, S>.Create(aSelector)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
generic function utlSelectN<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEventN<T, S>): specialize IutlEnumerator<S>; | |||
begin | |||
result := specialize TutlSelectEnumerator<T, S>.Create(aEnumerator, specialize TutlCallbackSelector<T, S>.Create(aSelector)); | |||
end; | |||
{$ENDIF} | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlSelectMany<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize IutlSelector<T, specialize IutlEnumerator<S>>): specialize IutlEnumerator<S>; | |||
begin | |||
result := specialize TutlSelectManyEnumerator<T, S>.Create(aEnumerator, aSelector); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlSelectMany<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEvent<T, specialize IutlEnumerator<S>>): specialize IutlEnumerator<S>; | |||
begin | |||
result := specialize TutlSelectManyEnumerator<T, S>.Create(aEnumerator, specialize TutlCallbackSelector<T, specialize IutlEnumerator<S>>.Create(aSelector)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlSelectManyO<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEventO<T, specialize IutlEnumerator<S>>): specialize IutlEnumerator<S>; | |||
begin | |||
result := specialize TutlSelectManyEnumerator<T, S>.Create(aEnumerator, specialize TutlCallbackSelector<T, specialize IutlEnumerator<S>>.Create(aSelector)); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
{$IFDEF UTL_NESTED_PROCVARS} | |||
generic function utlSelectManyN<T, S>( | |||
constref aEnumerator: specialize IutlEnumerator<T>; | |||
constref aSelector: specialize TutlSelectEventN<T, specialize IutlEnumerator<S>>): specialize IutlEnumerator<S>; | |||
begin | |||
result := specialize TutlSelectManyEnumerator<T, S>.Create(aEnumerator, specialize TutlCallbackSelector<T, specialize IutlEnumerator<S>>.Create(aSelector)); | |||
end; | |||
{$ENDIF} | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic function utlZip<T, S>( | |||
constref aEnumerator1: specialize IutlEnumerator<T>; | |||
constref aEnumerator2: specialize IutlEnumerator<S>): specialize IutlEnumerator<specialize TutlPair<T, S>>; | |||
begin | |||
result := specialize TutlZipEnumerator<T, S>.Create(aEnumerator1, aEnumerator2); | |||
end; | |||
{$ENDIF} | |||
{$ENDIF} | |||
end. | |||
@@ -6,13 +6,15 @@ interface | |||
uses | |||
Classes, SysUtils, | |||
uutlArrayContainer, uutlInterfaces; | |||
uutlArrayContainer | |||
{$IFDEF UTL_ADVANCED_ENUMERATORS}, uutlInterfaces{$ENDIF}; | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlListBase<T> = class( | |||
specialize TutlArrayContainer<T>, | |||
specialize IutlEnumerable<T>) | |||
specialize TutlArrayContainer<T> | |||
, specialize IEnumerable<T> | |||
{$IFDEF UTL_ADVANCED_ENUMERATORS}, specialize IutlEnumerable<T>{$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<T>; | |||
{$IFDEF UTL_ADVANCED_ENUMERATORS} | |||
public { IutlEnumerable } | |||
function GetUtlEnumerator: specialize IutlEnumerator<T>; | |||
{$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<T>; | |||
begin | |||
result := GetUtlEnumerator; | |||
result := specialize TutlMemoryEnumerator<T>.Create(GetInternalItem(0), Count); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
{$IFDEF UTL_ADVANCED_ENUMERATORS} | |||
function TutlListBase.GetUtlEnumerator: specialize IutlEnumerator<T>; | |||
begin | |||
// TODO | |||
result := specialize TutlMemoryEnumerator<T>.Create(GetInternalItem(0), Count); | |||
end; | |||
{$ENDIF} | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
procedure TutlListBase.Clear; | |||
@@ -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<IutlLogConsumer>; | |||
TutlLogConsumerList = specialize TutlList<IutlLogConsumer>; | |||
{ 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; | |||
@@ -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<T> = class(TutlObservableEventArgs) | |||
private | |||
fItem: T; | |||
public | |||
property Item: T read fItem; | |||
constructor Create(const aEventType: TutlObservableEventType; constref aItem: T); | |||
end; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlObservableReplaceEventArgs<T> = 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<T> = class( | |||
specialize TutlCustomList<T> | |||
, specialize IutlObservable<T>) | |||
private type | |||
TEventHandlerList = specialize TutlEventList<TutlEventHandler>; | |||
public type | |||
TItemEventArgs = class(specialize TutlObservableItemEventArgs<T>) | |||
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<T>) | |||
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<T> = class(specialize TutlObservableCustomList<T>) | |||
public type | |||
TEqualityComparer = specialize TutlEqualityComparer<T>; | |||
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. | |||
@@ -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<TutlCheckSynchronizeEvent>) | |||
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<T> = interface(IUnknown) | |||
function LockedObject: T; | |||
end; | |||
generic TutlLock<T> = class(TInterfacedObject, specialize IutlLock<T>) | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlLock<T> = class( | |||
TInterfacedObject, | |||
specialize IutlLock<T>) | |||
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; | |||
@@ -0,0 +1,23 @@ | |||
unit uutlTypes; | |||
{$mode objfpc}{$H+} | |||
interface | |||
uses | |||
Classes, SysUtils; | |||
type | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlArray<T> = array of T; | |||
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
generic TutlPair<T1, T2> = packed record | |||
first: T1; | |||
second: T2; | |||
end; | |||
implementation | |||
end. | |||
@@ -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; | |||