Browse Source

* finished linq stuff

master
bergmann 7 years ago
parent
commit
77ee5bce60
29 changed files with 4909 additions and 1440 deletions
  1. +80
    -18
      tests/tests.lpi
  2. +13
    -2
      tests/tests.lpr
  3. +411
    -208
      tests/tests.lps
  4. +9
    -11
      tests/uutlAlgorithmTests.pas
  5. +0
    -151
      tests/uutlArrayTests.pas
  6. +369
    -128
      tests/uutlEnumeratorTests.pas
  7. +1
    -1
      tests/uutlHashSetTests.pas
  8. +855
    -0
      tests/uutlLinqTests.pas
  9. +1
    -4
      tests/uutlMapTests.pas
  10. +140
    -0
      tests/uutlObservableListTests.pas
  11. +134
    -6
      uutlAlgorithm.pas
  12. +4
    -7
      uutlArrayContainer.pas
  13. +403
    -4
      uutlCommon.pas
  14. +27
    -3
      uutlComparer.pas
  15. +645
    -155
      uutlEnumerator.pas
  16. +138
    -128
      uutlEvent.pas
  17. +23
    -13
      uutlEventManager.pas
  18. +0
    -110
      uutlExceptions.pas
  19. +45
    -21
      uutlFilter.pas
  20. +109
    -132
      uutlGenerics.pas
  21. +30
    -13
      uutlInterfaces.pas
  22. +436
    -0
      uutlLinq.pas
  23. +20
    -12
      uutlListBase.pas
  24. +2
    -2
      uutlLogger.pas
  25. +288
    -0
      uutlObservable.pas
  26. +475
    -237
      uutlStreamHelper.pas
  27. +180
    -21
      uutlSyncObjs.pas
  28. +23
    -0
      uutlTypes.pas
  29. +48
    -53
      uutlXmlHelper.pas

+ 80
- 18
tests/tests.lpi View File

@@ -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>


+ 13
- 2
tests/tests.lpr View File

@@ -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}



+ 411
- 208
tests/tests.lps View File

@@ -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>


+ 9
- 11
tests/uutlAlgorithmTests.pas View File

@@ -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]);


+ 0
- 151
tests/uutlArrayTests.pas View File

@@ -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.


+ 369
- 128
tests/uutlEnumeratorTests.pas View File

@@ -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.


+ 1
- 1
tests/uutlHashSetTests.pas View File

@@ -10,7 +10,7 @@ uses

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TIntSet = specialize TutlHastSet<Integer>;
TIntSet = specialize TutlHashSet<Integer>;
TutlHastSetTests = class(TTestCase)
private
fIntSet: TIntSet;


+ 855
- 0
tests/uutlLinqTests.pas View File

@@ -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.


+ 1
- 4
tests/uutlMapTests.pas View File

@@ -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;


+ 140
- 0
tests/uutlObservableListTests.pas View File

@@ -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.


+ 134
- 6
uutlAlgorithm.pas View File

@@ -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.


+ 4
- 7
uutlArrayContainer.pas View File

@@ -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


+ 403
- 4
uutlCommon.pas View File

@@ -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.


+ 27
- 3
uutlComparer.pas View File

@@ -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.


+ 645
- 155
uutlEnumerator.pas
File diff suppressed because it is too large
View File


+ 138
- 128
uutlEvent.pas View File

@@ -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;



+ 23
- 13
uutlEventManager.pas View File

@@ -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);


+ 0
- 110
uutlExceptions.pas View File

@@ -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.


+ 45
- 21
uutlFilter.pas View File

@@ -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.


+ 109
- 132
uutlGenerics.pas View File

@@ -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;



+ 30
- 13
uutlInterfaces.pas View File

@@ -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;


+ 436
- 0
uutlLinq.pas View File

@@ -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.


+ 20
- 12
uutlListBase.pas View File

@@ -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;


+ 2
- 2
uutlLogger.pas View File

@@ -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;


+ 288
- 0
uutlObservable.pas View File

@@ -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.


+ 475
- 237
uutlStreamHelper.pas
File diff suppressed because it is too large
View File


+ 180
- 21
uutlSyncObjs.pas View File

@@ -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;


+ 23
- 0
uutlTypes.pas View File

@@ -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.


+ 48
- 53
uutlXmlHelper.pas View File

@@ -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;


Loading…
Cancel
Save