Browse Source

* implementer IutlStored

* implemented some usefull custom variant types
* fixed memleak in uutlGenerics
master
bergmann 7 years ago
parent
commit
66515e3fc6
19 changed files with 2257 additions and 336 deletions
  1. +21
    -1
      bitSpaceUtils.lpk
  2. +2
    -1
      bitSpaceUtils.pas
  3. +9
    -1
      tests/tests.lpi
  4. +3
    -3
      tests/tests.lpr
  5. +327
    -214
      tests/tests.lps
  6. +11
    -11
      tests/uutlSetHelperTests.pas
  7. +94
    -0
      tests/uutlVariantEnumTest.pas
  8. +48
    -0
      tests/uutlVariantSetTest.pas
  9. +2
    -1
      uutlArrayContainer.pas
  10. +6
    -2
      uutlCommon.pas
  11. +13
    -0
      uutlEnumVariant.pas
  12. +428
    -98
      uutlGenerics.pas
  13. +496
    -0
      uutlStored.pas
  14. +105
    -0
      uutlTypeInfo.pas
  15. +206
    -0
      uutlVariantEnum.pas
  16. +149
    -0
      uutlVariantObject.pas
  17. +157
    -0
      uutlVariantProperty.pas
  18. +172
    -0
      uutlVariantSet.pas
  19. +8
    -4
      uutlXmlHelper.pas

+ 21
- 1
bitSpaceUtils.lpk View File

@@ -11,7 +11,7 @@
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Files Count="26">
<Files Count="31">
<Item1>
<Filename Value="uutlAlgorithm.pas"/>
<UnitName Value="uutlAlgorithm"/>
@@ -116,6 +116,26 @@
<Filename Value="uutlXmlHelper.pas"/>
<UnitName Value="uutlXmlHelper"/>
</Item26>
<Item27>
<Filename Value="uutlStored.pas"/>
<UnitName Value="uutlStored"/>
</Item27>
<Item28>
<Filename Value="uutlVariantObject.pas"/>
<UnitName Value="uutlVariantObject"/>
</Item28>
<Item29>
<Filename Value="uutlVariantProperty.pas"/>
<UnitName Value="uutlVariantProperty"/>
</Item29>
<Item30>
<Filename Value="uutlVariantEnum.pas"/>
<UnitName Value="uutlVariantEnum"/>
</Item30>
<Item31>
<Filename Value="uutlVariantSet.pas"/>
<UnitName Value="uutlVariantSet"/>
</Item31>
</Files>
<RequiredPkgs Count="2">
<Item1>


+ 2
- 1
bitSpaceUtils.pas View File

@@ -11,7 +11,8 @@ uses
uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlCompression, uutlEmbeddedProfiler, uutlEnumerator,
uutlEvent, uutlEventManager, uutlFilter, uutlGenerics, uutlInterfaces, uutlKeyCodes, uutlLinq, uutlListBase,
uutlLogger, uutlMCF, uutlObservable, uutlSScanf, uutlStreamHelper, uutlSyncObjs, uutlThreads, uutlTypes,
uutlXmlHelper, LazarusPackageIntf;
uutlXmlHelper, uutlStored, uutlVariantObject, uutlVariantProperty, uutlVariantEnum, uutlVariantSet,
LazarusPackageIntf;

implementation



+ 9
- 1
tests/tests.lpi View File

@@ -33,7 +33,7 @@
<PackageName Value="FCL"/>
</Item3>
</RequiredPackages>
<Units Count="38">
<Units Count="40">
<Unit0>
<Filename Value="tests.lpr"/>
<IsPartOfProject Value="True"/>
@@ -186,6 +186,14 @@
<Filename Value="uutlSetHelperTests.pas"/>
<IsPartOfProject Value="True"/>
</Unit37>
<Unit38>
<Filename Value="uutlVariantEnumTest.pas"/>
<IsPartOfProject Value="True"/>
</Unit38>
<Unit39>
<Filename Value="uutlVariantSetTest.pas"/>
<IsPartOfProject Value="True"/>
</Unit39>
</Units>
</ProjectOptions>
<CompilerOptions>


+ 3
- 3
tests/tests.lpr View File

@@ -15,9 +15,9 @@ uses
uTestHelper,

// units unter test
uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlEnumerator,
uutlFilter, uutlGenerics, uutlInterfaces, uutlLinq, uutlListBase, uutlLogger,
uutlStreamHelper, uutlSyncObjs, uutlTypes, uutlXmlHelper, uutlObservable, uutlSetHelperTests;
uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlEnumerator, uutlFilter, uutlGenerics, uutlInterfaces,
uutlLinq, uutlListBase, uutlLogger, uutlStreamHelper, uutlSyncObjs, uutlTypes, uutlXmlHelper, uutlObservable,
uutlSetHelperTests, uutlVariantEnumTest, uutlVariantSetTest;

{$R *.res}



+ 327
- 214
tests/tests.lps View File

@@ -4,21 +4,29 @@
<PathDelim Value="\"/>
<Version Value="10"/>
<BuildModes Active="Default"/>
<Units Count="68">
<Units Count="82">
<Unit0>
<Filename Value="tests.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos X="54" Y="12"/>
<UsageCount Value="81"/>
<EditorIndex Value="10"/>
<CursorPos Y="5"/>
<UsageCount Value="92"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="..\uutlGenerics.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="7"/>
<TopLine Value="1003"/>
<CursorPos Y="1021"/>
<UsageCount Value="81"/>
<TopLine Value="1897"/>
<CursorPos X="3" Y="1900"/>
<ExtraEditorCount Value="1"/>
<ExtraEditor1>
<EditorIndex Value="2"/>
<WindowIndex Value="1"/>
<TopLine Value="2008"/>
<CursorPos Y="2043"/>
</ExtraEditor1>
<UsageCount Value="92"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
@@ -26,32 +34,32 @@
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos X="11" Y="13"/>
<UsageCount Value="81"/>
<UsageCount Value="92"/>
</Unit2>
<Unit3>
<Filename Value="..\uutlCommon.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="206"/>
<CursorPos X="10" Y="225"/>
<UsageCount Value="81"/>
<EditorIndex Value="8"/>
<TopLine Value="264"/>
<CursorPos X="29" Y="283"/>
<UsageCount Value="92"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="..\uutlListBase.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="100"/>
<CursorPos X="72" Y="113"/>
<UsageCount Value="81"/>
<Loaded Value="True"/>
<UsageCount Value="92"/>
</Unit4>
<Unit5>
<Filename Value="uutlListTest.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="3"/>
<TopLine Value="573"/>
<CursorPos Y="588"/>
<UsageCount Value="81"/>
<Loaded Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="50"/>
<CursorPos X="3" Y="65"/>
<UsageCount Value="92"/>
</Unit5>
<Unit6>
<Filename Value="uutlQueueTests.pas"/>
@@ -59,7 +67,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="250"/>
<CursorPos X="49" Y="260"/>
<UsageCount Value="81"/>
<UsageCount Value="92"/>
</Unit6>
<Unit7>
<Filename Value="uutlStackTests.pas"/>
@@ -67,22 +75,23 @@
<EditorIndex Value="-1"/>
<TopLine Value="246"/>
<CursorPos X="24" Y="263"/>
<UsageCount Value="81"/>
<UsageCount Value="92"/>
</Unit7>
<Unit8>
<Filename Value="uTestHelper.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="4"/>
<EditorIndex Value="-1"/>
<CursorPos X="3" Y="12"/>
<UsageCount Value="81"/>
<Loaded Value="True"/>
<UsageCount Value="92"/>
</Unit8>
<Unit9>
<Filename Value="..\uutlComparer.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos X="90" Y="6"/>
<UsageCount Value="71"/>
<EditorIndex Value="9"/>
<TopLine Value="174"/>
<CursorPos X="10" Y="190"/>
<UsageCount Value="82"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
<Filename Value="..\uutlAlgorithm.pas"/>
@@ -90,14 +99,14 @@
<EditorIndex Value="-1"/>
<TopLine Value="138"/>
<CursorPos Y="153"/>
<UsageCount Value="81"/>
<UsageCount Value="92"/>
</Unit10>
<Unit11>
<Filename Value="uutlHashSetTests.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos X="32" Y="13"/>
<UsageCount Value="81"/>
<UsageCount Value="92"/>
</Unit11>
<Unit12>
<Filename Value="uutlAlgorithmTests.pas"/>
@@ -105,7 +114,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="72"/>
<CursorPos X="43" Y="87"/>
<UsageCount Value="80"/>
<UsageCount Value="91"/>
</Unit12>
<Unit13>
<Filename Value="uutlMapTests.pas"/>
@@ -113,15 +122,15 @@
<EditorIndex Value="-1"/>
<TopLine Value="206"/>
<CursorPos X="66" Y="221"/>
<UsageCount Value="79"/>
<UsageCount Value="90"/>
</Unit13>
<Unit14>
<Filename Value="..\uutlEnumerator.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="90"/>
<CursorPos X="5" Y="105"/>
<UsageCount Value="78"/>
<EditorIndex Value="12"/>
<TopLine Value="325"/>
<CursorPos X="42" Y="341"/>
<UsageCount Value="89"/>
<Loaded Value="True"/>
</Unit14>
<Unit15>
@@ -130,7 +139,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="615"/>
<CursorPos X="34" Y="631"/>
<UsageCount Value="78"/>
<UsageCount Value="89"/>
</Unit15>
<Unit16>
<Filename Value="..\uutlFilter.pas"/>
@@ -138,16 +147,15 @@
<EditorIndex Value="-1"/>
<TopLine Value="17"/>
<CursorPos X="13" Y="159"/>
<UsageCount Value="74"/>
<UsageCount Value="85"/>
</Unit16>
<Unit17>
<Filename Value="..\uutlInterfaces.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="2"/>
<EditorIndex Value="-1"/>
<TopLine Value="34"/>
<CursorPos X="5" Y="40"/>
<UsageCount Value="74"/>
<Loaded Value="True"/>
<UsageCount Value="85"/>
</Unit17>
<Unit18>
<Filename Value="..\uutlLinq.pas"/>
@@ -155,7 +163,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="391"/>
<CursorPos X="31" Y="417"/>
<UsageCount Value="65"/>
<UsageCount Value="76"/>
</Unit18>
<Unit19>
<Filename Value="uutlLinqTests.pas"/>
@@ -163,13 +171,13 @@
<EditorIndex Value="-1"/>
<TopLine Value="622"/>
<CursorPos X="23" Y="650"/>
<UsageCount Value="65"/>
<UsageCount Value="76"/>
</Unit19>
<Unit20>
<Filename Value="..\uutlTypes.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<UsageCount Value="65"/>
<UsageCount Value="76"/>
</Unit20>
<Unit21>
<Filename Value="..\uutlSyncObjs.pas"/>
@@ -177,7 +185,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="241"/>
<CursorPos X="20" Y="263"/>
<UsageCount Value="59"/>
<UsageCount Value="70"/>
</Unit21>
<Unit22>
<Filename Value="..\uutlLogger.pas"/>
@@ -185,7 +193,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="419"/>
<CursorPos X="55" Y="434"/>
<UsageCount Value="57"/>
<UsageCount Value="68"/>
</Unit22>
<Unit23>
<Filename Value="..\uutlXmlHelper.pas"/>
@@ -193,7 +201,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="188"/>
<CursorPos X="26" Y="203"/>
<UsageCount Value="58"/>
<UsageCount Value="69"/>
</Unit23>
<Unit24>
<Filename Value="..\uutlStreamHelper.pas"/>
@@ -201,7 +209,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="216"/>
<CursorPos X="10" Y="241"/>
<UsageCount Value="57"/>
<UsageCount Value="68"/>
</Unit24>
<Unit25>
<Filename Value="..\uutlCompression.pas"/>
@@ -210,7 +218,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="57"/>
<UsageCount Value="68"/>
</Unit25>
<Unit26>
<Filename Value="..\uutlEmbeddedProfiler.pas"/>
@@ -219,7 +227,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="57"/>
<UsageCount Value="68"/>
</Unit26>
<Unit27>
<Filename Value="..\uutlKeyCodes.pas"/>
@@ -228,7 +236,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="57"/>
<UsageCount Value="68"/>
</Unit27>
<Unit28>
<Filename Value="..\uutlMCF.pas"/>
@@ -237,7 +245,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="57"/>
<UsageCount Value="68"/>
</Unit28>
<Unit29>
<Filename Value="..\uutlSScanf.pas"/>
@@ -246,7 +254,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="57"/>
<UsageCount Value="68"/>
</Unit29>
<Unit30>
<Filename Value="..\uutlThreads.pas"/>
@@ -255,14 +263,14 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="57"/>
<UsageCount Value="68"/>
</Unit30>
<Unit31>
<Filename Value="..\uutlEvent.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos X="11" Y="35"/>
<UsageCount Value="56"/>
<UsageCount Value="67"/>
</Unit31>
<Unit32>
<Filename Value="..\uutlEventManager.pas"/>
@@ -270,7 +278,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="246"/>
<CursorPos X="39" Y="264"/>
<UsageCount Value="56"/>
<UsageCount Value="67"/>
</Unit32>
<Unit33>
<Filename Value="..\uutlObservable.pas"/>
@@ -278,7 +286,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="556"/>
<CursorPos X="45" Y="572"/>
<UsageCount Value="56"/>
<UsageCount Value="67"/>
</Unit33>
<Unit34>
<Filename Value="uutlObservableListTests.pas"/>
@@ -286,7 +294,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="36"/>
<CursorPos X="53" Y="52"/>
<UsageCount Value="48"/>
<UsageCount Value="59"/>
</Unit34>
<Unit35>
<Filename Value="uutlObservableHashSetTests.pas"/>
@@ -294,7 +302,7 @@
<EditorIndex Value="-1"/>
<TopLine Value="46"/>
<CursorPos X="25" Y="62"/>
<UsageCount Value="28"/>
<UsageCount Value="39"/>
</Unit35>
<Unit36>
<Filename Value="uutlObservableMapTests.pas"/>
@@ -302,360 +310,462 @@
<EditorIndex Value="-1"/>
<TopLine Value="46"/>
<CursorPos X="22" Y="51"/>
<UsageCount Value="27"/>
<UsageCount Value="38"/>
</Unit36>
<Unit37>
<Filename Value="uutlSetHelperTests.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="44"/>
<CursorPos X="64" Y="54"/>
<UsageCount Value="24"/>
<EditorIndex Value="11"/>
<TopLine Value="45"/>
<CursorPos Y="67"/>
<UsageCount Value="35"/>
<Loaded Value="True"/>
</Unit37>
<Unit38>
<Filename Value="uutlVariantEnumTest.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="3"/>
<WindowIndex Value="1"/>
<TopLine Value="30"/>
<CursorPos X="62" Y="34"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
</Unit38>
<Unit39>
<Filename Value="..\uutlExceptions.pas"/>
<EditorIndex Value="-1"/>
<CursorPos X="21" Y="3"/>
<UsageCount Value="32"/>
</Unit38>
<Unit39>
</Unit39>
<Unit40>
<Filename Value="_uutlInterfaces.pas"/>
<EditorIndex Value="-1"/>
<CursorPos X="42" Y="6"/>
<UsageCount Value="33"/>
</Unit39>
<Unit40>
</Unit40>
<Unit41>
<Filename Value="uutlArrayTests.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="9"/>
<CursorPos X="25" Y="38"/>
<UsageCount Value="32"/>
</Unit40>
<Unit41>
</Unit41>
<Unit42>
<Filename Value="..\uutlGenerics2.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="1902"/>
<CursorPos Y="1905"/>
<UsageCount Value="7"/>
</Unit41>
<Unit42>
</Unit42>
<Unit43>
<Filename Value="..\uutlCommon2.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="9"/>
<CursorPos X="15" Y="26"/>
<UsageCount Value="7"/>
</Unit42>
<Unit43>
</Unit43>
<Unit44>
<Filename Value="uutlInterfaces2.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="49"/>
<CursorPos X="35" Y="60"/>
<UsageCount Value="7"/>
</Unit43>
<Unit44>
</Unit44>
<Unit45>
<Filename Value="..\uutlAlgorithm2.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="66"/>
<CursorPos X="5" Y="93"/>
<UsageCount Value="7"/>
</Unit44>
<Unit45>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\objpas.pp"/>
</Unit45>
<Unit46>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\objpas.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="63"/>
<CursorPos X="20" Y="75"/>
<UsageCount Value="15"/>
</Unit45>
<Unit46>
</Unit46>
<Unit47>
<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"/>
</Unit46>
<Unit47>
</Unit47>
<Unit48>
<Filename Value="..\uutlEnumerator2.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="126"/>
<CursorPos X="22" Y="128"/>
<UsageCount Value="6"/>
</Unit47>
<Unit48>
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\FPCUnitCompatibleInterface.inc"/>
</Unit48>
<Unit49>
<Filename Value="..\..\..\components\fptest\src\FPCUnitCompatibleInterface.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="54"/>
<CursorPos Y="69"/>
<UsageCount Value="16"/>
</Unit48>
<Unit49>
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\TestFramework.pas"/>
</Unit49>
<Unit50>
<Filename Value="..\..\..\components\fptest\src\TestFramework.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="2243"/>
<CursorPos Y="2258"/>
<UsageCount Value="10"/>
</Unit49>
<Unit50>
</Unit50>
<Unit51>
<Filename Value="..\internal_uutlInterfaces.pas"/>
<EditorIndex Value="-1"/>
<CursorPos Y="11"/>
<UsageCount Value="6"/>
</Unit50>
<Unit51>
</Unit51>
<Unit52>
<Filename Value="..\uutlUtils.inc"/>
<EditorIndex Value="-1"/>
<CursorPos X="46" Y="3"/>
<UsageCount Value="7"/>
</Unit51>
<Unit52>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\classes\classesh.inc"/>
</Unit52>
<Unit53>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\classes\classesh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="118"/>
<CursorPos X="3" Y="143"/>
<UsageCount Value="13"/>
</Unit52>
<Unit53>
</Unit53>
<Unit54>
<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"/>
</Unit53>
<Unit54>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\ascdef.inc"/>
</Unit54>
<Unit55>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\ascdef.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="202"/>
<CursorPos X="10" Y="217"/>
<UsageCount Value="8"/>
</Unit54>
<Unit55>
</Unit55>
<Unit56>
<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"/>
</Unit55>
<Unit56>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\sysutilh.inc"/>
</Unit56>
<Unit57>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\sysutils\sysutilh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="83"/>
<CursorPos X="4" Y="98"/>
<UsageCount Value="14"/>
</Unit56>
<Unit57>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\func.inc"/>
</Unit57>
<Unit58>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\func.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="244"/>
<CursorPos X="10" Y="259"/>
<UsageCount Value="9"/>
</Unit57>
<Unit58>
</Unit58>
<Unit59>
<Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlXmlHelper.pas"/>
<EditorIndex Value="-1"/>
<CursorPos X="29" Y="30"/>
<UsageCount Value="8"/>
</Unit58>
<Unit59>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\packages\fcl-base\src\contnrs.pp"/>
</Unit59>
<Unit60>
<Filename Value="..\..\..\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"/>
</Unit59>
<Unit60>
</Unit60>
<Unit61>
<Filename Value="..\uutlEmbeddedProfiler.inc"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="19"/>
</Unit60>
<Unit61>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\inc\objpash.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="190"/>
<CursorPos X="23" Y="205"/>
<UsageCount Value="14"/>
</Unit61>
<Unit62>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\osutilsh.inc"/>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\inc\objpash.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="248"/>
<CursorPos X="8" Y="264"/>
<UsageCount Value="15"/>
</Unit62>
<Unit63>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\sysutils\osutilsh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="40"/>
<CursorPos X="3" Y="62"/>
<UsageCount Value="12"/>
</Unit62>
<Unit63>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\struct.inc"/>
</Unit63>
<Unit64>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\struct.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="5662"/>
<CursorPos X="8" Y="5677"/>
<UsageCount Value="11"/>
</Unit63>
<Unit64>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\base.inc"/>
</Unit64>
<Unit65>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\base.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="448"/>
<CursorPos X="12" Y="463"/>
<UsageCount Value="11"/>
</Unit64>
<Unit65>
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\FPCUnitCompatibleInterface.inc"/>
<EditorIndex Value="5"/>
<TopLine Value="158"/>
<CursorPos Y="185"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit65>
<Unit66>
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="8"/>
<TopLine Value="3311"/>
<CursorPos X="30" Y="3325"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
<Filename Value="..\..\fptest\src\FPCUnitCompatibleInterface.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="53"/>
<CursorPos X="35" Y="66"/>
<UsageCount Value="12"/>
</Unit66>
<Unit67>
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFrameworkIfaces.pas"/>
<EditorIndex Value="6"/>
<Filename Value="..\..\fptest\src\TestFramework.pas"/>
<EditorIndex Value="1"/>
<WindowIndex Value="1"/>
<TopLine Value="2786"/>
<CursorPos Y="2808"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit67>
<Unit68>
<Filename Value="..\..\fptest\src\TestFrameworkIfaces.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="35"/>
<CursorPos X="3" Y="51"/>
<UsageCount Value="10"/>
</Unit68>
<Unit69>
<Filename Value="..\uutlVariantEnum.pas"/>
<WindowIndex Value="1"/>
<TopLine Value="81"/>
<CursorPos X="34" Y="105"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit67>
</Unit69>
<Unit70>
<Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\variants.pp"/>
<EditorIndex Value="5"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit70>
<Unit71>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\inc\varianth.inc"/>
<EditorIndex Value="6"/>
<TopLine Value="114"/>
<CursorPos X="27" Y="136"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit71>
<Unit72>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\inc\variant.inc"/>
<EditorIndex Value="-1"/>
<UsageCount Value="11"/>
</Unit72>
<Unit73>
<Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\sysconst.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="107"/>
<CursorPos X="3" Y="123"/>
<UsageCount Value="11"/>
</Unit73>
<Unit74>
<Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\varutilh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="43"/>
<CursorPos X="10" Y="59"/>
<UsageCount Value="11"/>
</Unit74>
<Unit75>
<Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\cvarutil.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="258"/>
<CursorPos X="41" Y="272"/>
<UsageCount Value="11"/>
</Unit75>
<Unit76>
<Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\varerror.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="2"/>
<CursorPos X="3" Y="23"/>
<UsageCount Value="11"/>
</Unit76>
<Unit77>
<Filename Value="..\uutlVariantSet.pas"/>
<TopLine Value="80"/>
<CursorPos X="36" Y="95"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit77>
<Unit78>
<Filename Value="..\uutlVariantObject.pas"/>
<EditorIndex Value="1"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit78>
<Unit79>
<Filename Value="..\uutlVariantProperty.pas"/>
<EditorIndex Value="4"/>
<TopLine Value="24"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit79>
<Unit80>
<Filename Value="uutlVariantSetTest.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="2"/>
<TopLine Value="17"/>
<CursorPos Y="43"/>
<UsageCount Value="22"/>
<Loaded Value="True"/>
</Unit80>
<Unit81>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="3"/>
<TopLine Value="1726"/>
<CursorPos X="16" Y="1749"/>
<ExtraEditorCount Value="1"/>
<ExtraEditor1>
<IsVisibleTab Value="True"/>
<EditorIndex Value="4"/>
<WindowIndex Value="1"/>
<TopLine Value="1480"/>
<CursorPos X="85" Y="1507"/>
</ExtraEditor1>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit81>
</Units>
<OtherDefines Count="3">
<Define0 Value="UTL_ADVANCED_ENUMERATORS"/>
<Define1 Value="UTL_NESTED_PROCVARS"/>
<Define2 Value="UTL_ENUMERATORS"/>
</OtherDefines>
<JumpHistory Count="30" HistoryIndex="29">
<JumpHistory Count="28" HistoryIndex="27">
<Position1>
<Filename Value="..\uutlListBase.pas"/>
<Caret Line="139" TopLine="119"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="1433" Column="6" TopLine="1416"/>
</Position1>
<Position2>
<Filename Value="..\uutlListBase.pas"/>
<Caret Line="143" TopLine="119"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="395" Column="20" TopLine="368"/>
</Position2>
<Position3>
<Filename Value="..\uutlListBase.pas"/>
<Caret Line="135" Column="35" TopLine="119"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="1732" Column="18" TopLine="1723"/>
</Position3>
<Position4>
<Filename Value="uutlListTest.pas"/>
<Caret Line="612" Column="42" TopLine="594"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="1733" Column="32" TopLine="1723"/>
</Position4>
<Position5>
<Filename Value="..\uutlListBase.pas"/>
<Caret Line="105" TopLine="89"/>
<Filename Value="..\uutlVariantSet.pas"/>
<Caret Line="16" Column="73"/>
</Position5>
<Position6>
<Filename Value="uutlListTest.pas"/>
<Caret Line="625" TopLine="610"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="1733" Column="32" TopLine="1723"/>
</Position6>
<Position7>
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\FPCUnitCompatibleInterface.inc"/>
<Caret Line="184" TopLine="158"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="1727" Column="33" TopLine="1723"/>
</Position7>
<Position8>
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/>
<Caret Line="3327" TopLine="3306"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="620" Column="31" TopLine="605"/>
</Position8>
<Position9>
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/>
<Caret Line="3329" TopLine="3306"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="549" Column="57" TopLine="533"/>
</Position9>
<Position10>
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/>
<Caret Line="3332" TopLine="3306"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="584" Column="50" TopLine="563"/>
</Position10>
<Position11>
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/>
<Caret Line="3333" TopLine="3307"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="561" Column="36" TopLine="546"/>
</Position11>
<Position12>
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/>
<Caret Line="3335" TopLine="3309"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="2044" Column="12" TopLine="2023"/>
</Position12>
<Position13>
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/>
<Caret Line="3337" TopLine="3311"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="629" Column="23" TopLine="597"/>
</Position13>
<Position14>
<Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\FPCUnitCompatibleInterface.inc"/>
<Caret Line="185" TopLine="158"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1917" Column="12" TopLine="1901"/>
</Position14>
<Position15>
<Filename Value="uutlListTest.pas"/>
<Caret Line="626" TopLine="610"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1926" Column="27" TopLine="1899"/>
</Position15>
<Position16>
<Filename Value="..\uutlEnumerator.pas"/>
<Caret Line="396" TopLine="380"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1917" Column="17" TopLine="1901"/>
</Position16>
<Position17>
<Filename Value="..\uutlEnumerator.pas"/>
<Caret Line="397" TopLine="380"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="2000" Column="3" TopLine="1997"/>
</Position17>
<Position18>
<Filename Value="..\uutlEnumerator.pas"/>
<Caret Line="398" TopLine="380"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1971" Column="27" TopLine="1949"/>
</Position18>
<Position19>
<Filename Value="..\uutlEnumerator.pas"/>
<Caret Line="402" TopLine="380"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1989" Column="13" TopLine="1968"/>
</Position19>
<Position20>
<Filename Value="..\uutlEnumerator.pas"/>
<Caret Line="403" TopLine="380"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="561" Column="11" TopLine="553"/>
</Position20>
<Position21>
<Filename Value="..\uutlEnumerator.pas"/>
<Caret Line="405" TopLine="380"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1900" Column="3" TopLine="1897"/>
</Position21>
<Position22>
<Filename Value="..\uutlEnumerator.pas"/>
<Caret Line="407" TopLine="381"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="1730" Column="2" TopLine="1723"/>
</Position22>
<Position23>
<Filename Value="uutlListTest.pas"/>
<Caret Line="627" TopLine="610"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="1769" Column="17" TopLine="1758"/>
</Position23>
<Position24>
<Filename Value="..\uutlListBase.pas"/>
<Caret Line="103" TopLine="89"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="1426" Column="25" TopLine="1410"/>
</Position24>
<Position25>
<Filename Value="..\uutlListBase.pas"/>
<Caret Line="104" TopLine="89"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="1774" Column="4" TopLine="1752"/>
</Position25>
<Position26>
<Filename Value="..\uutlEnumerator.pas"/>
<Caret Line="400" Column="28" TopLine="381"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="398" Column="15" TopLine="373"/>
</Position26>
<Position27>
<Filename Value="..\uutlEnumerator.pas"/>
<Caret Line="105" Column="24" TopLine="89"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="281" Column="34" TopLine="256"/>
</Position27>
<Position28>
<Filename Value="..\uutlListBase.pas"/>
<Caret Line="110" Column="29" TopLine="100"/>
<Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/>
<Caret Line="273" Column="21" TopLine="261"/>
</Position28>
<Position29>
<Filename Value="..\uutlListBase.pas"/>
<Caret Line="106" TopLine="100"/>
</Position29>
<Position30>
<Filename Value="..\uutlListBase.pas"/>
<Caret Line="113" Column="72" TopLine="100"/>
</Position30>
</JumpHistory>
</ProjectSession>
<Debugging>
@@ -665,10 +775,13 @@
<InitialEnabled Value="False"/>
</Item1>
</BreakPointGroups>
<Watches Count="1">
<Watches Count="2">
<Item1>
<Expression Value="fCurrent"/>
<Expression Value="TEnumVarData(v)"/>
</Item1>
<Item2>
<Expression Value="TTestEnum(aSet)"/>
</Item2>
</Watches>
</Debugging>
</CONFIG>

+ 11
- 11
tests/uutlSetHelperTests.pas View File

@@ -22,7 +22,7 @@ uses
uutlGenerics;

type
TTestEnum = (
TSetHelperTestEnum = (
teTest0 = 0,
teTest1 = 1,
teTest2 = 2,
@@ -32,8 +32,8 @@ type
teTest8 = 8,
teTest9 = 9
);
TTestSet = set of TTestEnum;
TTestSetH = specialize TutlSetHelper<TTestEnum, TTestSet>;
TSetHelperTestSet = set of TSetHelperTestEnum;
TSetHelperTestSetH = specialize TutlSetHelper<TSetHelperTestEnum, TSetHelperTestSet>;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSetHelperTests////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -42,31 +42,31 @@ procedure TutlSetHelperTests.proc_ToString;
var
str: String;
begin
str := TTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8]);
str := TSetHelperTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8]);
AssertEquals('teTest0, teTest1, teTest2, teTest3, teTest4, teTest8', str);

str := TTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8], '_');
str := TSetHelperTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8], '_');
AssertEquals('teTest0_teTest1_teTest2_teTest3_teTest4_teTest8', str);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSetHelperTests.proc_TryToSet;
var
s: TTestSet;
s: TSetHelperTestSet;
begin
AssertTrue(TTestSetH.TryToSet('teTest0, teTest1, teTest2, teTest3, teTest8, teTest9', s));
AssertTrue(TSetHelperTestSetH.TryToSet('teTest0, teTest1, teTest2, teTest3, teTest8, teTest9', s));
AssertTrue([teTest0, teTest1, teTest2, teTest3, teTest8, teTest9] = s);

AssertTrue(TTestSetH.TryToSet('teTest0_asd_teTest1_asd_teTest2_asd_teTest3_asd_teTest8_asd_teTest9', '_asd_', s));
AssertTrue(TSetHelperTestSetH.TryToSet('teTest0_asd_teTest1_asd_teTest2_asd_teTest3_asd_teTest8_asd_teTest9', '_asd_', s));
AssertTrue([teTest0, teTest1, teTest2, teTest3, teTest8, teTest9] = s);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSetHelperTests.proc_Compare;
begin
AssertEquals( 0, TTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest1, teTest2]));
AssertEquals(-1, TTestSetH.Compare([ teTest1, teTest2], [teTest0, teTest1, teTest2]));
AssertEquals( 1, TTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest2]));
AssertEquals( 0, TSetHelperTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest1, teTest2]));
AssertEquals(-1, TSetHelperTestSetH.Compare([ teTest1, teTest2], [teTest0, teTest1, teTest2]));
AssertEquals( 1, TSetHelperTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest2]));
end;

initialization


+ 94
- 0
tests/uutlVariantEnumTest.pas View File

@@ -0,0 +1,94 @@
unit uutlVariantEnumTest;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, TestFramework,
uutlVariantEnum;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlVariantEnumTest = class(TTestCase)
published
procedure VariantToString;
procedure VariantToEnum;
procedure VariantToInt;
end;

implementation

uses
uutlGenerics;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TTestEnum = (
teTest2 = 2,
teTest3 = 3,
teTest5 = 5,
teTest9 = 9
);
TTestEnumH = specialize TutlEnumHelper<TTestEnum>;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlVariantEnumTest///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlVariantEnumTest.VariantToString;
begin
AssertEquals('2', String(VarMakeEnum(Ord(teTest2))));
AssertEquals('3', String(VarMakeEnum(Ord(teTest3))));
AssertEquals('5', String(VarMakeEnum(Ord(teTest5))));
AssertEquals('9', String(VarMakeEnum(Ord(teTest9))));

AssertEquals('teTest2', String(VarMakeEnum(Ord(teTest2), TTestEnumH)));
AssertEquals('teTest3', String(VarMakeEnum(Ord(teTest3), TTestEnumH)));
AssertEquals('teTest5', String(VarMakeEnum(Ord(teTest5), TTestEnumH)));
AssertEquals('teTest9', String(VarMakeEnum(Ord(teTest9), TTestEnumH)));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlVariantEnumTest.VariantToEnum;
var
e: TTestEnum;
begin
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest2)), e, true));
AssertEquals(Integer(teTest2), Integer(e));
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest3)), e, true));
AssertEquals(Integer(teTest3), Integer(e));
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest5)), e, true));
AssertEquals(Integer(teTest5), Integer(e));
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest9)), e, true));
AssertEquals(Integer(teTest9), Integer(e));

AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest2), TTestEnumH), e, true));
AssertEquals(Integer(teTest2), Integer(e));
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest3), TTestEnumH), e, true));
AssertEquals(Integer(teTest3), Integer(e));
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest5), TTestEnumH), e, true));
AssertEquals(Integer(teTest5), Integer(e));
AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest9), TTestEnumH), e, true));
AssertEquals(Integer(teTest9), Integer(e));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlVariantEnumTest.VariantToInt;
begin
// cause of a bug in FPC this test will always fail with a invalid cast exception

AssertEquals(2, Integer(VarMakeEnum(Ord(teTest2))));
AssertEquals(3, Integer(VarMakeEnum(Ord(teTest3))));
AssertEquals(5, Integer(VarMakeEnum(Ord(teTest5))));
AssertEquals(9, Integer(VarMakeEnum(Ord(teTest9))));

AssertEquals(2, Integer(VarMakeEnum(Ord(teTest2), TTestEnumH)));
AssertEquals(3, Integer(VarMakeEnum(Ord(teTest3), TTestEnumH)));
AssertEquals(5, Integer(VarMakeEnum(Ord(teTest5), TTestEnumH)));
AssertEquals(9, Integer(VarMakeEnum(Ord(teTest9), TTestEnumH)));
end;

initialization
RegisterTest(TutlVariantEnumTest.Suite);
end.


+ 48
- 0
tests/uutlVariantSetTest.pas View File

@@ -0,0 +1,48 @@
unit uutlVariantSetTest;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, TestFramework,
uutlVariantSet;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlVariantSetTest = class(TTestCase)
published
procedure VariantToString;
end;

implementation

uses
uutlGenerics;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TTestEnum = (
teTest2 = 2,
teTest3 = 3,
teTest5 = 5,
teTest9 = 9
);
TTestSet = set of TTestEnum;
TTestSetH = specialize TutlSetHelper<TTestEnum, TTestSet>;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlVariantSetTest////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlVariantSetTest.VariantToString;
begin
AssertEquals('teTest2, teTest3, teTest5, teTest9', String(VarMakeSet(TTestSet([teTest2, teTest3, teTest5, teTest9]), SizeOf(TTestSet), TTestSetH)));
AssertEquals('teTest2, teTest5', String(VarMakeSet(TTestSet([teTest2, teTest5]), SizeOf(TTestSet), TTestSetH)));
AssertEquals('teTest3', String(VarMakeSet(TTestSet([teTest3]), SizeOf(TTestSet), TTestSetH)));
end;

initialization
RegisterTest(TutlVariantSetTest.Suite);

end.


+ 2
- 1
uutlArrayContainer.pas View File

@@ -80,7 +80,8 @@ end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlArrayContainer.Release(var aItem: T; const aFreeItem: Boolean);
begin
utlFinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem);
if not utlFinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem) then
Finalize(aItem);
FillByte(aItem, SizeOf(aItem), 0);
end;



+ 6
- 2
uutlCommon.pas View File

@@ -90,7 +90,7 @@ function GetMicroTime (): QWord;
function GetPlatformIdentitfier(): String;

function utlRateLimited (const Reference: QWord; const Interval: QWord): boolean;
procedure utlFinalizeObject (var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
function utlFinalizeObject (var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean): Boolean;
function utlFilterBuilder (): IutlFilterBuilder;

implementation
@@ -261,10 +261,11 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure utlFinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean);
function utlFinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean): Boolean;
var
o: TObject;
begin
result := true;
case aTypeInfo^.Kind of
tkClass: begin
if (aFreeObject) then begin
@@ -290,6 +291,9 @@ begin
tkString: begin
String(Obj) := '';
end;

else
result := false;
end;
end;



+ 13
- 0
uutlEnumVariant.pas View File

@@ -0,0 +1,13 @@
unit uutlEnumVariant;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils;

implementation

end.


+ 428
- 98
uutlGenerics.pas View File

@@ -453,6 +453,7 @@ type
function TryGetValue (constref aKey: TKey; out aValue: TValue): Boolean;
function IndexOf (constref aKey: TKey): Integer;
function Contains (constref aKey: TKey): Boolean;
function Remove (constref aKey: TKey): Boolean;
procedure Delete (constref aKey: TKey);
procedure DeleteAt (const aIndex: Integer);
procedure Clear;
@@ -482,49 +483,153 @@ type
constructor Create(const aValue, aExpectedType: String);
end;

generic TutlEnumHelper<T> = class
TutlEnumHelperBaseClass = class of TutlEnumHelperBase;
TutlEnumHelperBase = class
public type
TIntArray = array of Integer;
TStringArray = array of String;

private type
TValuesMap = specialize TutlMap<string, TIntArray>;
TNamesMap = specialize TutlMap<string, TStringArray>;

private class var
fValuesMap: TValuesMap;
fNamesMap: TNamesMap;

protected
class procedure RegisterType (const aValues: TIntArray; const aNames: TStringArray);
class procedure UnregisterType();

public
class function ToString (const aValue: Integer; const aAllowOrd: Boolean = false): String; reintroduce;
class function TryToEnum (const aStr: String; out aValue: Integer; const aAllowOrd: Boolean = false): Boolean;
class function ToEnum (const aStr: String; const aAllowOrd: Boolean = false): Integer; overload;
class function ToEnum (const aStr: String; const aDefault: Integer; const aAllowOrd: Boolean = false): Integer; overload;

class function IntValues: TIntArray;
class function Names: TStringArray;

public
class constructor Initialize;
class destructor Finalize;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlEnumHelper<T> = class(TutlEnumHelperBase)
public type
TEnumType = T;
TValueArray = array of T;
TStringArray = array of String;

private class var
fTypeInfo: PTypeInfo;
fValues: TValueArray;
fNames: TStringArray;
fIntValues: TIntArray;
fTypeInfo: PTypeInfo;

public
class function ToString (aValue: T): String; reintroduce;
class function TryToEnum (aStr: String; out aValue: T): Boolean;
class function ToEnum (aStr: String): T; overload;
class function ToEnum (aStr: String; const aDefault: T): T; overload;
class function ToString (const aValue: T; const aAllowOrd: Boolean = false): String; reintroduce;
class function TryToEnum (const aStr: String; out aValue: T; const aAllowOrd: Boolean = false): Boolean;
class function ToEnum (const aStr: String; const aAllowOrd: Boolean = false): T; overload;
class function ToEnum (const aStr: String; const aDefault: T; const aAllowOrd: Boolean = false): T; overload;

class function Values: TValueArray; inline;
class function IntValues: TIntArray; inline;
class function Names: TStringArray; inline;
class function TypeInfo: PTypeInfo; inline;

class constructor Initialize;
class destructor Finalize;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlSetHelperBase = class
private type
TEnumHelperMap = specialize TutlMap<string, TutlEnumHelperBaseClass>;

private class var
fEnumHelpers: TEnumHelperMap;

private
class function IsSet (const aSet; const aSize: Integer; const aValue: Integer): Boolean;
class procedure SetValue (var aSet; const aSize: Integer; const aValue: Integer);
class procedure ClearValue(var aSet; const aSize: Integer; const aValue: Integer);

protected
class procedure RegisterEnumHelper(const aHelper: TutlEnumHelperBaseClass);
class procedure UnregisterEnumHelper;

public
class function ToString(
const aSet;
const aSize: Integer;
const aSeparator: String = ', ';
const aAllowOrd: Boolean = false): String; reintroduce;

class function TryToSet(
const aStr: String;
out aSet;
const aSize: Integer;
const aAllowOrd: Boolean = false): Boolean;

class function TryToSet(
const aStr: String;
const aSeparator: String;
out aSet;
const aSize: Integer;
const aAllowOrd: Boolean = false): Boolean;

class function Compare(
const aSet1;
const aSet2;
const aSize: Integer): Integer;

class function EnumHelper: TutlEnumHelperBaseClass;

class constructor Initialize;
class destructor Finalize;
end;
TutlSetHelperBaseClass = class of TutlSetHelperBase;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlSetHelper<TEnum, TSet> = class
generic TutlSetHelper<TEnum, TSet> = class(TutlSetHelperBase)
public type
TEnumHelper = specialize TutlEnumHelper<TEnum>;
TEnumType = TEnum;
TSetType = TSet;

private
class function IsSet (constref aSet: TSet; aEnum: TEnum): Boolean;
class procedure SetValue (var aSet: TSet; aEnum: TEnum);
class procedure ClearValue(var aSet: TSet; aEnum: TEnum);

public
class function ToString (const aValue: TSet; const aSeperator: String = ', '): String; reintroduce;
class function TryToSet (const aStr: String; out aValue: TSet): Boolean; overload;
class function TryToSet (const aStr: String; const aSeperator: String; out aValue: TSet): Boolean; overload;
class function ToSet (const aStr: String; const aDefault: TSet): TSet; overload;
class function ToSet (const aStr: String): TSet; overload;
class function Compare (const aSet1, aSet2: TSet): Integer;
class function ToString(
const aValue: TSet;
const aSeparator: String = ', ';
const aAllowOrd: Boolean = false): String; overload;

class function TryToSet(
const aStr: String;
out aValue: TSet;
const aAllowOrd: Boolean = false): Boolean; overload;

class function TryToSet(
const aStr: String;
const aSeparator: String;
out aValue: TSet;
const aAllowOrd: Boolean = false): Boolean; overload;

class function ToSet(
const aStr: String;
const aDefault: TSet;
const aAllowOrd: Boolean = false): TSet; overload;

class function ToSet(
const aStr: String;
const aAllowOrd: Boolean = false): TSet; overload;

class function Compare(
const aSet1, aSet2: TSet): Integer; overload;

class constructor Initialize;
class destructor Finalize;
end;

implementation
@@ -1129,8 +1234,10 @@ end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.THashSet.Release(var aItem: TKeyValuePair; const aFreeItem: Boolean);
begin
utlFinalizeObject(aItem.Key, TypeInfo(aItem.Key), fOwner.OwnsKeys and aFreeItem);
utlFinalizeObject(aItem.Value, TypeInfo(aItem.Value), fOwner.OwnsValues and aFreeItem);
if not utlFinalizeObject(aItem.Key, TypeInfo(aItem.Key), fOwner.OwnsKeys and aFreeItem) then
Finalize(aItem.Key);
if not utlFinalizeObject(aItem.Value, TypeInfo(aItem.Value), fOwner.OwnsValues and aFreeItem) then
Finalize(aItem.Key);
inherited Release(aItem, aFreeItem);
end;

@@ -1448,12 +1555,18 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.Delete(constref aKey: TKey);
function TutlCustomMap.Remove(constref aKey: TKey): Boolean;
var
kvp: TKeyValuePair;
begin
kvp.Key := aKey;
if not fHashSetRef.Remove(kvp) then
result := fHashSetRef.Remove(kvp);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCustomMap.Delete(constref aKey: TKey);
begin
if not Remove(aKey) then
raise EInvalidOperation.Create('key not found');
end;

@@ -1523,10 +1636,107 @@ begin
inherited Create(Format('%s is not a %s', [aValue, aExpectedType]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEnumHelperBase////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlEnumHelperBase.RegisterType(const aValues: TIntArray; const aNames: TStringArray);
begin
fValuesMap.Add(ClassName, aValues);
fNamesMap.Add (ClassName, aNames);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlEnumHelperBase.UnregisterType;
begin
fValuesMap.Remove(ClassName);
fNamesMap.Remove(ClassName);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.ToString(const aValue: Integer; const aAllowOrd: Boolean = false): String;
var
i: Integer;
iArr: TIntArray;
sArr: TStringArray;
begin
iArr := fValuesMap[ClassName];
sArr := fNamesMap[ClassName];
for i := low(iArr) to high(iArr) do begin
if (iArr[i] = aValue) then begin
result := sArr[i];
exit;
end;
end;
if aAllowOrd
then result := IntToStr(aValue)
else result := '';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.TryToEnum(const aStr: String; out aValue: Integer; const aAllowOrd: Boolean = false): Boolean;
var
i: Integer;
iArr: TIntArray;
sArr: TStringArray;
begin
iArr := fValuesMap[ClassName];
sArr := fNamesMap[ClassName];
for i := low(sArr) to high(sArr) do begin
if (sArr[i] = aStr) then begin
result := true;
aValue := iArr[i];
exit;
end;
end;
if aAllowOrd
then result := TryStrToInt(aStr, aValue)
else result := false;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.ToEnum(const aStr: String; const aAllowOrd: Boolean): Integer;
begin
if not TryToEnum(aStr, result, aAllowOrd) then
raise EConvertError.Create(aStr + ' is an unknown enum value');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.ToEnum(const aStr: String; const aDefault: Integer; const aAllowOrd: Boolean): Integer;
begin
if not TryToEnum(aStr, result, aAllowOrd) then
result := aDefault;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.IntValues: TIntArray;
begin
result := fValuesMap[ClassName];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelperBase.Names: TStringArray;
begin
result := fNamesMap[ClassName];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class constructor TutlEnumHelperBase.Initialize;
begin
fNamesMap := TNamesMap.Create(true, true);
fValuesMap := TValuesMap.Create(true, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class destructor TutlEnumHelperBase.Finalize;
begin
FreeAndNil(fNamesMap);
FreeAndNil(fValuesMap);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEnumHelper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToString(aValue: T): String;
class function TutlEnumHelper.ToString(const aValue: T; const aAllowOrd: Boolean): String;
begin
{$Push}
{$IOChecks OFF}
@@ -1537,9 +1747,10 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.TryToEnum(aStr: String; out aValue: T): Boolean;
class function TutlEnumHelper.TryToEnum(const aStr: String; out aValue: T; const aAllowOrd: Boolean): Boolean;
var
a: T;
i: Integer;
begin
a := T(0);
Result := false;
@@ -1552,20 +1763,25 @@ begin
Result := IOResult <> 106;
{$Pop}
if Result then
aValue := a;
aValue := a
else if aAllowOrd then begin
result := TryStrToInt(aStr, i);
if result then
aValue := T(i);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToEnum(aStr: String): T;
class function TutlEnumHelper.ToEnum(const aStr: String; const aAllowOrd: Boolean): T;
begin
if not TryToEnum(aStr, result) then
if not TryToEnum(aStr, result, aAllowOrd) then
raise EEnumConvertException.Create(aStr, TypeInfo^.Name);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToEnum(aStr: String; const aDefault: T): T;
class function TutlEnumHelper.ToEnum(const aStr: String; const aDefault: T; const aAllowOrd: Boolean): T;
begin
if not TryToEnum(aStr, result) then
if not TryToEnum(aStr, result, aAllowOrd) then
result := aDefault;
end;

@@ -1575,6 +1791,12 @@ begin
result := fValues;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.IntValues: TIntArray;
begin
result := fIntValues;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.Names: TStringArray;
begin
@@ -1595,6 +1817,7 @@ var
PName: PShortString;
i: integer;
en: T;
sl: TStringList;
begin
{
See FPC Bug http://bugs.freepascal.org/view.php?id=27622
@@ -1613,97 +1836,142 @@ begin
}
tdEnum := GetTypeData(FTypeInfo);
PName := @tdEnum^.NameList;
SetLength(fValues, 0);
SetLength(fNames, 0);
i:= 0;
while Length(PName^) > 0 do begin
SetLength(fValues, i+1);
SetLength(fNames, i+1);
{
Memory layout for TTypeData has the declaring EnumUnitName after the last NameList entry.
This can normally not be the same as a valid enum value, because it is in the same identifier
namespace. However, with scoped enums we might have the same name for module and element, because
the full identifier for the element would be TypeName.ElementName.
In either case, the next PShortString will point to a zero-length string, and the loop is left
with the last element being invalid (either empty or whatever value the unit-named element has).
}
fNames[i] := PName^;
if TryToEnum(PName^, en) then
fValues[i]:= en;
sl := TStringList.Create;
try
while Length(PName^) > 0 do begin
{
Memory layout for TTypeData has the declaring EnumUnitName after the last NameList entry.
This can normally not be the same as a valid enum value, because it is in the same identifier
namespace. However, with scoped enums we might have the same name for module and element, because
the full identifier for the element would be TypeName.ElementName.
In either case, the next PShortString will point to a zero-length string, and the loop is left
with the last element being invalid (either empty or whatever value the unit-named element has).
}
sl.Add(PName^);
if TryToEnum(PName^, en) then
sl.Objects[sl.Count-1] := TObject({%H-}Pointer(PtrUInt(en)));
inc(PByte(PName), Length(PName^) + 1);
end;

inc(i);
inc(PByte(PName), Length(PName^) + 1);
sl.Delete(sl.Count-1); // remove the EnumUnitName item
SetLength(fValues, sl.Count);
SetLength(fIntValues, sl.Count);
SetLength(fNames, sl.Count);
for i := 0 to sl.Count-1 do begin
fNames[i] := sl[i];
fValues[i] := T(PtrUInt(sl.Objects[i]));
fIntValues[i] := Integer(fValues[i]);
end;

finally
FreeAndNil(sl);
end;
// remove the EnumUnitName item
SetLength(fValues, High(fValues));
SetLength(fNames, High(fNames));

RegisterType(fIntValues, fNames);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSetHelper/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class destructor TutlEnumHelper.Finalize;
begin
Finalize(fNames);
Finalize(fValues);
Finalize(fIntValues);
UnregisterType;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.IsSet(constref aSet: TSet; aEnum: TEnum): Boolean;
//TutlSetHelperBase/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelperBase.IsSet(const aSet; const aSize: Integer; const aValue: Integer): Boolean;
begin
if (aValue >= 8*aSize) then
raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1);
result := ((PByte(@aSet)[aValue shr 3] and (1 shl (aValue and 7))) <> 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlSetHelperBase.SetValue(var aSet; const aSize: Integer; const aValue: Integer);
begin
result := ((PByte(@aSet)[Integer(aEnum) shr 3] and (1 shl (Integer(aEnum) and 7))) <> 0);
if (aValue >= 8*aSize) then
raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1);
PByte(@aSet)[aValue shr 3] := PByte(@aSet)[aValue shr 3] or (1 shl (aValue and 7));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlSetHelper.SetValue(var aSet: TSet; aEnum: TEnum);
class procedure TutlSetHelperBase.ClearValue(var aSet; const aSize: Integer; const aValue: Integer);
begin
PByte(@aSet)[Integer(aEnum) shr 3] := PByte(@aSet)[Integer(aEnum) shr 3] or (1 shl (Integer(aEnum) and 7));
if (aValue >= 8*aSize) then
raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1);
PByte(@aSet)[aValue shr 3] := PByte(@aSet)[aValue shr 3] and not (1 shl (aValue and 7));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlSetHelper.ClearValue(var aSet: TSet; aEnum: TEnum);
class procedure TutlSetHelperBase.RegisterEnumHelper(const aHelper: TutlEnumHelperBaseClass);
begin
PByte(@aSet)[Integer(aEnum) shr 3] := PByte(@aSet)[Integer(aEnum) shr 3] and not (1 shl (Integer(aEnum) and 7));
fEnumHelpers.Add(ClassName, aHelper);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.ToString(const aValue: TSet; const aSeperator: String): String;
class procedure TutlSetHelperBase.UnregisterEnumHelper;
begin
fEnumHelpers.Remove(ClassName);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelperBase.ToString(const aSet; const aSize: Integer; const aSeparator: String;
const aAllowOrd: Boolean): String;
var
e: TEnum;
i: Integer;
h: TutlEnumHelperBaseClass;
arr: TutlEnumHelperBase.TIntArray;
begin
h := EnumHelper;
if not Assigned(h) then
raise EInvalidOperation.Create('enum helper class is not set');
result := '';
for e in TEnumHelper.Values do begin
if IsSet(aValue, e) then begin
arr := h.IntValues;
for i in arr do begin
if IsSet(aSet, aSize, i) then begin
if result > '' then
result := result + aSeperator;
result := result + TEnumHelper.ToString(e);
result := result + aSeparator;
result := result + h.ToString(i, aAllowOrd);
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.TryToSet(const aStr: String; out aValue: TSet): Boolean;
class function TutlSetHelperBase.TryToSet(const aStr: String; out aSet; const aSize: Integer; const aAllowOrd: Boolean): Boolean;
begin
result := TryToSet(aStr, ',', aValue);
result := TryToSet(aStr, ',', aSet, aSize, aAllowOrd);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelper.TryToSet(const aStr: String; const aSeperator: String; out aValue: TSet): Boolean;
class function TutlSetHelperBase.TryToSet(const aStr: String; const aSeparator: String; out aSet; const aSize: Integer; const aAllowOrd: Boolean): Boolean;
var
i, j: Integer;
i, j, e: Integer;
s: String;
e: TEnum;
h: TutlEnumHelperBaseClass;
begin
if (aSeperator = '') then
raise EArgumentException.Create('''aSeperator'' can not be empty');
if (aSeparator = '') then
raise EArgumentException.Create('''aSeparator'' can not be empty');
h := EnumHelper;
if not Assigned(h) then
raise EInvalidOperation.Create('enum helper class is not set');

result := true;
aValue := [];
i := 1;
j := 1;
i := 1;
j := 1;

FillByte(aSet{%H-}, aSize, 0);
while (i <= Length(aStr)) do begin
if (Copy(aStr, i, Length(aSeperator)) = aSeperator) then begin
if (Copy(aStr, i, Length(aSeparator)) = aSeparator) then begin
s := Trim(copy(aStr, j, i - j));
if (s <> '') then begin
result := result and TEnumHelper.TryToEnum(s, e);
result := result and h.TryToEnum(s, e);
if not result then
exit;
SetValue(aValue, e);
j := i + Length(aSeperator);
SetValue(aSet, aSize, e);
j := i + Length(aSeparator);
end;
end;
inc(i);
@@ -1711,42 +1979,104 @@ begin

s := Trim(copy(aStr, j, i - j));
if (s <> '') then begin
result := result and TEnumHelper.TryToEnum(s, e);
result := result and h.TryToEnum(s, e);
if not result then
exit;
SetValue(aValue, e);
end
SetValue(aSet, aSize, e);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelperBase.Compare(const aSet1; const aSet2; const aSize: Integer): Integer;
var
e: Integer;
h: TutlEnumHelperBaseClass;
begin
h := EnumHelper;
if not Assigned(h) then
raise EInvalidOperation.Create('enum helper class is not set');

result := 0;
for e in h.IntValues do begin
if IsSet(aSet1, aSize, e) and not IsSet(aSet2, aSize, e) then begin
result := 1;
break;
end else
if not IsSet(aSet1, aSize, e) and IsSet(aSet2, aSize, e) then begin
result := -1;
break;
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlSetHelperBase.EnumHelper: TutlEnumHelperBaseClass;
begin
result := fEnumHelpers[ClassName];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class constructor TutlSetHelperBase.Initialize;
begin
fEnumHelpers := TEnumHelperMap.Create(true, true);