Big update for rtl-generics (aka Generics.Collections 2.0 - sync with https://github.com/maciej-izak/generics.collections). What is new:

* New collections:
    - TSortedList<T>
    - THashSet<T>
    - TAVLTreeMap<TKey, TValue>
    - TIndexedAVLTreeMap<TKey, TValue>
    - TAVLTree<T>
    - TIndexedAVLTree<T>
    - TSortedSet<T>
    - TSortedHashSet<T> (this one collection is especially interesting - optimized mix of dictionary and AVL tree)
* Ptr property for all collections
* New hash functions (the optimal hash function for collections is selected depending on environment)
* Bug fixes
* Tests

git-svn-id: trunk@38462 -

.gitattributes

@@ -7414,6 +7414,15 @@ packages/rtl-generics/src/generics.memoryexpanders.pas svneol=native#text/pascal
 packages/rtl-generics/src/generics.strings.pas svneol=native#text/pascal
 packages/rtl-generics/src/inc/generics.dictionaries.inc svneol=native#text/pascal
 packages/rtl-generics/src/inc/generics.dictionariesh.inc svneol=native#text/pascal
+packages/rtl-generics/tests/testrunner.rtlgenerics.lpi svneol=native#text/plain
+packages/rtl-generics/tests/testrunner.rtlgenerics.pp svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.arrayhelper.pas svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.bugs.pas svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.hashmaps.pas svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.sets.pas svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.stdcollections.pas svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.trees.pas svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.utils.pas svneol=native#text/pascal
 packages/rtl-objpas/Makefile svneol=native#text/plain
 packages/rtl-objpas/Makefile.fpc svneol=native#text/plain
 packages/rtl-objpas/Makefile.fpc.fpcmake svneol=native#text/plain

packages/rtl-generics/src/generics.defaults.pas

@@ -14,6 +14,14 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types and major refactoring of entire library
+
+    Thanks to mORMot (http://synopse.info) project for the best implementations
+    of hashing functions like crc32c and xxHash32 :)
+
  **********************************************************************}
 
 unit Generics.Defaults;
@@ -554,7 +562,7 @@ type
     EqualityComparer_Method_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Method ; GetHashCode: @THashFactory.Method );
     EqualityComparer_Variant_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Variant; GetHashCode: @THashFactory.Variant);
     EqualityComparer_Pointer_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Pointer; GetHashCode: @THashFactory.Pointer);
-{$WARNINGS ON}
+{.$WARNINGS ON} // do not enable warnings ever in this unit, or you will get many warnings about uninitialized TEqualityComparerVMT fields
   private class var
     // IEqualityComparer VMT
     FEqualityComparer_Int8_VMT  : THashFactory.TEqualityComparerVMT;
@@ -673,7 +681,7 @@ type
     ExtendedEqualityComparer_Method_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Method ; GetHashCode: @THashFactory.Method ; GetHashList: @TExtendedHashFactory.Method );
     ExtendedEqualityComparer_Variant_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Variant; GetHashCode: @THashFactory.Variant; GetHashList: @TExtendedHashFactory.Variant);
     ExtendedEqualityComparer_Pointer_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Pointer; GetHashCode: @THashFactory.Pointer; GetHashList: @TExtendedHashFactory.Pointer);
-{$WARNINGS ON}
+{.$WARNINGS ON} // do not enable warnings ever in this unit, or you will get many warnings about uninitialized TEqualityComparerVMT fields
   private class var
     // IExtendedEqualityComparer VMT
     FExtendedEqualityComparer_Int8_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT;
@@ -857,6 +865,12 @@ type
     class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
   end;
 
+  TmORMotHashFactory = class(THashFactory)
+  public
+    class function GetHashService: THashServiceClass; override;
+    class function GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32 = 0): UInt32; override;
+  end;
+
   { TAdler32HashFactory }
 
   TAdler32HashFactory = class(THashFactory)
@@ -922,7 +936,7 @@ type
     class procedure GetHashList(AKey: Pointer; ASize: SizeInt; AHashList: PUInt32; AOptions: TGetHashListOptions = []); override;
   end;
 
-  TDefaultHashFactory = TDelphiQuadrupleHashFactory;
+  TDefaultHashFactory = TmORMotHashFactory;
 
   TDefaultGenericInterface = (giComparer, giEqualityComparer, giExtendedEqualityComparer);
 
@@ -2782,6 +2796,18 @@ begin
   Result := DelphiHashLittle(AKey, ASize, AInitVal);
 end;
 
+{ TmORMotHashFactory }
+
+class function TmORMotHashFactory.GetHashService: THashServiceClass;
+begin
+  Result := THashService<TmORMotHashFactory>;
+end;
+
+class function TmORMotHashFactory.GetHashCode(AKey: Pointer; ASize: SizeInt; AInitVal: UInt32): UInt32;
+begin
+  Result := mORMotHasher(AInitVal, AKey, ASize);
+end;
+
 { TAdler32HashFactory }
 
 class function TAdler32HashFactory.GetHashService: THashServiceClass;
@@ -2879,7 +2905,7 @@ begin
   else
     raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
   end;
-{$WARNINGS ON}
+{.$WARNINGS ON} // do not enable warnings ever in this unit, or you will get many warnings about uninitialized TEqualityComparerVMT fields
 end;
 
 { TDelphiQuadrupleHashFactory }
@@ -3255,7 +3281,7 @@ begin
     giEqualityComparer:
       begin
         if AFactory = nil then
-          AFactory := TDelphiHashFactory;
+          AFactory := TDefaultHashFactory;
 
         Exit(
           AFactory.GetHashService.LookupEqualityComparer(ATypeInfo, ASize));

packages/rtl-generics/src/generics.hashes.pas

@@ -14,6 +14,14 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types and major refactoring of entire library.
+
+    Thanks to mORMot (http://synopse.info) project for the best implementations
+    of hashing functions like crc32c and xxHash32 :)
+
  **********************************************************************}
 
 unit Generics.Hashes;
@@ -64,6 +72,14 @@ function SimpleChecksumHash(AKey: Pointer; ALength: SizeInt): UInt32;
 // https://code.google.com/p/hedgewars/source/browse/hedgewars/adler32.pas
 function Adler32(AKey: Pointer; ALength: SizeInt): UInt32;
 function sdbm(AKey: Pointer; ALength: SizeInt): UInt32;
+function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal;
+
+type
+  THasher = function(crc: cardinal; buf: Pointer; len: cardinal): cardinal;
+
+var
+  crc32c: THasher;
+  mORMotHasher: THasher;
 
 implementation
 
@@ -911,5 +927,657 @@ begin
   Result := Int32(c);
 end;
 
+{$ifdef CPU64}
+  {$define PUREPASCAL}
+  {$ifdef CPUX64}
+    {$define CPUINTEL}
+    {$ASMMODE INTEL}
+  {$endif CPUX64}
+{$else}
+  {$ifdef CPUX86}
+    {$define CPUINTEL}
+    {$ASMMODE INTEL}
+  {$else CPUX86}
+  {$define PUREPASCAL}
+  {$endif}
+{$endif CPU64}
+
+{$ifdef CPUARM} // circumvent FPC issue on ARM
+function ToByte(value: cardinal): cardinal; inline;
+begin
+  result := value and $ff;
+end;
+{$else}
+type ToByte = byte;
+{$endif}
+
+{$ifdef CPUINTEL} // use optimized x86/x64 asm versions for xxHash32
+
+{$ifdef CPUX86}
+function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal;
+asm
+        xchg    edx, ecx
+        push    ebp
+        push    edi
+        lea     ebp, [ecx+edx]
+        push    esi
+        push    ebx
+        sub     esp, 8
+        cmp     edx, 15
+        mov     ebx, eax
+        mov     dword ptr [esp], edx
+        lea     eax, [ebx+165667B1H]
+        jbe     @2
+        lea     eax, [ebp-10H]
+        lea     edi, [ebx+24234428H]
+        lea     esi, [ebx-7A143589H]
+        mov     dword ptr [esp+4H], ebp
+        mov     edx, eax
+        lea     eax, [ebx+61C8864FH]
+        mov     ebp, edx
+@1:     mov     edx, dword ptr [ecx]
+        imul    edx, edx, -2048144777
+        add     edi, edx
+        rol     edi, 13
+        imul    edi, edi, -1640531535
+        mov     edx, dword ptr [ecx+4]
+        imul    edx, edx, -2048144777
+        add     esi, edx
+        rol     esi, 13
+        imul    esi, esi, -1640531535
+        mov     edx, dword ptr [ecx+8]
+        imul    edx, edx, -2048144777
+        add     ebx, edx
+        rol     ebx, 13
+        imul    ebx, ebx, -1640531535
+        mov     edx, dword ptr [ecx+12]
+        lea     ecx, [ecx+16]
+        imul    edx, edx, -2048144777
+        add     eax, edx
+        rol     eax, 13
+        imul    eax, eax, -1640531535
+        cmp     ebp, ecx
+        jnc     @1
+        rol     edi, 1
+        rol     esi, 7
+        rol     ebx, 12
+        add     esi, edi
+        mov     ebp, dword ptr [esp+4H]
+        ror     eax, 14
+        add     ebx, esi
+        add     eax, ebx
+@2:     lea     esi, [ecx+4H]
+        add     eax, dword ptr [esp]
+        cmp     ebp, esi
+        jc      @4
+        mov     ebx, esi
+        nop
+@3:     imul    edx, dword ptr [ebx-4H], -1028477379
+        add     ebx, 4
+        add     eax, edx
+        ror     eax, 15
+        imul    eax, eax, 668265263
+        cmp     ebp, ebx
+        jnc     @3
+        lea     edx, [ebp-4H]
+        sub     edx, ecx
+        mov     ecx, edx
+        and     ecx, 0FFFFFFFCH
+        add     ecx, esi
+@4:     cmp     ebp, ecx
+        jbe     @6
+@5:     movzx   edx, byte ptr [ecx]
+        add     ecx, 1
+        imul    edx, edx, 374761393
+        add     eax, edx
+        rol     eax, 11
+        imul    eax, eax, -1640531535
+        cmp     ebp, ecx
+        jnz     @5
+        nop
+@6:     mov     edx, eax
+        add     esp, 8
+        shr     edx, 15
+        xor     eax, edx
+        imul    eax, eax, -2048144777
+        pop     ebx
+        pop     esi
+        mov     edx, eax
+        shr     edx, 13
+        xor     eax, edx
+        imul    eax, eax, -1028477379
+        pop     edi
+        pop     ebp
+        mov     edx, eax
+        shr     edx, 16
+        xor     eax, edx
+end;
+{$endif CPUX86}
+
+{$ifdef CPUX64}
+function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal;
+asm
+        {$ifdef LINUX} // crc=rdi P=rsi len=rdx
+        mov     r8, rdi
+        mov     rcx, rsi
+        {$else} // crc=r8 P=rcx len=rdx
+        mov     r10, r8
+        mov     r8, rcx
+        mov     rcx, rdx
+        mov     rdx, r10
+        push    rsi   // Win64 expects those registers to be preserved
+        push    rdi
+        {$endif}
+        // P=r8 len=rcx crc=rdx
+        push    rbx
+        lea     r10, [rcx+rdx]
+        cmp     rdx, 15
+        lea     eax, [r8+165667B1H]
+        jbe     @2
+        lea     rsi, [r10-10H]
+        lea     ebx, [r8+24234428H]
+        lea     edi, [r8-7A143589H]
+        lea     eax, [r8+61C8864FH]
+@1:     imul    r9d, dword ptr [rcx], -2048144777
+        add     rcx, 16
+        imul    r11d, dword ptr [rcx-0CH], -2048144777
+        add     ebx, r9d
+        lea     r9d, [r11+rdi]
+        rol     ebx, 13
+        rol     r9d, 13
+        imul    ebx, ebx, -1640531535
+        imul    edi, r9d, -1640531535
+        imul    r9d, dword ptr [rcx-8H], -2048144777
+        add     r8d, r9d
+        imul    r9d, dword ptr [rcx-4H], -2048144777
+        rol     r8d, 13
+        imul    r8d, r8d, -1640531535
+        add     eax, r9d
+        rol     eax, 13
+        imul    eax, eax, -1640531535
+        cmp     rsi, rcx
+        jnc     @1
+        rol     edi, 7
+        rol     ebx, 1
+        rol     r8d, 12
+        mov     r9d, edi
+        ror     eax, 14
+        add     r9d, ebx
+        add     r8d, r9d
+        add     eax, r8d
+@2:     lea     r9, [rcx+4H]
+        add     eax, edx
+        cmp     r10, r9
+        jc      @4
+        mov     r8, r9
+@3:     imul    edx, dword ptr [r8-4H], -1028477379
+        add     r8, 4
+        add     eax, edx
+        ror     eax, 15
+        imul    eax, eax, 668265263
+        cmp     r10, r8
+        jnc     @3
+        lea     rdx, [r10-4H]
+        sub     rdx, rcx
+        mov     rcx, rdx
+        and     rcx, 0FFFFFFFFFFFFFFFCH
+        add     rcx, r9
+@4:     cmp     r10, rcx
+        jbe     @6
+@5:     movzx   edx, byte ptr [rcx]
+        add     rcx, 1
+        imul    edx, edx, 374761393
+        add     eax, edx
+        rol     eax, 11
+        imul    eax, eax, -1640531535
+        cmp     r10, rcx
+        jnz     @5
+@6:     mov     edx, eax
+        shr     edx, 15
+        xor     eax, edx
+        imul    eax, eax, -2048144777
+        mov     edx, eax
+        shr     edx, 13
+        xor     eax, edx
+        imul    eax, eax, -1028477379
+        mov     edx, eax
+        shr     edx, 16
+        xor     eax, edx
+        pop     rbx
+        {$ifndef LINUX}
+        pop     rdi
+        pop     rsi
+        {$endif}
+end;
+{$endif CPUX64}
+
+{$else not CPUINTEL}
+const
+  PRIME32_1 = 2654435761;
+  PRIME32_2 = 2246822519;
+  PRIME32_3 = 3266489917;
+  PRIME32_4 = 668265263;
+  PRIME32_5 = 374761393;
+
+// RolDWord is an intrinsic function under FPC :)
+function Rol13(value: cardinal): cardinal; inline;
+begin
+  result := RolDWord(value, 13);
+end;
+
+function xxHash32(crc: cardinal; P: Pointer; len: integer): cardinal;
+var c1, c2, c3, c4: cardinal;
+    PLimit, PEnd: PAnsiChar;
+begin
+  PEnd := P + len;
+  if len >= 16 then begin
+    PLimit := PEnd - 16;
+    c3 := crc;
+    c2 := c3 + PRIME32_2;
+    c1 := c2 + PRIME32_1;
+    c4 := c3 - PRIME32_1;
+    repeat
+      c1 := PRIME32_1 * Rol13(c1 + PRIME32_2 * PCardinal(P)^);
+      c2 := PRIME32_1 * Rol13(c2 + PRIME32_2 * PCardinal(P+4)^);
+      c3 := PRIME32_1 * Rol13(c3 + PRIME32_2 * PCardinal(P+8)^);
+      c4 := PRIME32_1 * Rol13(c4 + PRIME32_2 * PCardinal(P+12)^);
+      inc(P, 16);
+    until not (P <= PLimit);
+    result := RolDWord(c1, 1) + RolDWord(c2, 7) + RolDWord(c3, 12) + RolDWord(c4, 18);
+  end else
+    result := crc + PRIME32_5;
+  inc(result, len);
+  while P <= PEnd - 4 do begin
+    inc(result, PCardinal(P)^ * PRIME32_3);
+    result := RolDWord(result, 17) * PRIME32_4;
+    inc(P, 4);
+  end;
+  while P < PEnd do begin
+    inc(result, PByte(P)^ * PRIME32_5);
+    result := RolDWord(result, 11) * PRIME32_1;
+    inc(P);
+  end;
+  result := result xor (result shr 15);
+  result := result * PRIME32_2;
+  result := result xor (result shr 13);
+  result := result * PRIME32_3;
+  result := result xor (result shr 16);
+end;
+{$endif CPUINTEL}
+
+{$ifdef CPUINTEL}
+
+type
+ TRegisters = record
+   eax,ebx,ecx,edx: cardinal;
+ end;
+
+{$ifdef CPU64}
+procedure GetCPUID(Param: Cardinal; var Registers: TRegisters); nostackframe; assembler;
+asm
+        {$ifdef win64}
+        mov     eax, ecx
+        mov     r9, rdx
+        {$else}
+        mov     eax, edi
+        mov     r9, rsi
+        {$endif win64}
+        mov     r10, rbx // preserve rbx
+        xor     ebx, ebx
+        xor     ecx, ecx
+        xor     edx, edx
+        cpuid
+        mov     TRegisters(r9).&eax, eax
+        mov     TRegisters(r9).&ebx, ebx
+        mov     TRegisters(r9).&ecx, ecx
+        mov     TRegisters(r9).&edx, edx
+        mov     rbx, r10
+end;
+
+function crc32csse42(crc: cardinal; buf: Pointer; len: cardinal): cardinal; nostackframe; assembler;
+asm // ecx=crc, rdx=buf, r8=len (Linux: edi,rsi,rdx)
+        {$ifdef win64}
+        mov     eax, ecx
+        {$else}
+        mov     eax, edi
+        mov     r8, rdx
+        mov     rdx, rsi
+        {$endif win64}
+        not     eax
+        test    rdx, rdx
+        jz      @0
+        test    r8, r8
+        jz      @0
+@7:     test    dl, 7
+        jz      @8 // align to 8 bytes boundary
+        crc32   eax, byte ptr[rdx]
+        inc     rdx
+        dec     r8
+        jz      @0
+        test    dl, 7
+        jnz     @7
+@8:     mov     rcx, r8
+        shr     r8, 3
+        jz      @2
+@1:
+        crc32   rax, qword [rdx] // hash 8 bytes per loop
+        dec     r8
+        lea     rdx, [rdx + 8]
+        jnz     @1
+@2:     and     ecx, 7
+        jz      @0
+        cmp     ecx, 4
+        jb      @4
+        crc32   eax, dword ptr[rdx]
+        sub     ecx, 4
+        lea     rdx, [rdx + 4]
+        jz      @0
+@4:     crc32   eax, byte ptr[rdx]
+        dec     ecx
+        jz      @0
+        crc32   eax, byte ptr[rdx + 1]
+        dec     ecx
+        jz      @0
+        crc32   eax, byte ptr[rdx + 2]
+@0:     not     eax
+end;
+{$endif CPU64}
+
+{$ifdef CPUX86}
+procedure GetCPUID(Param: Cardinal; var Registers: TRegisters);
+asm
+        push    esi
+        push    edi
+        mov     esi, edx
+        mov     edi, eax
+        pushfd
+        pop     eax
+        mov     edx, eax
+        xor     eax, $200000
+        push    eax
+        popfd
+        pushfd
+        pop     eax
+        xor     eax, edx
+        jz      @nocpuid
+        push    ebx
+        mov     eax, edi
+        xor     ecx, ecx
+        cpuid
+        mov     TRegisters(esi).&eax, eax
+        mov     TRegisters(esi).&ebx, ebx
+        mov     TRegisters(esi).&ecx, ecx
+        mov     TRegisters(esi).&edx, edx
+        pop     ebx
+@nocpuid:
+        pop     edi
+        pop     esi
+end;
+
+function crc32csse42(crc: cardinal; buf: Pointer; len: cardinal): cardinal;
+asm // eax=crc, edx=buf, ecx=len
+        not     eax
+        test    ecx, ecx
+        jz      @0
+        test    edx, edx
+        jz      @0
+@3:     test    edx, 3
+        jz      @8 // align to 4 bytes boundary
+        crc32   eax, byte ptr[edx]
+        inc     edx
+        dec     ecx
+        jz      @0
+        test    edx, 3
+        jnz     @3
+@8:     push    ecx
+        shr     ecx, 3
+        jz      @2
+@1:
+        crc32   eax, dword ptr[edx]
+        crc32   eax, dword ptr[edx + 4]
+        dec     ecx
+        lea     edx, [edx + 8]
+        jnz     @1
+@2:     pop     ecx
+        and     ecx, 7
+        jz      @0
+        cmp     ecx, 4
+        jb      @4
+        crc32   eax, dword ptr[edx]
+        sub     ecx, 4
+        lea     edx, [edx + 4]
+        jz      @0
+@4:
+        crc32   eax, byte ptr[edx]
+        dec     ecx
+        jz      @0
+        crc32   eax, byte ptr[edx + 1]
+        dec     ecx
+        jz      @0
+        crc32   eax, byte ptr[edx + 2]
+@0:     not     eax
+end;
+{$endif CPUX86}
+
+type
+  /// the potential features, retrieved from an Intel CPU
+  // - see https://en.wikipedia.org/wiki/CPUID#EAX.3D1:_Processor_Info_and_Feature_Bits
+  TIntelCpuFeature =
+   ( { in EDX }
+   cfFPU, cfVME, cfDE, cfPSE, cfTSC, cfMSR, cfPAE, cfMCE,
+   cfCX8, cfAPIC, cf_d10, cfSEP, cfMTRR, cfPGE, cfMCA, cfCMOV,
+   cfPAT, cfPSE36, cfPSN, cfCLFSH, cf_d20, cfDS, cfACPI, cfMMX,
+   cfFXSR, cfSSE, cfSSE2, cfSS, cfHTT, cfTM, cfIA64, cfPBE,
+   { in ECX }
+   cfSSE3, cfCLMUL, cfDS64, cfMON, cfDSCPL, cfVMX, cfSMX, cfEST,
+   cfTM2, cfSSSE3, cfCID, cfSDBG, cfFMA, cfCX16, cfXTPR, cfPDCM,
+   cf_c16, cfPCID, cfDCA, cfSSE41, cfSSE42, cfX2A, cfMOVBE, cfPOPCNT,
+   cfTSC2, cfAESNI, cfXS, cfOSXS, cfAVX, cfF16C, cfRAND, cfHYP,
+   { extended features in EBX, ECX }
+   cfFSGS, cf_b01, cfSGX, cfBMI1, cfHLE, cfAVX2, cf_b06, cfSMEP,
+   cfBMI2, cfERMS, cfINVPCID, cfRTM, cfPQM, cf_b13, cfMPX, cfPQE,
+   cfAVX512F, cfAVX512DQ, cfRDSEED, cfADX, cfSMAP, cfAVX512IFMA, cfPCOMMIT, cfCLFLUSH,
+   cfCLWB, cfIPT, cfAVX512PF, cfAVX512ER, cfAVX512CD, cfSHA, cfAVX512BW, cfAVX512VL,
+   cfPREFW1, cfAVX512VBMI, cfUMIP, cfPKU, cfOSPKE, cf_c05, cf_c06, cf_c07,
+   cf_c08, cf_c09, cf_c10, cf_c11, cf_c12, cf_c13, cfAVX512VPC, cf_c15,
+   cf_cc16, cf_c17, cf_c18, cf_c19, cf_c20, cf_c21, cfRDPID, cf_c23,
+   cf_c24, cf_c25, cf_c26, cf_c27, cf_c28, cf_c29, cfSGXLC, cf_c31,
+   cf_d0, cf_d1, cfAVX512NNI, cfAVX512MAS, cf_d4, cf_d5, cf_d6, cf_d7);
+
+  /// all features, as retrieved from an Intel CPU
+  TIntelCpuFeatures = set of TIntelCpuFeature;
+
+var
+  /// the available CPU features, as recognized at program startup
+  CpuFeatures: TIntelCpuFeatures;
+
+procedure TestIntelCpuFeatures;
+var regs: TRegisters;
+begin
+  regs.edx := 0;
+  regs.ecx := 0;
+  GetCPUID(1,regs);
+  PIntegerArray(@CpuFeatures)^[0] := regs.edx;
+  PIntegerArray(@CpuFeatures)^[1] := regs.ecx;
+  GetCPUID(7,regs);
+  PIntegerArray(@CpuFeatures)^[2] := regs.ebx;
+  PIntegerArray(@CpuFeatures)^[3] := regs.ecx;
+  PByte(@PIntegerArray(@CpuFeatures)^[4])^ := regs.edx;
+//  assert(sizeof(CpuFeatures)=4*4+1);
+  {$ifdef Darwin}
+  {$ifdef CPU64}
+  // SSE42 asm does not (yet) work on Darwin x64 ...
+  Exclude(CpuFeatures, cfSSE42);
+  {$endif}
+  {$endif}
+end;
+{$endif CPUINTEL}
+
+var
+  crc32ctab: array[0..{$ifdef PUREPASCAL}3{$else}7{$endif},byte] of cardinal;
+
+function crc32cfast(crc: cardinal; buf: Pointer; len: cardinal): cardinal;
+{$ifdef PUREPASCAL}
+begin
+  result := not crc;
+  if (buf<>nil) and (len>0) then begin
+    repeat
+      if PtrUInt(buf) and 3=0 then // align to 4 bytes boundary
+        break;
+      result := crc32ctab[0,ToByte(result xor cardinal(buf^))] xor (result shr 8);
+      dec(len);
+      inc(buf);
+    until len=0;
+    while len>=4 do begin
+      result := result xor PCardinal(buf)^;
+      inc(buf,4);
+      result := crc32ctab[3,ToByte(result)] xor
+                crc32ctab[2,ToByte(result shr 8)] xor
+                crc32ctab[1,ToByte(result shr 16)] xor
+                crc32ctab[0,result shr 24];
+      dec(len,4);
+    end;
+    while len>0 do begin
+      result := crc32ctab[0,ToByte(result xor cardinal(buf^))] xor (result shr 8);
+      dec(len);
+      inc(buf);
+    end;
+  end;
+  result := not result;
+end;
+{$else}
+// adapted from fast Aleksandr Sharahov version
+asm
+        test    edx, edx
+        jz      @ret
+        neg     ecx
+        jz      @ret
+        not     eax
+        push    ebx
+@head:  test    dl, 3
+        jz      @aligned
+        movzx   ebx, byte[edx]
+        inc     edx
+        xor     bl, al
+        shr     eax, 8
+        xor     eax, dword ptr[ebx * 4 + crc32ctab]
+        inc     ecx
+        jnz     @head
+        pop     ebx
+        not     eax
+        ret
+@ret:   rep     ret
+@aligned:
+        sub     edx, ecx
+        add     ecx, 8
+        jg      @bodydone
+        push    esi
+        push    edi
+        mov     edi, edx
+        mov     edx, eax
+@bodyloop:
+        mov     ebx, [edi + ecx - 4]
+        xor     edx, [edi + ecx - 8]
+        movzx   esi, bl
+        mov     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
+        movzx   esi, bh
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
+        shr     ebx, 16
+        movzx   esi, bl
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
+        movzx   esi, bh
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
+        movzx   esi, dl
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 7]
+        movzx   esi, dh
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 6]
+        shr     edx, 16
+        movzx   esi, dl
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 5]
+        movzx   esi, dh
+        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 4]
+        add     ecx, 8
+        jg      @done
+        mov     ebx, [edi + ecx - 4]
+        xor     eax, [edi + ecx - 8]
+        movzx   esi, bl
+        mov     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
+        movzx   esi, bh
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
+        shr     ebx, 16
+        movzx   esi, bl
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
+        movzx   esi, bh
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
+        movzx   esi, al
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 7]
+        movzx   esi, ah
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 6]
+        shr     eax, 16
+        movzx   esi, al
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 5]
+        movzx   esi, ah
+        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 4]
+        add     ecx, 8
+        jle     @bodyloop
+        mov     eax, edx
+@done:  mov     edx, edi
+        pop     edi
+        pop     esi
+@bodydone:
+        sub     ecx, 8
+        jl      @tail
+        pop     ebx
+        not     eax
+        ret
+@tail:  movzx   ebx, byte[edx + ecx]
+        xor     bl, al
+        shr     eax, 8
+        xor     eax, dword ptr[ebx * 4 + crc32ctab]
+        inc     ecx
+        jnz     @tail
+        pop     ebx
+        not     eax
+end;
+{$endif PUREPASCAL}
+
+procedure InitializeCrc32ctab;
+var
+  i, n: integer;
+  crc: cardinal;
+begin
+  // initialize tables for crc32cfast() and SymmetricEncrypt/FillRandom
+  for i := 0 to 255 do begin
+    crc := i;
+    for n := 1 to 8 do
+      if (crc and 1)<>0 then // polynom is not the same as with zlib's crc32()
+        crc := (crc shr 1) xor $82f63b78 else
+        crc := crc shr 1;
+    crc32ctab[0,i] := crc;
+  end;
+  for i := 0 to 255 do begin
+    crc := crc32ctab[0,i];
+    for n := 1 to high(crc32ctab) do begin
+      crc := (crc shr 8) xor crc32ctab[0,ToByte(crc)];
+      crc32ctab[n,i] := crc;
+    end;
+  end;
+end;
+
+begin
+  {$ifdef CPUINTEL}
+  TestIntelCpuFeatures;
+  if cfSSE42 in CpuFeatures then
+  begin
+    crc32c := @crc32csse42;
+    mORMotHasher := @crc32csse42;
+  end
+  else
+  {$endif CPUINTEL}
+  begin
+    InitializeCrc32ctab;
+    crc32c := @crc32cfast;
+    mORMotHasher := @xxHash32;
+  end;
 end.
 

packages/rtl-generics/src/generics.helpers.pas

@@ -20,6 +20,8 @@ unit Generics.Helpers;
 
 {$MODE DELPHI}{$H+}
 {$MODESWITCH TYPEHELPERS}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
 
 interface
 

packages/rtl-generics/src/generics.memoryexpanders.pas

@@ -21,6 +21,8 @@ unit Generics.MemoryExpanders;
 
 {$mode delphi}
 {$MACRO ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
 {.$WARN 5024 OFF}
 {.$WARN 4079 OFF}
 

packages/rtl-generics/src/generics.strings.pas

@@ -24,7 +24,10 @@ interface
 
 resourcestring
   SArgumentOutOfRange = 'Argument out of range';
+  SArgumentNilNode = 'Node is nil';
   SDuplicatesNotAllowed = 'Duplicates not allowed in dictionary';
+  SCollectionInconsistency = 'Collection inconsistency';
+  SCollectionDuplicate = 'Collection does not allow duplicates';
   SDictionaryKeyDoesNotExist = 'Dictionary key does not exist';
   SItemNotFound = 'Item not found';
 

packages/rtl-generics/src/inc/generics.dictionaries.inc

@@ -16,6 +16,14 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types and major refactoring of entire library
+
+    Thanks to mORMot (http://synopse.info) project for the best implementations
+    of hashing functions like crc32c and xxHash32 :)
+
  **********************************************************************}
 
 { TPair<TKey,TValue> }
@@ -29,7 +37,7 @@ end;
 
 { TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS> }
 
-procedure TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.PairNotify(constref APair: TPair<TKey, TValue>;
+procedure TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.PairNotify(constref APair: TDictionaryPair;
   ACollectionNotification: TCollectionNotification);
 begin
   KeyNotify(APair.Key, ACollectionNotification);
@@ -88,16 +96,35 @@ begin
   Create(ACollection, TEqualityComparer<TKey>.Default(THashFactory));
 end;
 
+{$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+constructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>);
+begin
+  Create(ACollection, TEqualityComparer<TKey>.Default(THashFactory));
+end;
+{$ENDIF}
+
 constructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>;
   const AComparer: IEqualityComparer<TKey>); overload;
 var
-  LItem: TPair<TKey, TValue>;
+  LItem: TDictionaryPair;
 begin
   Create(AComparer);
   for LItem in ACollection do
     Add(LItem);
 end;
 
+{$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+constructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>;
+  const AComparer: IEqualityComparer<TKey>); overload;
+var
+  LItem: PDictionaryPair;
+begin
+  Create(AComparer);
+  for LItem in ACollection.Ptr^ do
+    Add(LItem^);
+end;
+{$ENDIF}
+
 destructor TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>.Destroy;
 begin
   Clear;
@@ -143,27 +170,32 @@ begin
   Result := GetCurrent;
 end;
 
-{ TDictionaryEnumerable<TDictionaryEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS> }
+{ TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS> }
+
+function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.GetPtrEnumerator: TEnumerator<PT>;
+begin
+  Result := TDictionaryPointersEnumerator.Create(FDictionary);
+end;
 
-constructor TDictionaryEnumerable<TDictionaryEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.Create(
+constructor TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.Create(
   ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
 begin
   FDictionary := ADictionary;
 end;
 
-function TDictionaryEnumerable<TDictionaryEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.
+function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.
   DoGetEnumerator: TDictionaryEnumerator;
 begin
   Result := TDictionaryEnumerator(TDictionaryEnumerator.NewInstance);
   TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS>(Result).Create(FDictionary);
 end;
 
-function TDictionaryEnumerable<TDictionaryEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.GetCount: SizeInt;
+function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.GetCount: SizeInt;
 begin
   Result := TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>(FDictionary).Count;
 end;
 
-function TDictionaryEnumerable<TDictionaryEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.ToArray: TArray<T>;
+function TDictionaryEnumerable<TDictionaryEnumerator, TDictionaryPointersEnumerator, T, CUSTOM_DICTIONARY_CONSTRAINTS>.ToArray: TArray<T>;
 begin
   Result := ToArrayImpl(FDictionary.Count);
 end;
@@ -193,6 +225,89 @@ begin
   Result := True;
 end;
 
+{ TOpenAddressingPointersEnumerator<TItem, PDictionaryPair> }
+
+function TOpenAddressingPointersEnumerator<TItem, PDictionaryPair>.DoMoveNext: boolean;
+var
+  LLength: SizeInt;
+begin
+  Inc(FIndex);
+
+  LLength := Length(FItems^);
+
+  if FIndex >= LLength then
+    Exit(False);
+
+  // maybe related to bug #24098
+  // compiler error for (TDictionary<DICTIONARY_CONSTRAINTS>(FDictionary).FItems[FIndex].Hash and UInt32.GetSignMask) = 0
+  while (FItems^[FIndex].Hash and UInt32.GetSignMask) = 0 do
+  begin
+    Inc(FIndex);
+    if FIndex = LLength then
+      Exit(False);
+  end;
+
+  Result := True;
+end;
+
+function TOpenAddressingPointersEnumerator<TItem, PDictionaryPair>.DoGetCurrent: PDictionaryPair;
+begin
+  Result := GetCurrent;
+end;
+
+function TOpenAddressingPointersEnumerator<TItem, PDictionaryPair>.GetCurrent: PDictionaryPair;
+begin
+  Result := @FItems^[FIndex].Pair;
+end;
+
+constructor TOpenAddressingPointersEnumerator<TItem, PDictionaryPair>.Create(var AItems);
+begin
+  FIndex := -1;
+  FItems := @AItems;
+end;
+
+{ TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair> }
+
+function TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair>.Items: PArray;
+begin
+  Result := PArray(@((@Self)^));
+end;
+
+function TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair>.GetCount: SizeInt;
+begin
+  Result := PSizeInt(PByte(@((@Self)^))-SizeOf(SizeInt))^;
+end;
+
+function TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair>.GetEnumerator: TPointersEnumerator;
+begin
+  Result := TPointersEnumerator(TPointersEnumerator.NewInstance);
+  TPointersEnumerator(Result).Create(Items^);
+end;
+
+function TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair>.ToArray: TArray<PDictionaryPair>;
+{begin
+  Result := ToArrayImpl(FList.Count);
+end;}
+var
+  i: SizeInt;
+  LEnumerator: TPointersEnumerator;
+begin
+  SetLength(Result, GetCount);
+
+  try
+    LEnumerator := GetEnumerator;
+
+    i := 0;
+    while LEnumerator.MoveNext do
+    begin
+      Result[i] := LEnumerator.Current;
+      Inc(i);
+    end;
+  finally
+    LEnumerator.Free;
+  end;
+end;
+
 { TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS> }
 
 constructor TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACapacity: SizeInt;
@@ -224,7 +339,7 @@ begin
   Result := FindBucketIndex(FItems, AKey, LHash);
 end;
 
-function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.PrepareAddingItem: SizeInt;
+procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.PrepareAddingItem;
 begin
   if RealItemsLength > FItemsThreshold then
     Rehash(Length(FItems) shl 1)
@@ -235,9 +350,6 @@ begin
   end
   else if FItemsLength = $40000001 then // High(TIndex) ... Error: Type mismatch
     OutOfMemoryError;
-
-  Result := FItemsLength;
-  Inc(FItemsLength);
 end;
 
 procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.UpdateItemsThreshold(ASize: SizeInt);
@@ -255,9 +367,17 @@ begin
   AItem.Pair.Key := AKey;
   AItem.Pair.Value := AValue;
 
+  // ! very important. FItemsLength must be increased after above code (because constref has meaning)
+  Inc(FItemsLength);
+
   PairNotify(AItem.Pair, cnAdded);
 end;
 
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.GetPointers: PPointersCollection;
+begin
+  Result := PPointersCollection(@FItems);
+end;
+
 procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.Add(constref AKey: TKey; constref AValue: TValue);
 begin
   DoAdd(AKey, AValue);
@@ -302,7 +422,7 @@ var
   LIndex: SizeInt;
 begin
   LIndex := FindBucketIndex(AKey);
-  if LIndex  < 0 then
+  if LIndex < 0 then
     Exit;
 
   DoRemove(LIndex, cnRemoved);
@@ -313,7 +433,7 @@ var
   LIndex: SizeInt;
 begin
   LIndex := FindBucketIndex(AKey);
-  if LIndex  < 0 then
+  if LIndex < 0 then
     Exit(Default(TPair<TKey, TValue>));
 
   Result.Key := AKey;
@@ -555,6 +675,13 @@ begin
   Result := TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>(FDictionary).FItems[FIndex].Pair.Value;
 end;
 
+{ TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TPValueEnumerator }
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TPValueEnumerator.GetCurrent: PValue;
+begin
+  Result := @(TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>(FDictionary).FItems[FIndex].Pair.Value);
+end;
+
 { TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TKeyEnumerator }
 
 function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TKeyEnumerator.GetCurrent: TKey;
@@ -562,6 +689,13 @@ begin
   Result := TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>(FDictionary).FItems[FIndex].Pair.Key;
 end;
 
+{ TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TPKeyEnumerator }
+
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TPKeyEnumerator.GetCurrent: PKey;
+begin
+  Result := @(TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>(FDictionary).FItems[FIndex].Pair.Key);
+end;
+
 { TOpenAddressingLP<DICTIONARY_CONSTRAINTS> }
 
 procedure TOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.NotifyIndexChange(AFrom, ATo: SizeInt);
@@ -885,6 +1019,13 @@ constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: T
 begin
 end;
 
+{$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+end;
+{$ENDIF}
+
 constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACapacity: SizeInt);
 begin
   Create(ACapacity, TExtendedEqualityComparer<TKey>.Default(THashFactory));
@@ -895,6 +1036,13 @@ begin
   Create(ACollection, TExtendedEqualityComparer<TKey>.Default(THashFactory));
 end;
 
+{$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>);
+begin
+  Create(ACollection, TExtendedEqualityComparer<TKey>.Default(THashFactory));
+end;
+{$ENDIF}
+
 constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACapacity: SizeInt;
   const AComparer: IExtendedEqualityComparer<TKey>);
 begin
@@ -911,13 +1059,25 @@ end;
 constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>;
   const AComparer: IExtendedEqualityComparer<TKey>);
 var
-  LItem: TPair<TKey, TValue>;
+  LItem: TDictionaryPair;
 begin
   Create(AComparer);
   for LItem in ACollection do
     Add(LItem);
 end;
 
+{$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+constructor TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>;
+  const AComparer: IExtendedEqualityComparer<TKey>);
+var
+  LItem: PDictionaryPair;
+begin
+  Create(AComparer);
+  for LItem in ACollection.Ptr^ do
+    Add(LItem^);
+end;
+{$ENDIF}
+
 procedure TOpenAddressingDH<OPEN_ADDRESSING_CONSTRAINTS>.UpdateItemsThreshold(ASize: SizeInt);
 begin
   inherited;
@@ -1073,6 +1233,126 @@ begin
   Result := True;
 end;
 
+{ TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair> }
+
+function TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair>.DoMoveNext: boolean;
+var
+  LLength: SizeInt;
+  LArray: TItemsArray;
+begin
+  Inc(FIndex);
+
+  if (FMainIndex = TCuckooCfg.D) then // queue
+  begin
+    LLength := Length(FQueue.FItems);
+    if FIndex >= LLength then
+      Exit(False);
+
+    while ((FQueue.FItems[FIndex].Hash)
+      and UInt32.GetSignMask) = 0 do
+    begin
+      Inc(FIndex);
+      if FIndex = LLength then
+        Exit(False);
+    end;
+  end
+  else // d-array
+  begin
+    LArray := FItems^[FMainIndex];
+    LLength := Length(LArray);
+    if FIndex >= LLength then
+    begin
+      Inc(FMainIndex);
+      FIndex := -1;
+      Exit(DoMoveNext);
+    end;
+
+    while (((LArray[FIndex]).Hash) and UInt32.GetSignMask) = 0 do
+    begin
+      Inc(FIndex);
+      if FIndex = LLength then
+      begin
+        Inc(FMainIndex);
+        FIndex := -1;
+        Exit(DoMoveNext);
+      end;
+    end;
+  end;
+
+  Result := True;
+end;
+
+function TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair>.DoGetCurrent: PDictionaryPair;
+begin
+  Result := GetCurrent;
+end;
+
+function TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair>.GetCurrent: PDictionaryPair;
+begin
+  if FMainIndex = TCuckooCfg.D then
+    Result := @(FQueue.FItems[FIndex].Pair.Value.Pair)
+  else
+    Result := @((FItems^[FMainIndex])[FIndex].Pair);
+end;
+
+constructor TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair>.Create(var AItems; AQueue: TQueueDictionary; ACount: SizeInt);
+begin
+  FIndex := -1;
+  if ACount = 0 then
+    FMainIndex := TCuckooCfg.D
+  else
+    FMainIndex := 0;
+  FQueue := AQueue;
+  FItems := @AItems;
+end;
+
+{ TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItem, TQueueDictionary, PDictionaryPair> }
+
+function TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>.Items: PArray;
+begin
+  Result := PArray(@((@Self)^));
+end;
+
+function TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>.GetCount: SizeInt;
+begin
+  Result := SizeInt((@PByte(@((@Self)^))[-SizeOf(SizeInt)])^);
+end;
+
+function TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>.GetQueue: TQueueDictionary;
+begin
+  Result := TQueueDictionary((@PByte(@((@Self)^))[SizeOf(TItemsDArray)])^);
+end;
+
+function TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>.GetEnumerator: TPointersEnumerator;
+begin
+  Result := TPointersEnumerator(TPointersEnumerator.NewInstance);
+  TPointersEnumerator(Result).Create(Items^, GetQueue, GetCount);
+end;
+
+function TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>.ToArray: TArray<PDictionaryPair>;
+{begin
+  Result := ToArrayImpl(FList.Count);
+end;}
+var
+  i: SizeInt;
+  LEnumerator: TPointersEnumerator;
+begin
+  SetLength(Result, GetCount);
+
+  try
+    LEnumerator := GetEnumerator;
+
+    i := 0;
+    while LEnumerator.MoveNext do
+    begin
+      Result[i] := LEnumerator.Current;
+      Inc(i);
+    end;
+  finally
+    LEnumerator.Free;
+  end;
+end;
+
 { TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS> }
 
 function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TQueueDictionary.Rehash(ASizePow2: SizeInt;
@@ -1133,7 +1413,7 @@ end;
 
 function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TQueueDictionary.Pop: Pointer;
 var
-  AIndex, LGap: SizeInt;
+  AIndex: SizeInt;
   //LResult: TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TItem; !!!bug #25917
 begin
   AIndex := FIdx.DoRemove(FIdx.Count - 1, cnExtracted);
@@ -1173,6 +1453,13 @@ constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection:
 begin
 end;
 
+{$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>;
+  const AComparer: IEqualityComparer<TKey>);
+begin
+end;
+{$ENDIF}
+
 constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create;
 begin
   Create(0);
@@ -1188,6 +1475,13 @@ begin
   Create(ACollection, TExtendedEqualityComparer<TKey>.Default(THashFactory));
 end;
 
+{$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>);
+begin
+  Create(ACollection, TExtendedEqualityComparer<TKey>.Default(THashFactory));
+end;
+{$ENDIF}
+
 constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACapacity: SizeInt;
   const AComparer: IExtendedEqualityComparer<TKey>);
 begin
@@ -1217,13 +1511,25 @@ end;
 constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection: TEnumerable<TDictionaryPair>;
   const AComparer: IExtendedEqualityComparer<TKey>);
 var
-  LItem: TPair<TKey, TValue>;
+  LItem: TDictionaryPair;
 begin
   Create(AComparer);
   for LItem in ACollection do
     Add(LItem);
 end;
 
+{$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+constructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Create(ACollection: TEnumerableWithPointers<TDictionaryPair>;
+  const AComparer: IExtendedEqualityComparer<TKey>);
+var
+  LItem: PDictionaryPair;
+begin
+  Create(AComparer);
+  for LItem in ACollection.Ptr^ do
+    Add(LItem^);
+end;
+{$ENDIF}
+
 destructor TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Destroy;
 begin
   inherited;
@@ -1245,6 +1551,11 @@ begin
   Result := TValueCollection(FValues);
 end;
 
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.GetPointers: PPointersCollection;
+begin
+  Result := PPointersCollection(@FItems);
+end;
+
 function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Lookup(constref AKey: TKey;
   var AHashListOrIndex: PUInt32): SizeInt;
 begin
@@ -1310,7 +1621,7 @@ begin
   Result := LR_NIL;
 end;
 
-function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.PrepareAddingItem: SizeInt;
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.PrepareAddingItem;
 var
   i: SizeInt;
 begin
@@ -1324,9 +1635,6 @@ begin
   end
   else if FItemsLength = $40000001 then // High(TIndex) ... Error: Type mismatch
     OutOfMemoryError;
-
-  Result := FItemsLength;
-  Inc(FItemsLength);
 end;
 
 procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.UpdateItemsThreshold(ASize: SizeInt);
@@ -1348,7 +1656,7 @@ var
   y: boolean = false;
   b: UInt32;
   LIndex: UInt32;
-  i, j, LLengthMask: SizeInt;
+  i, LLengthMask: SizeInt;
   LTempItem: TItem;
   LHashList: array[0..1] of UInt32;
   LHashListParams: array[0..3] of UInt16 absolute LHashList;
@@ -1411,10 +1719,11 @@ begin
     FQueue.InsertIntoHead(@LNewItem);
 end;
 
-procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.DoAdd(constref AKey: TKey; constref AValue: TValue;
+procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.DoAdd(const AKey: TKey; const AValue: TValue;
   const AHashList: PUInt32);
 begin
   AddItem(FItems, AKey, AValue, AHashList);
+  Inc(FItemsLength);
   KeyNotify(AKey, cnAdded);
   ValueNotify(AValue, cnAdded);
 end;
@@ -1545,10 +1854,8 @@ end;
 procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.Rehash(ASizePow2: SizeInt);
 var
   LNewItems: TItemsDArray;
-  LHash: UInt32;
-  LIndex: SizeInt;
   i, j: SizeInt;
-  LItem, LNewItem: PItem;
+  LItem: PItem;
   LOldQueue: TQueueDictionary;
 var
   LHashList: array[0..1] of UInt32;
@@ -1688,6 +1995,8 @@ end;
 procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TrimExcess;
 begin
   SetCapacity(Succ(FItemsLength));
+  FQueue.TrimExcess;
+  FQueue.FIdx.TrimExcess;
 end;
 
 procedure TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.SetItem(constref AValue: TValue;
@@ -1711,7 +2020,6 @@ var
   LHashList: array[0..TCuckooCfg.D] of UInt32;
   LHashListOrIndex: PUint32;
   LLookupResult: SizeInt;
-  LIndex: UInt32;
 begin
   LHashListOrIndex := @LHashList[0];
   LLookupResult := Lookup(AKey, LHashListOrIndex);
@@ -1747,16 +2055,17 @@ var
   LHashList: array[0..TCuckooCfg.D] of UInt32;
   LHashListOrIndex: PUint32;
   LLookupResult: SizeInt;
-  LIndex: UInt32;
 begin
   LHashListOrIndex := @LHashList[0];
   LLookupResult := Lookup(AKey, LHashListOrIndex);
 
   if LLookupResult = LR_NIL then
-  begin
-    PrepareAddingItem;
-    DoAdd(AKey, AValue, LHashListOrIndex);
-  end
+    Add(AKey, AValue)
+    // more optimal version for AddOrSetValue has some bug : see Test_CuckooD2_Notification
+    //begin
+    //  PrepareAddingItem;
+    //  DoAdd(AKey, AValue, LHashListOrIndex);
+    //end
   else
     SetItem(AValue, LHashListOrIndex, LLookupResult);
 end;
@@ -1832,6 +2141,16 @@ begin
     Result := TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FItems[FMainIndex][FIndex].Pair.Value;
 end;
 
+{ TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TPValueEnumerator }
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TPValueEnumerator.GetCurrent: PValue;
+begin
+  if FMainIndex = TCuckooCfg.D then
+    Result := @(TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FQueue.FItems[FIndex].Pair.Value.Pair.Value)
+  else
+    Result := @(TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FItems[FMainIndex][FIndex].Pair.Value);
+end;
+
 { TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TKeyEnumerator }
 
 function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TKeyEnumerator.GetCurrent: TKey;
@@ -1842,6 +2161,16 @@ begin
     Result := TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FItems[FMainIndex][FIndex].Pair.Key;
 end;
 
+{ TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TPKeyEnumerator }
+
+function TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.TPKeyEnumerator.GetCurrent: TKey;
+begin
+  if FMainIndex = TCuckooCfg.D then
+    Result := @(TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FQueue.FItems[FIndex].Pair.Value.Pair.Key)
+  else
+    Result := @(TDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>(FDictionary).FItems[FMainIndex][FIndex].Pair.Key);
+end;
+
 { TObjectDictionary<DICTIONARY_CONSTRAINTS> }
 
 procedure TObjectDeamortizedDArrayCuckooMap<CUCKOO_CONSTRAINTS>.KeyNotify(

packages/rtl-generics/src/inc/generics.dictionariesh.inc

@@ -16,6 +16,14 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types and major refactoring of entire library
+
+    Thanks to mORMot (http://synopse.info) project for the best implementations
+    of hashing functions like crc32c and xxHash32 :)
+
  **********************************************************************}
 
 {$WARNINGS OFF}
@@ -44,8 +52,7 @@ type
     PKey = ^TKey;
     PValue = ^TValue;
     THashFactoryClass = THashFactory;
-  public
-    FItemsLength: SizeInt;
+  protected
     FEqualityComparer: IEqualityComparer<TKey>;
     FKeys: TEnumerable<TKey>;
     FValues: TEnumerable<TValue>;
@@ -63,8 +70,6 @@ type
     property LoadFactor: single read GetLoadFactor;
     property Capacity: SizeInt read GetCapacity write SetCapacity;
 
-    property Count: SizeInt read FItemsLength;
-
     procedure Clear; virtual; abstract;
     procedure Add(constref APair: TPair<TKey, TValue>); virtual; abstract;
   strict private // bug #24283. workaround for this class because can't inherit from TEnumerable
@@ -78,6 +83,10 @@ type
     constructor Create(const AComparer: IEqualityComparer<TKey>); overload;
     constructor Create(ACollection: TEnumerable<TDictionaryPair>); virtual; overload;
     constructor Create(ACollection: TEnumerable<TDictionaryPair>; const AComparer: IEqualityComparer<TKey>); virtual; overload;
+    {$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>); virtual; overload;
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>; const AComparer: IEqualityComparer<TKey>); virtual; overload;
+    {$ENDIF}
 
     destructor Destroy; override;
   private
@@ -88,11 +97,15 @@ type
 
     procedure KeyNotify(constref AKey: TKey; ACollectionNotification: TCollectionNotification); virtual;
     procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); virtual;
-    procedure PairNotify(constref APair: TPair<TKey, TValue>; ACollectionNotification: TCollectionNotification); inline;
+    procedure PairNotify(constref APair: TDictionaryPair; ACollectionNotification: TCollectionNotification); inline;
     procedure SetValue(var AValue: TValue; constref ANewValue: TValue);
   public
     property OnKeyNotify: TCollectionNotifyEvent<TKey> read FOnKeyNotify write FOnKeyNotify;
     property OnValueNotify: TCollectionNotifyEvent<TValue> read FOnValueNotify write FOnValueNotify;
+  protected // FItemsLength must be declared at the end of TCustomDictionary
+    FItemsLength: SizeInt;
+  public
+    property Count: SizeInt read FItemsLength;
   end;
 
   { TCustomDictionaryEnumerator }
@@ -110,27 +123,52 @@ type
 
   { TDictionaryEnumerable }
 
-  TDictionaryEnumerable<TDictionaryEnumerator: TObject; // ... inherits from TCustomDictionaryEnumerator. workaround...
-    T, CUSTOM_DICTIONARY_CONSTRAINTS> = class abstract(TEnumerable<T>)
+  TDictionaryEnumerable<TDictionaryEnumerator: TObject; TDictionaryPointersEnumerator, // ... inherits from TCustomDictionaryEnumerator. workaround...
+    T, CUSTOM_DICTIONARY_CONSTRAINTS> = class abstract(TEnumerableWithPointers<T>)
   private
     FDictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>;
     function GetCount: SizeInt;
+  protected
+    function GetPtrEnumerator: TEnumerator<PT>; override;
+    function DoGetEnumerator: TDictionaryEnumerator; override;
   public
     constructor Create(ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
-    function DoGetEnumerator: TDictionaryEnumerator; override;
     function ToArray: TArray<T>; override; final;
     property Count: SizeInt read GetCount;
   end;
 
   // more info : http://en.wikipedia.org/wiki/Open_addressing
 
-  { TDictionaryEnumerable }
+  { TOpenAddressingEnumerator }
 
   TOpenAddressingEnumerator<T, OPEN_ADDRESSING_CONSTRAINTS> = class abstract(TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS>)
   protected
     function DoMoveNext: Boolean; override;
   end;
 
+  TOpenAddressingPointersEnumerator<TItem, PDictionaryPair> = class abstract(TEnumerator<PDictionaryPair>)
+  private var
+    FItems: ^TArray<TItem>;
+    FIndex: SizeInt;
+  protected
+    function DoMoveNext: boolean; override;
+    function DoGetCurrent: PDictionaryPair; override;
+    function GetCurrent: PDictionaryPair; virtual;
+  public
+    constructor Create(var AItems);
+  end;
+
+  TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair> = record
+  private type
+    PArray = ^TArray<TItem>;
+    function Items: PArray; inline;
+    function GetCount: SizeInt; inline;
+  public
+    function GetEnumerator: TPointersEnumerator;
+    function ToArray: TArray<PDictionaryPair>;
+    property Count: SizeInt read GetCount;
+  end;
+
   TOnGetMemoryLayoutKeyPosition = procedure(Sender: TObject; AKeyPos: UInt32) of object;
 
   TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS> = class abstract(TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>)
@@ -142,12 +180,16 @@ type
     end;
 
     TItemsArray = array of TItem;
-  private var
-    FItemsThreshold: SizeInt;
+    TPointersEnumerator = class(TOpenAddressingPointersEnumerator<TItem, PDictionaryPair>);
+    TPointersCollection = TOpenAddressingPointersCollection<TPointersEnumerator, TItem, PDictionaryPair>;
+  public type
+    PPointersCollection = ^TPointersCollection;
+  private var // FItems must be declared as first field 
     FItems: TItemsArray;
+    FItemsThreshold: SizeInt;
 
     procedure Resize(ANewSize: SizeInt);
-    function PrepareAddingItem: SizeInt;
+    procedure PrepareAddingItem;
   protected
     function RealItemsLength: SizeInt; virtual;
     function Rehash(ASizePow2: SizeInt; AForce: Boolean = False): boolean; virtual;
@@ -166,21 +208,32 @@ type
         function GetCurrent: TValue; override;
       end;
 
+      TPValueEnumerator = class(TOpenAddressingEnumerator<PValue, OPEN_ADDRESSING_CONSTRAINTS>)
+      protected
+        function GetCurrent: PValue; override;
+      end;
+
       TKeyEnumerator = class(TOpenAddressingEnumerator<TKey, OPEN_ADDRESSING_CONSTRAINTS>)
       protected
         function GetCurrent: TKey; override;
       end;
 
+      TPKeyEnumerator = class(TOpenAddressingEnumerator<PKey, OPEN_ADDRESSING_CONSTRAINTS>)
+      protected
+        function GetCurrent: PKey; override;
+      end;
+
       // Collections
-      TValueCollection = class(TDictionaryEnumerable<TValueEnumerator, TValue, CUSTOM_DICTIONARY_CONSTRAINTS>);
+      TValueCollection = class(TDictionaryEnumerable<TValueEnumerator, TPValueEnumerator, TValue, CUSTOM_DICTIONARY_CONSTRAINTS>);
 
-      TKeyCollection = class(TDictionaryEnumerable<TKeyEnumerator, TKey, CUSTOM_DICTIONARY_CONSTRAINTS>);
+      TKeyCollection = class(TDictionaryEnumerable<TKeyEnumerator, TPKeyEnumerator, TKey, CUSTOM_DICTIONARY_CONSTRAINTS>);
 
     // bug #24283 - workaround related to lack of DoGetEnumerator
     function GetEnumerator: TPairEnumerator; reintroduce;
   private
     function GetKeys: TKeyCollection;
     function GetValues: TValueCollection;
+    function GetPointers: PPointersCollection; inline;
   private
     function GetItem(const AKey: TKey): TValue; inline;
     procedure SetItem(const AKey: TKey; const AValue: TValue); inline;
@@ -217,6 +270,7 @@ type
     property Items[Index: TKey]: TValue read GetItem write SetItem; default;
     property Keys: TKeyCollection read GetKeys;
     property Values: TValueCollection read GetValues;
+    property Ptr: PPointersCollection read GetPointers;
 
     procedure GetMemoryLayout(const AOnGetMemoryLayoutKeyPosition: TOnGetMemoryLayoutKeyPosition);
   end;
@@ -296,12 +350,21 @@ type
     constructor Create(ACapacity: SizeInt; const AComparer: IEqualityComparer<TKey>); override; overload;
     constructor Create(const AComparer: IEqualityComparer<TKey>); reintroduce; overload;
     constructor Create(ACollection: TEnumerable<TDictionaryPair>; const AComparer: IEqualityComparer<TKey>); override; overload;
+    {$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>; const AComparer: IEqualityComparer<TKey>); override; overload;
+    {$ENDIF}
   public // bug #26181 (redundancy of constructors)
     constructor Create(ACapacity: SizeInt); override; overload;
     constructor Create(ACollection: TEnumerable<TDictionaryPair>); override; overload;
+    {$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>); override; overload;
+    {$ENDIF}
     constructor Create(ACapacity: SizeInt; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
     constructor Create(const AComparer: IExtendedEqualityComparer<TKey>); overload;
     constructor Create(ACollection: TEnumerable<TDictionaryPair>; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
+    {$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
+    {$ENDIF}
   end;
 
   TDeamortizedDArrayCuckooMapEnumerator<T, CUCKOO_CONSTRAINTS> = class abstract(TCustomDictionaryEnumerator<T, CUSTOM_DICTIONARY_CONSTRAINTS>)
@@ -319,6 +382,32 @@ type
     constructor Create(ADictionary: TCustomDictionary<CUSTOM_DICTIONARY_CONSTRAINTS>);
   end;
 
+  TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair> = class abstract(TEnumerator<PDictionaryPair>)
+  private var // FItems must be declared as first field and FQueue as second
+    FItems: ^TItemsDArray;
+    FQueue: TQueueDictionary;
+    FIndex: SizeInt;
+    FMainIndex: SizeInt;
+  protected
+    function DoMoveNext: boolean; override;
+    function DoGetCurrent: PDictionaryPair; override;
+    function GetCurrent: PDictionaryPair; virtual;
+  public
+    constructor Create(var AItems; AQueue: TQueueDictionary; ACount: SizeInt);
+  end;
+
+  TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair> = record
+  private type
+    PArray = ^TItemsDArray;
+    function Items: PArray; inline;
+    function GetCount: SizeInt; inline;
+    function GetQueue: TQueueDictionary; inline;
+  public
+    function GetEnumerator: TPointersEnumerator;
+    function ToArray: TArray<PDictionaryPair>;
+    property Count: SizeInt read GetCount;
+  end;
+
   // more info :
   // http://arxiv.org/abs/0903.0391
 
@@ -334,7 +423,7 @@ type
     end;
     TValueForQueue = TItem;
 
-    TQueueDictionary = class(TOpenAddressingLP<TKey, TValueForQueue, TDelphiHashFactory, TLinearProbing>)
+    TQueueDictionary = class(TOpenAddressingLP<TKey, TValueForQueue, TDefaultHashFactory, TLinearProbing>)
     private type // for workaround Lazarus bug #25613
       _TItem = record
         Hash: UInt32;
@@ -355,16 +444,20 @@ type
     end;
 
     // cycle-detection mechanism class
-    TCDM = class(TOpenAddressingSH<TKey, TEmptyRecord, TDelphiHashFactory, TLinearProbing>);
+    TCDM = class(TOpenAddressingSH<TKey, TEmptyRecord, TDefaultHashFactory, TLinearProbing>);
     TItemsArray = array of TItem;
     TItemsDArray = array[0..Pred(TCuckooCfg.D)] of TItemsArray;
+    TPointersEnumerator = class(TDeamortizedDArrayPointersEnumerator<TCuckooCfg, TItemsArray, TItemsDArray, TQueueDictionary, PDictionaryPair>);
+    TPointersCollection = TDeamortizedDArrayPointersCollection<TPointersEnumerator, TItemsDArray, TQueueDictionary, PDictionaryPair>;
+  public type
+    PPointersCollection = ^TPointersCollection;
   private var
+    FItems: TItemsDArray;
     FQueue: TQueueDictionary;  // probably can be optimized - hash TItem give information from TItem.Hash for cuckoo ...
       // currently is kept in "TQueueDictionary = class(TOpenAddressingSH<TKey, TItem, ...>"
 
     FCDM: TCDM; // cycle-detection mechanism
     FItemsThreshold: SizeInt;
-    FItems: TItemsDArray;
   // sadly there is bug #24848 for class var ...
   {class} var
     CUCKOO_SIGN, CUCKOO_INDEX_SIZE, CUCKOO_HASH_SIGN: UInt32;
@@ -373,7 +466,7 @@ type
 
     procedure Resize(ANewSize: SizeInt);
     procedure Rehash(ASizePow2: SizeInt);
-    function PrepareAddingItem: SizeInt;
+    procedure PrepareAddingItem;
   protected
     procedure UpdateItemsThreshold(ASize: SizeInt); override;
     function Lookup(constref AKey: TKey; var AHashListOrIndex: PUInt32): SizeInt; inline; overload;
@@ -391,28 +484,39 @@ type
         function GetCurrent: TValue; override;
       end;
 
+      TPValueEnumerator = class(TDeamortizedDArrayCuckooMapEnumerator<PValue, CUCKOO_CONSTRAINTS>)
+      protected
+        function GetCurrent: PValue; override;
+      end;
+
       TKeyEnumerator = class(TDeamortizedDArrayCuckooMapEnumerator<TKey, CUCKOO_CONSTRAINTS>)
       protected
         function GetCurrent: TKey; override;
       end;
 
+      TPKeyEnumerator = class(TDeamortizedDArrayCuckooMapEnumerator<PKey, CUCKOO_CONSTRAINTS>)
+      protected
+        function GetCurrent: PKey; override;
+      end;
+
       // Collections
-      TValueCollection = class(TDictionaryEnumerable<TValueEnumerator, TValue, CUSTOM_DICTIONARY_CONSTRAINTS>);
+      TValueCollection = class(TDictionaryEnumerable<TValueEnumerator, TPValueEnumerator, TValue, CUSTOM_DICTIONARY_CONSTRAINTS>);
 
-      TKeyCollection = class(TDictionaryEnumerable<TKeyEnumerator, TKey, CUSTOM_DICTIONARY_CONSTRAINTS>);
+      TKeyCollection = class(TDictionaryEnumerable<TKeyEnumerator, TPKeyEnumerator, TKey, CUSTOM_DICTIONARY_CONSTRAINTS>);
 
     // bug #24283 - workaround related to lack of DoGetEnumerator
     function GetEnumerator: TPairEnumerator; reintroduce;
   private
     function GetKeys: TKeyCollection;
     function GetValues: TValueCollection;
+    function GetPointers: PPointersCollection; inline;
   private
     function GetItem(const AKey: TKey): TValue; inline;
     procedure SetItem(const AKey: TKey; const AValue: TValue); overload; inline;
     procedure SetItem(constref AValue: TValue; const AHashListOrIndex: PUInt32; ALookupResult: SizeInt); overload;
 
     procedure AddItem(constref AItems: TItemsDArray; constref AKey: TKey; constref AValue: TValue; const AHashList: PUInt32); overload;
-    procedure DoAdd(constref AKey: TKey; constref AValue: TValue; const AHashList: PUInt32); overload; inline;
+    procedure DoAdd(const AKey: TKey; const AValue: TValue; const AHashList: PUInt32); overload; inline;
     function DoRemove(const AHashListOrIndex: PUInt32; ALookupResult: SizeInt;
       ACollectionNotification: TCollectionNotification): TValue;
 
@@ -428,15 +532,24 @@ type
     constructor Create(ACapacity: SizeInt; const AComparer: IEqualityComparer<TKey>); override; overload;
     constructor Create(const AComparer: IEqualityComparer<TKey>); reintroduce; overload;
     constructor Create(ACollection: TEnumerable<TDictionaryPair>; const AComparer: IEqualityComparer<TKey>); override; overload;
+    {$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>; const AComparer: IEqualityComparer<TKey>); override; overload;
+    {$ENDIF}
   public
     // TODO: function TryFlushQueue(ACount: SizeInt): SizeInt;
 
     constructor Create; override; overload;
     constructor Create(ACapacity: SizeInt); override; overload;
     constructor Create(ACollection: TEnumerable<TDictionaryPair>); override; overload;
+    {$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>); override; overload;
+    {$ENDIF}
     constructor Create(ACapacity: SizeInt; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
     constructor Create(const AComparer: IExtendedEqualityComparer<TKey>); overload;
     constructor Create(ACollection: TEnumerable<TDictionaryPair>; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
+    {$IFDEF ENABLE_METHODS_WITH_TEnumerableWithPointers}
+    constructor Create(ACollection: TEnumerableWithPointers<TDictionaryPair>; const AComparer: IExtendedEqualityComparer<TKey>); virtual; overload;
+    {$ENDIF}
     destructor Destroy; override;
 
     procedure Add(constref APair: TPair<TKey, TValue>); override; overload;
@@ -454,6 +567,7 @@ type
     property Items[Index: TKey]: TValue read GetItem write SetItem; default;
     property Keys: TKeyCollection read GetKeys;
     property Values: TValueCollection read GetValues;
+    property Ptr: PPointersCollection read GetPointers;
 
     property QueueCount: SizeInt read GetQueueCount;
     procedure GetMemoryLayout(const AOnGetMemoryLayoutKeyPosition: TOnGetMemoryLayoutKeyPosition);
@@ -497,17 +611,17 @@ type
 
   // useful generics overloads
   TOpenAddressingLP<TKey, TValue, THashFactory> = class(TOpenAddressingLP<TKey, TValue, THashFactory, TLinearProbing>);
-  TOpenAddressingLP<TKey, TValue>  = class(TOpenAddressingLP<TKey, TValue, TDelphiHashFactory, TLinearProbing>);
+  TOpenAddressingLP<TKey, TValue>  = class(TOpenAddressingLP<TKey, TValue, TDefaultHashFactory, TLinearProbing>);
 
   TObjectOpenAddressingLP<TKey, TValue, THashFactory> = class(TObjectOpenAddressingLP<TKey, TValue, THashFactory, TLinearProbing>);
-  TObjectOpenAddressingLP<TKey, TValue> = class(TObjectOpenAddressingLP<TKey, TValue, TDelphiHashFactory, TLinearProbing>);
+  TObjectOpenAddressingLP<TKey, TValue> = class(TObjectOpenAddressingLP<TKey, TValue, TDefaultHashFactory, TLinearProbing>);
 
   // Linear Probing with Tombstones (LPT)
   TOpenAddressingLPT<TKey, TValue, THashFactory> = class(TOpenAddressingSH<TKey, TValue, THashFactory, TLinearProbing>);
-  TOpenAddressingLPT<TKey, TValue> = class(TOpenAddressingSH<TKey, TValue, TDelphiHashFactory, TLinearProbing>);
+  TOpenAddressingLPT<TKey, TValue> = class(TOpenAddressingSH<TKey, TValue, TDefaultHashFactory, TLinearProbing>);
 
   TOpenAddressingQP<TKey, TValue, THashFactory> = class(TOpenAddressingQP<TKey, TValue, THashFactory, TQuadraticProbing>);
-  TOpenAddressingQP<TKey, TValue> = class(TOpenAddressingQP<TKey, TValue, TDelphiHashFactory, TQuadraticProbing>);
+  TOpenAddressingQP<TKey, TValue> = class(TOpenAddressingQP<TKey, TValue, TDefaultHashFactory, TQuadraticProbing>);
 
   TOpenAddressingDH<TKey, TValue, THashFactory> = class(TOpenAddressingDH<TKey, TValue, THashFactory, TDoubleHashing>);
   TOpenAddressingDH<TKey, TValue> = class(TOpenAddressingDH<TKey, TValue, TDelphiDoubleHashFactory, TDoubleHashing>);
@@ -539,6 +653,3 @@ type
 
   THashMap<TKey, TValue> = class(TCuckooD4<TKey, TValue>);
   TObjectHashMap<TKey, TValue> = class(TObjectCuckooD4<TKey, TValue>);
-
-var
-  EmptyRecord: TEmptyRecord;

packages/rtl-generics/tests/testrunner.rtlgenerics.lpi

@@ -0,0 +1,92 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="testrunner.rtlgenerics"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="-a --format=plain"/>
+      </local>
+    </RunParams>
+    <Units Count="7">
+      <Unit0>
+        <Filename Value="testrunner.rtlgenerics.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="tests.generics.arrayhelper.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="tests.generics.trees.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="tests.generics.sets.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="tests.generics.stdcollections.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="tests.generics.bugs.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="tests.generics.utils.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit6>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="testrunner.rtlgenerics.rtlgenerics"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="..\src\inc;$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\src"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Other>
+      <CustomOptions Value="-dWAIT_FOR_ENTER"/>
+      <OtherDefines Count="1">
+        <Define0 Value="WAIT_FOR_ENTER"/>
+      </OtherDefines>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/rtl-generics/tests/testrunner.rtlgenerics.pp

@@ -0,0 +1,30 @@
+{ %CONFIGFILE=fpcunit-console-defaults.ini testdefaults.ini }
+
+program testrunner.rtlgenerics;
+
+{$mode objfpc}{$H+}
+
+uses
+  consoletestrunner,
+  tests.generics.bugs,
+  tests.generics.hashmaps,
+  tests.generics.arrayhelper,
+  tests.generics.trees,
+  tests.generics.stdcollections,
+  tests.generics.sets
+  ;
+
+var
+  Application: TTestRunner;
+
+begin
+  Application := TTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Title := 'RTL-Generics unit tests';
+  Application.Run;
+  Application.Free;
+{$IFDEF WAIT_FOR_ENTER}
+  WriteLn('Press enter...');
+  ReadLn;
+{$ENDIF}
+end.

packages/rtl-generics/tests/tests.generics.arrayhelper.pas

@@ -0,0 +1,97 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2018 by Maciej Izak (hnb),
+    member of the Free Pascal development team
+
+    It contains tests for the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types, tests and major refactoring of entire library
+
+ **********************************************************************}
+
+unit tests.generics.arrayhelper;
+
+{$mode delphi}
+
+interface
+
+uses
+  fpcunit, testregistry, testutils,
+  Classes, SysUtils, Generics.Collections;
+
+type
+
+  { TTestArrayHelper }
+
+  TTestArrayHelper = class(TTestCase)
+  protected
+    procedure CheckBinarySearch(constref AArray: TArray<Integer>;
+      AValue: Integer; AExpectedResult: boolean; out ASearchResult: TBinarySearchResult);
+    procedure CheckSearchResult(constref ASearchResult: TBinarySearchResult;
+      AValue: Integer; ACandidateIndex, AFoundIndex: SizeInt; ACompareResult: Boolean);
+  published
+    procedure Test_BinarySearch_Integers;
+    procedure Test_BinarySearch_EmptyArray;
+  end;
+
+implementation
+
+{ TTestArrayHelper }
+
+procedure TTestArrayHelper.CheckBinarySearch(constref AArray: TArray<Integer>;
+  AValue: Integer; AExpectedResult: boolean; out
+  ASearchResult: TBinarySearchResult);
+begin
+  CheckEquals(AExpectedResult,
+    TArrayHelper<Integer>.BinarySearch(AArray,AValue,ASearchResult),
+    'Wrong BinarySearch result for ' + AValue.ToString);
+end;
+
+procedure TTestArrayHelper.CheckSearchResult(constref
+  ASearchResult: TBinarySearchResult; AValue: Integer; ACandidateIndex,
+  AFoundIndex: SizeInt; ACompareResult: Boolean);
+begin
+  with ASearchResult do
+  begin
+    CheckEquals(ACandidateIndex, CandidateIndex, 'Wrong binary search result (CandidateIndex) for ' + AValue.ToString);
+    CheckEquals(AFoundIndex, FoundIndex, 'Wrong binary search result (FoundIndex) for ' + AValue.ToString);
+    Check(ACompareResult, 'Wrong binary search result (CompareResult) for ' + AValue.ToString);
+  end;
+end;
+
+procedure TTestArrayHelper.Test_BinarySearch_Integers;
+var
+  a: TArray<Integer>;
+  LSearchResult: TBinarySearchResult;
+begin
+  a := TArray<Integer>.Create(1,3,5,7,9,11,13,15,20);
+
+  CheckBinarySearch(a, 10, False, LSearchResult);
+  CheckSearchResult(LSearchResult, 10, 5, -1, LSearchResult.CompareResult>0);
+
+  CheckBinarySearch(a, 20, True, LSearchResult);
+  CheckSearchResult(LSearchResult, 20, 8, 8, LSearchResult.CompareResult=0);
+end;
+
+procedure TTestArrayHelper.Test_BinarySearch_EmptyArray;
+var
+  LSearchResult: TBinarySearchResult;
+begin
+  CheckBinarySearch(nil, 1, False, LSearchResult);
+  CheckSearchResult(LSearchResult, 1, -1, -1, LSearchResult.CompareResult=0);
+end;
+
+begin
+  RegisterTest(TTestArrayHelper);
+end.
+

packages/rtl-generics/tests/tests.generics.bugs.pas

@@ -0,0 +1,61 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2018 by Maciej Izak (hnb),
+    member of the Free Pascal development team
+
+    It contains tests for the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types, tests and major refactoring of entire library
+
+ **********************************************************************}
+unit tests.generics.bugs;
+
+{$mode delphi}
+
+interface
+
+uses
+  fpcunit, testregistry, testutils,
+  Classes, SysUtils, Generics.Collections, Generics.Defaults;
+
+type
+
+  { TTestBugs }
+
+  TTestBugs = class(TTestCase)
+  published
+    procedure Test_QuadraticProbing_InfinityLoop;
+  end;
+
+implementation
+
+{ TTestBugs }
+
+procedure TTestBugs.Test_QuadraticProbing_InfinityLoop;
+// https://github.com/maciej-izak/generics.collections/issues/4
+var
+  LMap: TOpenAddressingQP<string, pointer, TDelphiHashFactory>;
+begin
+  LMap := TOpenAddressingQP<string, pointer, TDelphiHashFactory>.Create();
+  LMap.Add(#178#178#107#141#143#151#168#39#172#38#83#194#130#90#101, nil);
+  LMap.Add(#193#190#172#41#144#231#52#62#45#117#108#45#217#71#77, nil);
+  LMap.Add(#49#116#202#160#38#131#41#37#217#171#227#215#122#151#71, nil);
+  LMap.Add(#148#159#199#71#198#97#69#201#116#45#195#184#178#129#200, nil);
+  CheckEquals(false, LMap.ContainsKey(#$E6'h=fzb'#$E5#$B4#$A0#$C4#$E6'B6r>'));
+  LMap.Free;
+end;
+
+begin
+  RegisterTest(TTestBugs);
+end.
+

packages/rtl-generics/tests/tests.generics.hashmaps.pas

@@ -0,0 +1,358 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2018 by Maciej Izak (hnb),
+    member of the Free Pascal development team
+
+    It contains tests for the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types, tests and major refactoring of entire library
+
+ **********************************************************************}
+
+unit tests.generics.hashmaps;
+
+{$mode delphi}
+{$MACRO ON}
+
+interface
+
+uses
+  fpcunit, testregistry, testutils, tests.generics.utils,
+  typinfo, Classes, SysUtils, StrUtils, Generics.Collections, Generics.Defaults;
+
+type
+  PCollectionNotification = ^TCollectionNotification;
+
+  { TTestHashMaps }
+
+  TTestHashMaps= class(TTestCollections)
+  private
+    procedure CountAsKey_Check(const AWhat: string; AValue, AExpectedValue: Integer;
+      AAction: PCollectionNotification);
+    procedure CountAsKey_Notify(const AKind: string; ASender: TObject; constref AItem: Integer; AAction: TCollectionNotification);
+    procedure CountAsKey_NotifyValue(ASender: TObject; constref AItem: Integer; AAction: TCollectionNotification);
+    procedure CountAsKey_NotifyKey(ASender: TObject; constref AItem: Integer; AAction: TCollectionNotification);
+  published
+    procedure Test_CountAsKey_OpenAddressingLP;
+    procedure Test_CountAsKey_OpenAddressingLPT;
+    procedure Test_CountAsKey_OpenAddressingQP;
+    procedure Test_CountAsKey_OpenAddressingDH;
+    procedure Test_CountAsKey_CuckooD2;
+    procedure Test_CountAsKey_CuckooD4;
+    procedure Test_CountAsKey_CuckooD6;
+
+    procedure Test_OpenAddressingLP_Notification;
+    procedure Test_OpenAddressingLPT_Notification;
+    procedure Test_OpenAddressingQP_Notification;
+    procedure Test_OpenAddressingDH_Notification;
+    procedure Test_CuckooD2_Notification;
+    procedure Test_CuckooD4_Notification;
+    procedure Test_CuckooD6_Notification;
+
+    procedure Test_OpenAddressingLP_TrimExcess;
+    procedure Test_CuckooD2_TrimExcess;
+
+    procedure Test_TryAddOrSetOrGetValue;
+  end;
+
+implementation
+
+{ TTestHashMaps }
+
+procedure TTestHashMaps.CountAsKey_Check(const AWhat: string; AValue, AExpectedValue: Integer;
+    AAction: PCollectionNotification);
+var
+  LCollectionNotificationStr: string;
+begin
+  if Assigned(AAction) then
+    LCollectionNotificationStr := GetEnumName(TypeInfo(TCollectionNotification), Ord(AAction^));
+
+  AssertEquals(AWhat + LCollectionNotificationStr, AExpectedValue, AValue);
+end;
+
+procedure TTestHashMaps.CountAsKey_Notify(const AKind: string; ASender: TObject; constref
+  AItem: Integer; AAction: TCollectionNotification);
+var
+  LCount: Integer;
+begin
+  CountAsKey_Check('Item ('+AKind+')', AItem, 0, @AAction);
+  LCount := TCustomDictionary<Integer, Integer, TDefaultHashFactory>(ASender).Count;
+  case AAction of
+    cnAdded:
+      CountAsKey_Check('Count', LCount, 1, @AAction);
+    cnRemoved:
+      CountAsKey_Check('Count', LCount, 0, @AAction);
+    cnExtracted: Halt(4);
+  end;
+end;
+
+procedure TTestHashMaps.CountAsKey_NotifyValue(ASender: TObject; constref AItem: Integer;
+  AAction: TCollectionNotification);
+begin
+  CountAsKey_Notify('Value', ASender, AItem, AAction);
+end;
+
+procedure TTestHashMaps.CountAsKey_NotifyKey(ASender: TObject; constref AItem: Integer;
+  AAction: TCollectionNotification);
+begin
+  CountAsKey_Notify('Key', ASender, AItem, AAction);
+end;
+
+{$DEFINE TEST_COUNT_AS_KEY :=
+  LDictionary.OnKeyNotify := CountAsKey_NotifyKey;
+  LDictionary.OnValueNotify := CountAsKey_NotifyValue;
+  CountAsKey_Check('Count', LDictionary.Count, 0, nil);
+  LDictionary.Add(LDictionary.Count,LDictionary.Count);
+  CountAsKey_Check('Item', LDictionary[0], 0, nil);
+  LDictionary.Free
+}
+
+procedure TTestHashMaps.Test_CountAsKey_OpenAddressingLP;
+var
+  LDictionary: TOpenAddressingLP<Integer, Integer>;
+begin
+  // TOpenAddressingLP
+  LDictionary := TOpenAddressingLP<Integer, Integer>.Create;
+  TEST_COUNT_AS_KEY;
+end;
+
+procedure TTestHashMaps.Test_CountAsKey_OpenAddressingLPT;
+var
+  LDictionary: TOpenAddressingLPT<Integer, Integer>;
+begin
+  // TOpenAddressingLPT
+  LDictionary := TOpenAddressingLPT<Integer, Integer>.Create;
+  TEST_COUNT_AS_KEY;
+end;
+
+procedure TTestHashMaps.Test_CountAsKey_OpenAddressingQP;
+var
+  LDictionary: TOpenAddressingQP<Integer, Integer>;
+begin
+  // TOpenAddressingQP
+  LDictionary := TOpenAddressingQP<Integer, Integer>.Create;
+  TEST_COUNT_AS_KEY;
+end;
+
+procedure TTestHashMaps.Test_CountAsKey_OpenAddressingDH;
+var
+  LDictionary: TOpenAddressingDH<Integer, Integer>;
+begin
+  // TOpenAddressingDH
+  LDictionary := TOpenAddressingDH<Integer, Integer>.Create;
+  TEST_COUNT_AS_KEY;
+end;
+
+procedure TTestHashMaps.Test_CountAsKey_CuckooD2;
+var
+  LDictionary: TCuckooD2<Integer, Integer>;
+begin
+  // TCuckooD2
+  LDictionary := TCuckooD2<Integer, Integer>.Create;
+  TEST_COUNT_AS_KEY;
+end;
+
+procedure TTestHashMaps.Test_CountAsKey_CuckooD4;
+var
+  LDictionary: TCuckooD4<Integer, Integer>;
+begin
+  // TCuckooD4
+  LDictionary := TCuckooD4<Integer, Integer>.Create;
+  TEST_COUNT_AS_KEY;
+end;
+
+procedure TTestHashMaps.Test_CountAsKey_CuckooD6;
+var
+  LDictionary: TCuckooD6<Integer, Integer>;
+begin
+  // TCuckooD6
+  LDictionary := TCuckooD6<Integer, Integer>.Create;
+  TEST_COUNT_AS_KEY;
+end;
+
+{$DEFINE TEST_NOTIFICATIONS :=
+try
+  LDictionary.OnKeyNotify := NotifyTestStr;
+  LDictionary.OnValueNotify := NotifyTestStr;
+
+  // Add
+  NotificationAdd(LDictionary, ['Aaa', 'Bbb', 'Ccc', 'Ddd', 'Eee', 'Fff'], cnAdded);
+  LDictionary.Add('Aaa', 'Bbb');
+  LDictionary.Add('Ccc', 'Ddd');
+  LDictionary.Add('Eee', 'Fff');
+  AssertNotificationsExecutedStr;
+
+  // Remove and ExtractPair
+  NotificationAdd(LDictionary, ['Ccc', 'Ddd'], cnRemoved);
+  LDictionary.Remove('Ccc');
+  AssertNotificationsExecutedStr;
+
+  NotificationAdd(LDictionary, ['Aaa', 'Bbb'], cnExtracted);
+  with LDictionary.ExtractPair('Aaa') do
+  begin
+    AssertEquals(Key, 'Aaa');
+    AssertEquals(Value, 'Bbb');
+  end;
+  AssertNotificationsExecutedStr;
+
+  // Clear
+  NotificationAdd(LDictionary, ['Eee', 'Fff'], cnRemoved);
+  LDictionary.Clear;
+  AssertNotificationsExecutedStr;
+
+  // SetItem
+  NotificationAdd(LDictionary, ['FPC', 'Polandball'], cnAdded);
+  LDictionary.AddOrSetValue('FPC', 'Polandball');
+  AssertNotificationsExecutedStr;
+  NotificationAdd(LDictionary, 'Polandball', cnRemoved);
+  NotificationAdd(LDictionary, 'xD', cnAdded);
+  NotificationAdd(LDictionary, 'xD', cnRemoved);
+  NotificationAdd(LDictionary, 'Polandball', cnAdded);
+  LDictionary['FPC'] := 'xD';
+  LDictionary.AddOrSetValue('FPC', 'Polandball');
+  AssertNotificationsExecutedStr;
+finally
+  NotificationAdd(LDictionary, ['FPC', 'Polandball'], cnRemoved);
+  LDictionary.Free;
+  AssertNotificationsExecutedStr;
+end
+}
+
+procedure TTestHashMaps.Test_OpenAddressingLP_Notification;
+var
+  LDictionary: TOpenAddressingLP<string, string>;
+begin
+  LDictionary := TOpenAddressingLP<string, string>.Create;
+  TEST_NOTIFICATIONS;
+end;
+
+procedure TTestHashMaps.Test_OpenAddressingLPT_Notification;
+var
+  LDictionary: TOpenAddressingLPT<string, string>;
+begin
+  LDictionary := TOpenAddressingLPT<string, string>.Create;
+  TEST_NOTIFICATIONS;
+end;
+
+procedure TTestHashMaps.Test_OpenAddressingQP_Notification;
+var
+  LDictionary: TOpenAddressingQP<string, string>;
+begin
+  LDictionary := TOpenAddressingQP<string, string>.Create;
+  TEST_NOTIFICATIONS;
+end;
+
+procedure TTestHashMaps.Test_OpenAddressingDH_Notification;
+var
+  LDictionary: TOpenAddressingDH<string, string>;
+begin
+  LDictionary := TOpenAddressingDH<string, string>.Create;
+  TEST_NOTIFICATIONS;
+end;
+
+procedure TTestHashMaps.Test_CuckooD2_Notification;
+var
+  LDictionary: TCuckooD2<string, string>;
+begin
+  LDictionary := TCuckooD2<string, string>.Create;
+  TEST_NOTIFICATIONS;
+end;
+
+procedure TTestHashMaps.Test_CuckooD4_Notification;
+var
+  LDictionary: TCuckooD4<string, string>;
+begin
+  LDictionary := TCuckooD4<string, string>.Create;
+  TEST_NOTIFICATIONS;
+end;
+
+procedure TTestHashMaps.Test_CuckooD6_Notification;
+var
+  LDictionary: TCuckooD6<string, string>;
+begin
+  LDictionary := TCuckooD6<string, string>.Create;
+  TEST_NOTIFICATIONS;
+end;
+
+{$DEFINE TEST_TRIMEXCESS :=
+  try
+    for i := 1 to 8 do
+      LDictionary.Add(i, EmptyRecord);
+    LDictionary.Remove(1);
+
+    CheckNotEquals(LDictionary.Capacity, LDictionary.Count);
+    LDictionary.TrimExcess;
+    AssertEquals(LDictionary.Capacity, 8);
+  finally
+    LDictionary.Free;
+  end;
+}
+
+procedure TTestHashMaps.Test_OpenAddressingLP_TrimExcess;
+var
+  LDictionary: TOpenAddressingLP<Integer, TEmptyRecord>;
+  i: Integer;
+begin
+  LDictionary := TOpenAddressingLP<Integer, TEmptyRecord>.Create;
+  TEST_TRIMEXCESS;
+end;
+
+procedure TTestHashMaps.Test_CuckooD2_TrimExcess;
+var
+  LDictionary: TCuckooD2<Integer, TEmptyRecord>;
+  i: Integer;
+begin
+  LDictionary := TCuckooD2<Integer, TEmptyRecord>.Create;
+  TEST_TRIMEXCESS;
+end;
+
+procedure TTestHashMaps.Test_TryAddOrSetOrGetValue;
+// modified test from Castle Game Engine (https://castle-engine.sourceforge.io)
+var
+  LObjects: TDictionary<string, TObject>;
+  LObject, LFoundObject: TObject;
+begin
+  LObjects := TDictionary<string, TObject>.Create;
+  try
+    LObjects.TryGetValue('blah', LFoundObject);
+    AssertTrue(nil = LFoundObject);
+
+    LObject := TObject.Create;
+    LObjects.AddOrSetValue('nope', LObject);
+
+    LObjects.TryGetValue('blah', LFoundObject);
+    AssertTrue(nil = LFoundObject);
+
+    LObject := TObject.Create;
+    LObjects.AddOrSetValue('blah', LObject);
+
+    LObjects.TryGetValue('blah', LFoundObject);
+    AssertTrue(LObject = LFoundObject);
+
+    LObjects.Remove('blah');
+
+    LObject.Free;
+
+    LObjects.TryGetValue('blah', LFoundObject);
+    AssertTrue(nil = LFoundObject);
+
+    LObjects['nope'].Free;
+  finally
+    FreeAndNil(LObjects)
+  end;
+end;
+
+begin
+  RegisterTest(TTestHashMaps);
+end.
+

packages/rtl-generics/tests/tests.generics.sets.pas

@@ -0,0 +1,355 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2018 by Maciej Izak (hnb),
+    member of the Free Pascal development team
+
+    It contains tests for the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types, tests and major refactoring of entire library
+
+ **********************************************************************}
+unit tests.generics.sets;
+
+{$mode delphi}
+
+interface
+
+uses
+  fpcunit, testregistry, testutils, tests.generics.utils,
+  Classes, SysUtils, Generics.Collections;
+
+type
+  THashSet_Integer = THashSet<Integer>;
+  TSortedSet_Integer = TSortedSet<Integer>;
+  TSortedHashSet_Integer = TSortedHashSet<Integer>;
+
+  { TTestSets }
+
+  TTestSets = class(TTestCollections)
+  protected
+    procedure Test_TCustomSet_Notification(ASet: TCustomSet<string>);
+  public
+    constructor Create; override;
+  published
+    procedure Test_HashSet_General;
+    procedure Test_SortedSet_General;
+    procedure Test_SortedHashSet_General;
+    procedure Test_HashSet;
+    procedure Test_SortedSet;
+    procedure Test_SortedHashSet;
+    procedure Test_THashSet_Notification;
+    procedure Test_TSortedSet_Notification;
+    procedure Test_TSortedHashSet_Notification;
+  end;
+
+  { TGenericTestSets }
+
+  TGenericTestSets<T> = record
+    class procedure ValidateSet(ASet: T; const ANumbers: array of Integer); static;
+    class procedure Test_Set_General; static;
+    class procedure Test_Set_Sorted; static;
+    class procedure Test_Set_NonSorted; static;
+  end;
+
+var
+  GTest: TTestSets;
+
+procedure CheckSet_10(ASet: TCustomSet<Integer>; ASortedList: TSortedList<Integer>);
+
+implementation
+
+{ TGenericTestSets }
+
+class procedure TGenericTestSets<T>.ValidateSet(ASet: T;
+  const ANumbers: array of Integer);
+var
+  i: Integer;
+begin with GTest do begin
+  for i in ANumbers do
+    AssertTrue('Can''t find number ' + i.ToString, ASet.Contains(i));
+  AssertEquals(ASet.Count, Length(ANumbers));
+end end;
+
+class procedure TGenericTestSets<T>.Test_Set_General;
+var
+  NumbersA: T;
+  NumbersB: T;
+  NumbersC: T;
+  i: Integer;
+begin with GTest do begin
+  NumbersA := T.Create;
+  NumbersB := T.Create;
+
+  for i := 0 to 4 do
+  begin
+    AssertTrue(NumbersA.Add(i * 2));
+    AssertTrue(NumbersB.Add((i * 2) + 1));
+  end;
+
+  ValidateSet(NumbersA, [0, 2, 4, 6, 8]);
+  ValidateSet(NumbersB, [1, 3, 5, 7, 9]);
+
+  { UnionWith }
+  NumbersC := T.Create(NumbersA);
+  NumbersC.UnionWith(NumbersB);
+  ValidateSet(NumbersC, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
+  AssertFalse(NumbersC.Add(5));
+  AssertFalse(NumbersC.AddRange([6, 7]));
+  AssertEquals(NumbersC.Count, 10);
+
+  { ExceptWith }
+  NumbersC.ExceptWith(NumbersB);
+  AssertEquals(NumbersC.Count, 5);
+  ValidateSet(NumbersC, [0, 2, 4, 6, 8]);
+  AssertTrue(NumbersC.AddRange(NumbersB));
+  ValidateSet(NumbersC, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
+
+  { SymmetricExceptWith }
+  NumbersA.Clear;
+  AssertEquals(NumbersA.Count, 0);
+  NumbersB.Clear;
+  AssertEquals(NumbersB.Count, 0);
+  NumbersC.Clear;
+  AssertEquals(NumbersC.Count, 0);
+  AssertTrue(NumbersA.AddRange([0, 1, 2, 3, 4, 5]));
+  ValidateSet(NumbersA, [0, 1, 2, 3, 4, 5]);
+  AssertTrue(NumbersB.AddRange([3, 4, 5, 6, 7, 8, 9]));
+  ValidateSet(NumbersB, [3, 4, 5, 6, 7, 8, 9]);
+  NumbersC.Free;
+  NumbersC := T.Create(NumbersA);
+  ValidateSet(NumbersC, [0, 1, 2, 3, 4, 5]);
+  NumbersC.SymmetricExceptWith(NumbersB);
+  ValidateSet(NumbersC, [0, 1, 2, 8, 7, 6, 9]);
+
+  { IntersectWith }
+  NumbersA.Clear;
+  AssertEquals(NumbersA.Count, 0);
+  NumbersB.Clear;
+  AssertEquals(NumbersB.Count, 0);
+  NumbersC.Clear;
+  AssertEquals(NumbersC.Count, 0);
+  AssertTrue(NumbersA.AddRange([0, 1, 2, 3, 4, 5]));
+  AssertTrue(NumbersB.AddRange([3, 4, 5, 6, 7, 8, 9]));
+  AssertTrue(NumbersC.AddRange(NumbersA));
+  NumbersC.IntersectWith(NumbersB);
+  ValidateSet(NumbersC, [3, 4, 5]);
+
+  NumbersC.Free;
+  NumbersB.Free;
+  NumbersA.Free;
+end end;
+
+class procedure TGenericTestSets<T>.Test_Set_Sorted;
+const
+  SORTED_NUMBERS: array[0..9] of Integer = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9);
+var
+  Numbers: T;
+  i, j: Integer;
+  pi: PInteger;
+begin with GTest do begin
+  Numbers := T.Create;
+  AssertTrue(Numbers.AddRange([8, 4, 6, 2, 0, 9, 5, 7, 3, 1]));
+  ValidateSet(Numbers, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
+
+  j := 0;
+  for i in TCustomSet<Integer>(Numbers) do
+  begin
+    AssertEquals(i, SORTED_NUMBERS[j]);
+    Inc(j);
+  end;
+
+  j := 0;
+  for pi in TCustomSet<Integer>(Numbers).Ptr^ do
+  begin
+    AssertEquals(pi^, SORTED_NUMBERS[j]);
+    Inc(j);
+  end;
+
+  Numbers.Free;
+end end;
+
+procedure CheckSet_10(ASet: TCustomSet<Integer>; ASortedList: TSortedList<Integer>);
+var
+  i: Integer;
+begin with GTest do begin
+  AssertEquals(ASortedList.Count, 10);
+  for i := 0 to 9 do
+  begin
+    AssertEquals(i, ASortedList[i]);
+    AssertTrue(ASet.Contains(i));
+  end;
+end end;
+
+class procedure TGenericTestSets<T>.Test_Set_NonSorted;
+var
+  Numbers: T;
+  LSortedList: TSortedList<Integer>;
+  i: Integer;
+  pi: PInteger;
+begin with GTest do begin
+  Numbers := T.Create;
+  LSortedList := TSortedList<Integer>.Create;
+  AssertTrue(Numbers.AddRange([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]));
+  ValidateSet(Numbers, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]);
+
+  for i in TCustomSet<Integer>(Numbers) do
+    LSortedList.Add(i);
+  CheckSet_10(Numbers, LSortedList);
+
+  LSortedList.Clear;
+
+  for pi in TCustomSet<Integer>(Numbers).Ptr^ do
+    LSortedList.Add(pi^);
+  CheckSet_10(Numbers, LSortedList);
+
+
+  LSortedList.Free;
+  Numbers.Free;
+end end;
+
+{ TTestSets }
+
+constructor TTestSets.Create;
+begin
+  inherited Create;
+  GTest := Self;
+end;
+
+procedure TTestSets.Test_HashSet_General;
+begin
+  TGenericTestSets<THashSet_Integer>.Test_Set_General;
+end;
+
+procedure TTestSets.Test_SortedSet_General;
+begin
+  TGenericTestSets<TSortedSet_Integer>.Test_Set_General;
+end;
+
+procedure TTestSets.Test_SortedHashSet_General;
+begin
+  TGenericTestSets<TSortedHashSet_Integer>.Test_Set_General;
+end;
+
+procedure TTestSets.Test_HashSet;
+begin
+  TGenericTestSets<THashSet_Integer>.Test_Set_NonSorted;
+end;
+
+procedure TTestSets.Test_SortedSet;
+begin
+  TGenericTestSets<TSortedSet_Integer>.Test_Set_Sorted;
+end;
+
+procedure TTestSets.Test_SortedHashSet;
+begin
+  TGenericTestSets<TSortedHashSet_Integer>.Test_Set_Sorted;
+end;
+
+procedure TTestSets.Test_TCustomSet_Notification(ASet: TCustomSet<string>);
+var
+  LSet: THashSet<string>;
+  LStringsObj: TEnumerable<string>;
+  LStringsIntf: IEnumerable<string>;
+begin
+  LSet :=  THashSet<string>.Create;
+  try
+    LStringsObj := EnumerableStringsObj(['Ddd', 'Eee']);
+    LStringsIntf := EnumerableStringsIntf(['Fff', 'Ggg']);
+    ASet.OnNotify := NotifyTestStr;
+
+    { Add + AddRange }
+    NotificationAdd(ASet, ['Aaa', 'Bbb', 'Ccc', 'Ddd', 'Eee', 'Fff', 'Ggg'], cnAdded);
+    AssertTrue(ASet.Add('Aaa'));
+    AssertTrue(ASet.AddRange(['Bbb', 'Ccc']));
+    AssertTrue(ASet.AddRange(LStringsObj));
+    AssertTrue(ASet.AddRange(LStringsIntf));
+    AssertNotificationsExecutedStr;
+
+    { Remove and Extract }
+    NotificationAdd(ASet, 'Ccc', cnRemoved);
+    NotificationAdd(ASet, 'Aaa', cnExtracted);
+    AssertTrue(ASet.Remove('Ccc'));
+    AssertEquals(ASet.Extract('Aaa'), 'Aaa');
+    AssertNotificationsExecutedStr;
+
+    { ExceptWith }
+    LSet.Add('Bbb');
+    NotificationAdd(ASet, 'Bbb', cnRemoved);
+    ASet.ExceptWith(LSet);
+    AssertNotificationsExecutedStr;
+
+    { IntersectWith }
+    LSet.AddRange(['Eee', 'Fff', 'Ggg']);
+    NotificationAdd(ASet, 'Ddd', cnRemoved);
+    ASet.IntersectWith(LSet);
+    AssertNotificationsExecutedStr;
+
+    { SymmetricExceptWith }
+    LSet.Clear;
+    LSet.AddRange(['Fff', 'FPC']);
+    NotificationAdd(ASet, 'FPC', cnAdded);
+    NotificationAdd(ASet, 'Fff', cnRemoved);
+    ASet.SymmetricExceptWith(LSet);
+    AssertNotificationsExecutedStr;
+
+    { Small clean up }
+    NotificationAdd(ASet, 'Eee', cnRemoved);
+    NotificationAdd(ASet, 'Ggg', cnExtracted);
+    AssertTrue(ASet.Remove('Eee'));
+    AssertEquals(ASet.Extract('Ggg'), 'Ggg');
+    AssertNotificationsExecutedStr;
+
+    { UnionWith }
+    LSet.Clear;
+    LSet.Add('Polandball');
+    NotificationAdd(ASet, 'Polandball', cnAdded);
+    ASet.UnionWith(LSet);
+    AssertNotificationsExecutedStr;
+
+    { Clear }
+    NotificationAdd(ASet, 'FPC', cnRemoved);
+    AssertTrue(ASet.Remove('FPC'));
+    AssertNotificationsExecutedStr;
+    NotificationAdd(ASet, 'Polandball', cnRemoved);
+    ASet.Clear;
+    AssertNotificationsExecutedStr;
+  finally
+    NotificationAdd(ASet, 'Polandball', cnAdded);
+    ASet.Add('Polandball');
+    AssertNotificationsExecutedStr;
+    LSet.Free;
+    NotificationAdd(ASet, 'Polandball', cnRemoved);
+    ASet.Free;
+    AssertNotificationsExecutedStr;
+  end;
+end;
+
+procedure TTestSets.Test_THashSet_Notification;
+begin
+  Test_TCustomSet_Notification(THashSet<string>.Create);
+end;
+
+procedure TTestSets.Test_TSortedSet_Notification;
+begin
+  Test_TCustomSet_Notification(TSortedSet<string>.Create);
+end;
+
+procedure TTestSets.Test_TSortedHashSet_Notification;
+begin
+  Test_TCustomSet_Notification(TSortedHashSet<string>.Create);
+end;
+
+begin
+  RegisterTest(TTestSets);
+end.
+

packages/rtl-generics/tests/tests.generics.stdcollections.pas

@@ -0,0 +1,919 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2018 by Maciej Izak (hnb),
+    member of the Free Pascal development team
+
+    It contains tests for the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types, tests and major refactoring of entire library
+
+    Thanks to Castle Game Engine (https://castle-engine.sourceforge.io)
+    Part of tests for this module was copied from Castle Game Engine tests
+
+ **********************************************************************}
+
+unit tests.generics.stdcollections;
+
+{$mode delphi}
+
+interface
+
+uses
+  fpcunit, testutils, testregistry, tests.generics.utils,
+  Classes, SysUtils, Generics.Collections, Generics.Defaults;
+
+type
+  TTestStdCollections = class(TTestCollections)
+  private
+    procedure Test_TList_Notification(AList: TList<string>); overload;
+  published
+    // Tests from Castle Game Engine
+    procedure Test_List;
+    procedure Test_FreeingManually;
+    procedure Test_AddingLists;
+    procedure Test_Sort;
+    procedure Test_Pack;
+    procedure Test_RecordsList;
+    procedure Test_VectorsList;
+    procedure Test_MethodsList;
+
+    // My (c) tests
+    procedure Test_SortedList;
+    procedure Test_Queue;
+    procedure Test_GenericListBox;
+
+    procedure Test_TList_Notification; overload;
+    procedure Test_TSortedList_Notification;
+    procedure Test_TQueue_Notification;
+    procedure Test_TStack_Notification;
+    procedure Test_TObjectList_Notification;
+    procedure Test_TObjectQueue_Notification;
+    procedure Test_TObjectStack_Notification;
+
+    procedure Test_TrimExcess;
+  end;
+
+  TGenericListBox<T> = class
+  private class var
+    F : TList<TComponentClass>;
+    class procedure Test(ATest: TTestCase);
+  end;
+
+implementation
+
+class procedure TGenericListBox<T>.Test(ATest: TTestCase);
+begin
+  F := TList<TComponentClass>.Create;
+  F.Add(TDataModule);
+  F.Add(nil);
+  with TList<TComponentClass>.Create(F) do
+  begin
+    ATest.AssertTrue(Count = 2);
+    ATest.AssertTrue(F[0] = Items[0]);
+    ATest.AssertTrue(F[1] = Items[1]);
+    ATest.AssertTrue(F[0] = TDataModule);
+    ATest.AssertTrue(F[1] = nil);
+    Free;
+  end;
+  F.Free;
+end;
+
+type
+  TApple = class
+    Name: string;
+  end;
+
+type
+  TAppleList = class(TObjectList<TApple>)
+    procedure Pack;
+  end;
+
+procedure TAppleList.Pack;
+begin
+  while Remove(nil) <> -1 do ;
+end;
+
+procedure TTestStdCollections.Test_List;
+var
+  A: TApple;
+  Apples: TAppleList;
+begin
+  Apples := TAppleList.Create(true);
+  try
+    A := TApple.Create;
+    Apples.Add(A);
+    Apples.Add(TApple.Create);
+    A := TApple.Create;
+    Apples.Add(A);
+
+    AssertEquals(3, Apples.Count);
+    AssertEquals(2, Apples.IndexOf(A));
+
+    Apples.Delete(0);
+
+    AssertEquals(2, Apples.Count);
+    AssertEquals(1, Apples.IndexOf(A));
+
+    Apples.Remove(A);
+
+    AssertEquals(1, Apples.Count);
+
+    Apples.Delete(0);
+
+    AssertEquals(0, Apples.Count);
+  finally FreeAndNil(Apples) end;
+end;
+
+procedure TTestStdCollections.Test_FreeingManually;
+var
+  A: TApple;
+  Apples: TAppleList;
+begin
+  Apples := TAppleList.Create(false);
+  try
+    A := TApple.Create;
+    Apples.Add(A);
+    Apples.Add(A);
+    Apples.Add(TApple.Create);
+
+    { This freeing would be invalid on a list that owns children,
+      as we free something twice, and we leave some invalid references
+      (to already freed items) in the list at various stages.
+      But it should be OK with list that has OwnsChildren = false. }
+
+    Apples[0].Free;
+    Apples[0] := nil;
+    Apples[1] := nil;
+    Apples[2].Free;
+  finally FreeAndNil(Apples) end;
+end;
+
+procedure TTestStdCollections.Test_AddingLists;
+var
+  A: TApple;
+  Apples, Apples2: TAppleList;
+begin
+  Apples := TAppleList.Create(true);
+  try
+    A := TApple.Create;
+    A.Name := 'One';
+    Apples.Add(A);
+
+    A := TApple.Create;
+    A.Name := 'Two';
+    Apples.Add(A);
+
+    Apples2 := TAppleList.Create(false);
+    try
+      Apples2.AddRange(Apples);
+      Apples2.AddRange(Apples);
+      Apples2.AddRange(Apples);
+      AssertEquals(6, Apples2.Count);
+      AssertEquals('One', Apples2[0].Name);
+      AssertEquals('Two', Apples2[1].Name);
+      AssertEquals('One', Apples2[2].Name);
+      AssertEquals('Two', Apples2[3].Name);
+      AssertEquals('One', Apples2[4].Name);
+      AssertEquals('Two', Apples2[5].Name);
+    finally FreeAndNil(Apples2) end;
+  finally FreeAndNil(Apples) end;
+end;
+
+function CompareApples(constref Left, Right: TApple): Integer;
+begin
+  Result := AnsiCompareStr(Left.Name, Right.Name);
+end;
+
+procedure TTestStdCollections.Test_Sort;
+type
+  TAppleComparer = TComparer<TApple>;
+var
+  A: TApple;
+  L: TAppleList;
+begin
+  L := TAppleList.Create(true);
+  try
+    A := TApple.Create;
+    A.Name := '11';
+    L.Add(A);
+
+    A := TApple.Create;
+    A.Name := '33';
+    L.Add(A);
+
+    A := TApple.Create;
+    A.Name := '22';
+    L.Add(A);
+
+    L.Sort(TAppleComparer.Construct(@CompareApples));
+
+    AssertEquals(3, L.Count);
+    AssertEquals('11', L[0].Name);
+    AssertEquals('22', L[1].Name);
+    AssertEquals('33', L[2].Name);
+  finally FreeAndNil(L) end;
+end;
+
+procedure TTestStdCollections.Test_Pack;
+var
+  A: TApple;
+  L: TAppleList;
+begin
+  L := TAppleList.Create(true);
+  try
+    L.Add(nil);
+
+    A := TApple.Create;
+    A.Name := '11';
+    L.Add(A);
+
+    L.Add(nil);
+
+    A := TApple.Create;
+    A.Name := '33';
+    L.Add(A);
+
+    A := TApple.Create;
+    A.Name := '22';
+    L.Add(A);
+
+    L.Add(nil);
+    L.Add(nil);
+
+    L.Pack;
+
+    AssertEquals(3, L.Count);
+    AssertEquals('11', L[0].Name);
+    AssertEquals('33', L[1].Name);
+    AssertEquals('22', L[2].Name);
+  finally FreeAndNil(L) end;
+end;
+
+procedure TTestStdCollections.Test_RecordsList;
+type
+  TMyRecord = packed record
+    A, B: Integer;
+  end;
+  TMyRecordList = TList<TMyRecord>;
+var
+  List: TMyRecordList;
+  R1, R2, R: TMyRecord;
+begin
+  List := TMyRecordList.Create;
+  try
+    R1.A := 11;
+    R1.B := 22;
+    List.Add(R1);
+
+    R2.A := 33;
+    R2.B := 44;
+    List.Add(R2);
+
+    R2.A := 33;
+    R2.B := 44;
+    List.Add(R2);
+
+    AssertEquals(3, List.Count);
+    AssertEquals(11, List[0].A);
+    AssertEquals(22, List[0].B);
+    AssertEquals(33, List[1].A);
+    AssertEquals(44, List[1].B);
+    AssertEquals(33, List[2].A);
+    AssertEquals(44, List[2].B);
+
+    List.Delete(2);
+
+    AssertEquals(2, List.Count);
+    AssertEquals(11, List[0].A);
+    AssertEquals(22, List[0].B);
+    AssertEquals(33, List[1].A);
+    AssertEquals(44, List[1].B);
+
+    AssertEquals(0, List.IndexOf(R1));
+    AssertEquals(1, List.IndexOf(R2));
+
+    // change R1 and R2, to make sure it doesn't matter for tests
+    R1.A := 111111;
+    R1.B := 222222;
+    R2.A := 333333;
+    R2.B := 444444;
+    AssertEquals(-1, List.IndexOf(R1));
+    AssertEquals(-1, List.IndexOf(R2));
+
+    R.A := 11;
+    R.B := 22;
+    AssertEquals(0, List.IndexOf(R));
+
+    R.A := 33;
+    R.B := 44;
+    AssertEquals(1, List.IndexOf(R));
+
+    R.A := 11;
+    R.B := 22;
+    List.Remove(R);
+    AssertEquals(1, List.Count);
+    AssertEquals(33, List[0].A);
+    AssertEquals(44, List[0].B);
+
+    R.A := 666;
+    R.B := 22;
+    List.Remove(R); // does nothing, no such record
+    AssertEquals(1, List.Count);
+    AssertEquals(33, List[0].A);
+    AssertEquals(44, List[0].B);
+  finally FreeAndNil(List) end;
+end;
+
+procedure TTestStdCollections.Test_VectorsList;
+type
+  TMyVector = packed array [0..1] of Single;
+  TMyVectorList = TList<TMyVector>;
+var
+  List: TMyVectorList;
+  R1, R2, R: TMyVector;
+begin
+  List := TMyVectorList.Create;
+  try
+    R1[0] := 11;
+    R1[1] := 22;
+    List.Add(R1);
+
+    R2[0] := 33;
+    R2[1] := 44;
+    List.Add(R2);
+
+    R2[0] := 33;
+    R2[1] := 44;
+    List.Add(R2);
+
+    AssertEquals(3, List.Count);
+    AssertEquals(11, List[0][0]);
+    AssertEquals(22, List[0][1]);
+    AssertEquals(33, List[1][0]);
+    AssertEquals(44, List[1][1]);
+    AssertEquals(33, List[2][0]);
+    AssertEquals(44, List[2][1]);
+
+    List.Delete(2);
+
+    AssertEquals(2, List.Count);
+    AssertEquals(11, List[0][0]);
+    AssertEquals(22, List[0][1]);
+    AssertEquals(33, List[1][0]);
+    AssertEquals(44, List[1][1]);
+
+    AssertEquals(0, List.IndexOf(R1));
+    AssertEquals(1, List.IndexOf(R2));
+
+    // change R1 and R2, to make sure it doesn't matter for tests
+    R1[0] := 111111;
+    R1[1] := 222222;
+    R2[0] := 333333;
+    R2[1] := 444444;
+    AssertEquals(-1, List.IndexOf(R1));
+    AssertEquals(-1, List.IndexOf(R2));
+
+    R[0] := 11;
+    R[1] := 22;
+    AssertEquals(0, List.IndexOf(R));
+
+    R[0] := 33;
+    R[1] := 44;
+    AssertEquals(1, List.IndexOf(R));
+
+    R[0] := 11;
+    R[1] := 22;
+    List.Remove(R);
+    AssertEquals(1, List.Count);
+    AssertEquals(33, List[0][0]);
+    AssertEquals(44, List[0][1]);
+
+    R[0] := 666;
+    R[1] := 22;
+    List.Remove(R); // does nothing, no such item
+    AssertEquals(1, List.Count);
+    AssertEquals(33, List[0][0]);
+    AssertEquals(44, List[0][1]);
+  finally FreeAndNil(List) end;
+end;
+
+type
+  TSomeClass = class
+    procedure Foo(A: Integer);
+  end;
+
+procedure TSomeClass.Foo(A: Integer);
+begin
+end;
+
+procedure TTestStdCollections.Test_MethodsList;
+type
+  TMyMethod = procedure (A: Integer) of object;
+  TMyMethodList = TList<TMyMethod>;
+
+  procedure AssertMethodsEqual(const M1, M2: TMyMethod);
+  begin
+    AssertTrue(TMethod(M1).Code = TMethod(M2).Code);
+    AssertTrue(TMethod(M1).Data = TMethod(M2).Data);
+  end;
+
+var
+  List: TMyMethodList;
+  C1, C2, C3: TSomeClass;
+  M: TMyMethod;
+begin
+  C1 := TSomeClass.Create;
+  C2 := TSomeClass.Create;
+  C3 := TSomeClass.Create;
+
+  List := TMyMethodList.Create;
+  try
+    List.Add(C1.Foo);
+    List.Add(C2.Foo);
+    List.Add(C2.Foo);
+
+    AssertEquals(3, List.Count);
+    M := C1.Foo;
+    AssertMethodsEqual(List[0], M);
+    M := C2.Foo;
+    AssertMethodsEqual(List[1], M);
+    AssertMethodsEqual(List[2], M);
+
+    List.Delete(2);
+
+    AssertEquals(2, List.Count);
+    M := C1.Foo;
+    AssertMethodsEqual(List[0], M);
+    M := C2.Foo;
+    AssertMethodsEqual(List[1], M);
+
+    AssertEquals(0, List.IndexOf(C1.Foo));
+    AssertEquals(1, List.IndexOf(C2.Foo));
+
+    AssertEquals(-1, List.IndexOf(C3.Foo));
+
+    List.Remove(C1.Foo);
+    AssertEquals(1, List.Count);
+    M := C2.Foo;
+    AssertMethodsEqual(List[0], M);
+
+    List.Remove(C3.Foo); // does nothing, no such item
+    AssertEquals(1, List.Count);
+    M := C2.Foo;
+    AssertMethodsEqual(List[0], M);
+  finally FreeAndNil(List) end;
+
+  C1.Free;
+  C2.Free;
+  C3.Free;
+end;
+
+procedure TTestStdCollections.Test_SortedList;
+var
+  LSortedList: TSortedList<Integer>;
+  i: integer;
+  LRandomOrder: TArray<Integer>;
+begin
+  LRandomOrder := TArray<Integer>.Create(
+    10, 8, 17, 19, 2, 0, 13, 15, 5, 7, 12, 14, 4, 6, 11, 9, 16, 18, 3, 1);
+
+  LSortedList := TSortedList<Integer>.Create;
+  for i in LRandomOrder do
+    LSortedList.Add(i);
+
+  AssertEquals('Wrong Count value for TSortedList', Length(LRandomOrder), LSortedList.Count);
+
+  for i := 0 to 19 do
+    AssertEquals(Format('Wrong item (%d) index (%d) in TSortedList',[LSortedList[i], i]), i, LSortedList[i]);
+
+  LSortedList.Free;
+end;
+
+procedure TTestStdCollections.Test_Queue;
+const
+  NUMBERS: array[0..2] of Integer = (3,4,5);
+var
+  LQueue: TQueue<Integer>;
+  i: Integer;
+  j: Integer;
+  pi: Pinteger;
+begin
+  LQueue := TQueue<Integer>.Create;
+
+  for i := 1 to 5 do
+  begin
+    LQueue.Enqueue(i);
+    AssertEquals(LQueue.Peek, 1);
+  end;
+
+  AssertEquals(LQueue.Dequeue, 1);
+  AssertEquals(LQueue.Extract, 2);
+
+  j := 0;
+  for i in LQueue do
+  begin
+    AssertEquals(i, NUMBERS[j]);
+    Inc(j);
+  end;
+
+  j := 0;
+  for pi in LQueue.Ptr^ do
+  begin
+    AssertEquals(pi^, NUMBERS[j]);
+    Inc(j);
+  end;
+
+  LQueue.Free;
+end;
+
+procedure TTestStdCollections.Test_TList_Notification(AList: TList<string>);
+var
+  LStringsObj: TEnumerable<string>;
+  LStringsIntf: IEnumerable<string>;
+begin
+  try
+    LStringsObj := EnumerableStringsObj(['Ddd', 'Eee']);
+    LStringsIntf := EnumerableStringsIntf(['Fff', 'Ggg']);
+    AList.OnNotify := NotifyTestStr;
+
+    { Add + AddRange }
+
+    NotificationAdd(AList, ['Aaa', 'Bbb', 'Ccc', 'Ddd', 'Eee', 'Fff', 'Ggg'], cnAdded);
+    AList.Add('Aaa');
+    AList.AddRange(['Bbb', 'Ccc']);
+    AList.AddRange(LStringsObj);
+    AList.AddRange(LStringsIntf);
+    AssertNotificationsExecutedStr;
+
+    { Clear }
+
+    NotificationAdd(AList, ['Aaa', 'Bbb', 'Ccc', 'Ddd', 'Eee', 'Fff', 'Ggg'], cnRemoved);
+    AList.Clear;
+    AssertNotificationsExecutedStr;
+
+    { Insert + InsertRange }
+
+    NotificationAdd(AList, ['Aaa', 'Bbb', 'Ccc', 'Ddd', 'Eee', 'Fff', 'Ggg'], cnAdded);
+    AList.Insert(0, 'Aaa');
+    AList.InsertRange(1, ['Bbb', 'Ccc']);
+    AList.InsertRange(3, LStringsObj);
+    AList.InsertRange(5, LStringsIntf);
+    AssertNotificationsExecutedStr;
+
+    { Remove + Delete + DeleteRange }
+
+    NotificationAdd(AList, ['Aaa', 'Bbb', 'Ccc', 'Ddd', 'Eee', 'Fff', 'Ggg'], cnRemoved);
+    AList.Remove('Aaa');
+    AList.Delete(0);
+    AList.DeleteRange(0, 5);
+    AssertEquals(AList.Count, 0);
+    AssertNotificationsExecutedStr;
+
+    { ExtractIndex, Extract }
+
+    NotificationAdd(AList, ['Aaa', 'Bbb', 'Ccc'], cnAdded);
+    AList.AddRange(['Aaa', 'Bbb', 'Ccc']);
+    AssertNotificationsExecutedStr;
+    NotificationAdd(AList, ['Aaa', 'Bbb'], cnExtracted);
+    AssertEquals(AList.ExtractIndex(0), 'Aaa');
+    AssertEquals(AList.Extract('Bbb'), 'Bbb');
+    AssertNotificationsExecutedStr;
+
+    { SetItem }
+    NotificationAdd(AList, 'Ccc', cnRemoved);
+    NotificationAdd(AList, 'FPC', cnAdded);
+    AList[0] := 'FPC';
+    AssertNotificationsExecutedStr;
+
+  finally
+    LStringsObj.Free;
+    { Free }
+    NotificationAdd(AList, 'FPC', cnRemoved);
+    AList.Free;
+    AssertNotificationsExecutedStr;
+  end;
+end;
+
+procedure TTestStdCollections.Test_TList_Notification;
+begin
+  Test_TList_Notification(TList<string>.Create);
+end;
+
+procedure TTestStdCollections.Test_TSortedList_Notification;
+var
+  LList: TSortedList<string>;
+begin
+  LList := TSortedList<string>.Create;
+  LList.SortStyle := cssUser;
+  Test_TList_Notification(LList);
+end;
+
+procedure TTestStdCollections.Test_TQueue_Notification;
+var
+  LQueue: TQueue<string>;
+begin
+  LQueue := TQueue<string>.Create();
+  try
+    LQueue.OnNotify := NotifyTestStr;
+
+    { Enqueue }
+    NotificationAdd(LQueue, ['Aaa', 'Bbb', 'Ccc', 'Ddd'], cnAdded);
+    LQueue.Enqueue('Aaa');
+    LQueue.Enqueue('Bbb');
+    LQueue.Enqueue('Ccc');
+    LQueue.Enqueue('Ddd');
+    AssertNotificationsExecutedStr;
+
+    { Dequeue }
+    NotificationAdd(LQueue, 'Aaa', cnRemoved);
+    AssertEquals(LQueue.Dequeue, 'Aaa');
+    AssertNotificationsExecutedStr;
+
+    { Extract }
+    NotificationAdd(LQueue, 'Bbb', cnExtracted);
+    AssertEquals(LQueue.Extract, 'Bbb');
+    AssertNotificationsExecutedStr;
+
+    { Clear }
+    NotificationAdd(LQueue, ['Ccc', 'Ddd'], cnRemoved);
+    LQueue.Clear;
+    AssertNotificationsExecutedStr;
+
+    { Enqueue }
+    NotificationAdd(LQueue, ['FPC', 'Polandball'], cnAdded);
+    LQueue.Enqueue('FPC');
+    LQueue.Enqueue('Polandball');
+    AssertNotificationsExecutedStr;
+  finally
+    NotificationAdd(LQueue, ['FPC', 'Polandball'], cnRemoved);
+    LQueue.Free;
+    AssertNotificationsExecutedStr;
+  end;
+end;
+
+procedure TTestStdCollections.Test_TStack_Notification;
+var
+  LStack: TStack<string>;
+begin
+  LStack := TStack<string>.Create();
+  try
+    LStack.OnNotify := NotifyTestStr;
+
+    { Push }
+    NotificationAdd(LStack, ['Aaa', 'Bbb', 'Ccc', 'Ddd'], cnAdded);
+    LStack.Push('Aaa');
+    LStack.Push('Bbb');
+    LStack.Push('Ccc');
+    LStack.Push('Ddd');
+    AssertNotificationsExecutedStr;
+
+    { Pop }
+    NotificationAdd(LStack, 'Ddd', cnRemoved);
+    AssertEquals(LStack.Pop, 'Ddd');
+    AssertNotificationsExecutedStr;
+
+    { Extract }
+    NotificationAdd(LStack, 'Ccc', cnExtracted);
+    AssertEquals(LStack.Extract, 'Ccc');
+    AssertNotificationsExecutedStr;
+
+    { Clear }
+    NotificationAdd(LStack, ['Bbb', 'Aaa'], cnRemoved);
+    LStack.Clear;
+    AssertNotificationsExecutedStr;
+
+    { Push }
+    NotificationAdd(LStack, ['FPC', 'Polandball'], cnAdded);
+    LStack.Push('FPC');
+    LStack.Push('Polandball');
+    AssertNotificationsExecutedStr;
+  finally
+    NotificationAdd(LStack, ['Polandball', 'FPC'], cnRemoved);
+    LStack.Free;
+    AssertNotificationsExecutedStr;
+  end;
+end;
+
+procedure TTestStdCollections.Test_TObjectList_Notification;
+var
+  LObj: TEnumerable<TObject>;
+  LIntf: IEnumerable<TObject>;
+  O: TArray<TObject>;
+  LList: TObjectList<TObject>;
+  i: Integer;
+begin
+  try
+    CreateObjects(O, 8);
+
+    LList := TObjectList<TObject>.Create(false);
+    LList.OnNotify := NotifyTestObj;
+
+    LObj := EnumerableObjectsObj([O[3], O[4]]);
+    LIntf := EnumerableObjectsIntf([O[5], O[6]]);
+
+    { Add + AddRange }
+
+    NotificationAdd(LList, [O[0], O[1], O[2], O[3], O[4], O[5], O[6]], cnAdded);
+    LList.Add(O[0]);
+    LList.AddRange([O[1], O[2]]);
+    LList.AddRange(LObj);
+    LList.AddRange(LIntf);
+    AssertNotificationsExecutedObj;
+
+    { Clear }
+
+    NotificationAdd(LList, [O[0], O[1], O[2], O[3], O[4], O[5], O[6]], cnRemoved);
+    LList.Clear;
+    AssertNotificationsExecutedObj;
+
+    { Insert + InsertRange }
+
+    NotificationAdd(LList, [O[0], O[1], O[2], O[3], O[4], O[5], O[6]], cnAdded);
+    LList.Insert(0, O[0]);
+    LList.InsertRange(1, [O[1], O[2]]);
+    LList.InsertRange(3, LObj);
+    LList.InsertRange(5, LIntf);
+    AssertNotificationsExecutedObj;
+
+    { Remove + Delete + DeleteRange }
+
+    NotificationAdd(LList, [O[0], O[1], O[2], O[3], O[4], O[5], O[6]], cnRemoved);
+    LList.Remove(O[0]);
+    LList.Delete(0);
+    LList.DeleteRange(0, 5);
+    AssertEquals(LList.Count, 0);
+    AssertNotificationsExecutedObj;
+
+    { ExtractIndex, Extract }
+
+    NotificationAdd(LList, [O[0], O[1], O[2]], cnAdded);
+    LList.AddRange([O[0], O[1], O[2]]);
+    AssertNotificationsExecutedObj;
+    NotificationAdd(LList, [O[0], O[1]], cnExtracted);
+    AssertTrue(LList.ExtractIndex(0) = O[0]);
+    AssertTrue(LList.Extract(O[1]) = O[1]);
+    AssertNotificationsExecutedObj;
+
+    { SetItem }
+    NotificationAdd(LList, O[2], cnRemoved);
+    NotificationAdd(LList, O[7], cnAdded);
+    LList[0] := O[7];
+    AssertNotificationsExecutedObj;
+
+  finally
+    LObj.Free;
+    { Free }
+    NotificationAdd(LList, O[7], cnRemoved);
+    FreeObjects(O);
+    LList.Free;
+    AssertNotificationsExecutedObj;
+  end;
+end;
+
+procedure TTestStdCollections.Test_TObjectQueue_Notification;
+var
+  LQueue: TObjectQueue<TObject>;
+  O: TArray<TObject>;
+begin
+  LQueue := TObjectQueue<TObject>.Create(false);
+  try
+    CreateObjects(O, 6);
+    LQueue.OnNotify := NotifyTestObj;
+
+    { Enqueue }
+    NotificationAdd(LQueue, [O[0], O[1], O[2], O[3]], cnAdded);
+    LQueue.Enqueue(O[0]);
+    LQueue.Enqueue(O[1]);
+    LQueue.Enqueue(O[2]);
+    LQueue.Enqueue(O[3]);
+    AssertNotificationsExecutedObj;
+
+    { Dequeue }
+    NotificationAdd(LQueue, O[0], cnRemoved);
+    LQueue.Dequeue;
+    AssertNotificationsExecutedObj;
+
+    { Extract }
+    NotificationAdd(LQueue, O[1], cnExtracted);
+    AssertTrue(LQueue.Extract = O[1]);
+    AssertNotificationsExecutedObj;
+
+    { Clear }
+    NotificationAdd(LQueue, [O[2], O[3]], cnRemoved);
+    LQueue.Clear;
+    AssertNotificationsExecutedObj;
+
+    { Enqueue }
+    NotificationAdd(LQueue, [O[4], O[5]], cnAdded);
+    LQueue.Enqueue(O[4]);
+    LQueue.Enqueue(O[5]);
+    AssertNotificationsExecutedObj;
+  finally
+    NotificationAdd(LQueue, [O[4], O[5]], cnRemoved);
+    FreeObjects(O);
+    LQueue.Free;
+    AssertNotificationsExecutedObj;
+  end;
+end;
+
+procedure TTestStdCollections.Test_TObjectStack_Notification;
+var
+  LStack: TStack<TObject>;
+  O: TArray<TObject>;
+begin
+  LStack := TObjectStack<TObject>.Create(false);
+  try
+    CreateObjects(O, 6);
+    LStack.OnNotify := NotifyTestObj;
+
+    { Push }
+    NotificationAdd(LStack, [O[0], O[1], O[2], O[3]], cnAdded);
+    LStack.Push(O[0]);
+    LStack.Push(O[1]);
+    LStack.Push(O[2]);
+    LStack.Push(O[3]);
+    AssertNotificationsExecutedObj;
+
+    { Pop }
+    NotificationAdd(LStack, O[3], cnRemoved);
+    AssertTrue(LStack.Pop = O[3]);
+    AssertNotificationsExecutedObj;
+
+    { Extract }
+    NotificationAdd(LStack, O[2], cnExtracted);
+    AssertTrue(LStack.Extract = O[2]);
+    AssertNotificationsExecutedObj;
+
+    { Clear }
+    NotificationAdd(LStack, [O[1], O[0]], cnRemoved);
+    LStack.Clear;
+    AssertNotificationsExecutedObj;
+
+    { Pop }
+    NotificationAdd(LStack, [O[4], O[5]], cnAdded);
+    LStack.Push(O[4]);
+    LStack.Push(O[5]);
+    AssertNotificationsExecutedObj;
+  finally
+    NotificationAdd(LStack, [O[5], O[4]], cnRemoved);
+    FreeObjects(O);
+    LStack.Free;
+    AssertNotificationsExecutedObj;
+  end;
+end;
+
+procedure TTestStdCollections.Test_GenericListBox;
+begin
+  TGenericListBox<Integer>.Test(Self);
+end;
+
+procedure TTestStdCollections.Test_TrimExcess;
+var
+  LList: TList<Integer>;
+  LQueue: TQueue<Integer>;
+  LStack: TStack<Integer>;
+begin
+  LList := TList<Integer>.Create;
+  LQueue := TQueue<Integer>.Create;
+  LStack := TStack<Integer>.Create;
+
+  try
+    LList.AddRange([1, 2, 3, 4, 5, 6]);
+    LList.DeleteRange(2, 3);
+    CheckNotEquals(LList.Capacity, LList.Count);
+    LList.TrimExcess;
+    AssertEquals(LList.Capacity, LList.Count);
+
+    LQueue.Enqueue(1);
+    LQueue.Enqueue(2);
+    LQueue.Dequeue;
+    CheckNotEquals(LQueue.Capacity, LQueue.Count);
+    LQueue.TrimExcess;
+    AssertEquals(LQueue.Capacity, LQueue.Count);
+
+    LStack.Push(1);
+    LStack.Push(2);
+    LStack.Pop;
+    CheckNotEquals(LStack.Capacity, LStack.Count);
+    LStack.TrimExcess;
+    AssertEquals(LStack.Capacity, LStack.Count);
+  finally
+    LStack.Free;
+    LQueue.Free;
+    LList.Free;
+  end;
+end;
+
+begin
+  RegisterTest(TTestStdCollections);
+end.

packages/rtl-generics/tests/tests.generics.trees.pas

@@ -0,0 +1,202 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2018 by Maciej Izak (hnb),
+    member of the Free Pascal development team
+
+    It contains tests for the Free Pascal generics library
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+    Acknowledgment
+
+    Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
+    many new types, tests and major refactoring of entire library
+
+ **********************************************************************}
+
+unit tests.generics.trees;
+
+{$mode delphi}
+
+interface
+
+uses
+  fpcunit, testregistry, testutils, tests.generics.utils,
+  Classes, SysUtils, Generics.Collections;
+
+type
+
+  { TTestArrayHelper }
+
+  { TTestTrees }
+
+  TTestTrees = class(TTestCollections)
+  published
+    procedure Test_IndexedAVLTree_Add_General;
+    procedure Test_IndexedAVLTree_Add;
+    procedure Test_IndexedAVLTree_Delete;
+
+    procedure Test_TAVLTreeMap_Notification;
+  end;
+
+implementation
+
+type
+  TStringsTree = TIndexedAVLTree<string>;
+
+{ TTestTrees }
+
+procedure TTestTrees.Test_IndexedAVLTree_Add_General;
+const
+  _COUNT = 999;
+var
+  LNumbers: THashSet<Integer>;
+  i, j: Integer;
+  LTree: TStringsTree;
+  LNodes: TList<TStringsTree.PNode>;
+  n: TStringsTree.PNode;
+begin
+  LNumbers := THashSet<Integer>.Create;
+  LTree := TStringsTree.Create;
+  LNodes := TList<TStringsTree.PNode>.Create;
+
+  try
+    // check consistency of adding new nodes to Indexed AVL
+    for i := 0 to _COUNT do
+    begin
+      LNodes.Add(LTree.Add('0'+i.ToString));
+      LNumbers.Clear;
+      for n in LTree.Nodes do
+        Check(LNumbers.Add(LTree.NodeToIndex(n)), 'Wrong index (duplicate) of '+ i.ToString + ' for node ' + n.Key);
+      for j := 0 to LNodes.Count - 1 do
+        Check(LNumbers.Contains(j), 'Missing index ' + j.ToString + ' for i = ' + i.ToString);
+      LTree.ConsistencyCheck;
+      CheckEquals(i+1, LTree.Count, 'Wrong tree count');
+    end;
+  finally
+    LNodes.Free;
+    LTree.Free;
+    LNumbers.Free;
+  end;
+end;
+
+procedure TTestTrees.Test_IndexedAVLTree_Add;
+var
+  LTree: TStringsTree;
+begin
+  LTree := TStringsTree.Create;
+
+  try
+    LTree.Duplicates:=dupAccept;
+    LTree.Add('Aaa');
+  finally
+    LTree.Free;
+  end;
+end;
+
+procedure TTestTrees.Test_IndexedAVLTree_Delete;
+const
+  _COUNT = 999;
+var
+  LNumbers: THashSet<Integer>;
+  i, j: Integer;
+  LTree: TStringsTree;
+  LNodes: TList<TStringsTree.PNode>;
+  n: TStringsTree.PNode;
+begin
+  LNumbers := THashSet<Integer>.Create;
+  LTree := TStringsTree.Create;
+  LNodes := TList<TStringsTree.PNode>.Create;
+
+  try
+    for i := 0 to _COUNT do
+      LNodes.Add(LTree.Add('0'+i.ToString));
+
+    // check consistency of deleting nodes from Indexed AVL
+    for i := 0 to _COUNT do
+    begin
+      LTree.Delete(LNodes.ExtractIndex(Random(LNodes.count)));
+      LNumbers.Clear;
+      for n in LTree.Nodes do
+        Check(LNumbers.Add(LTree.NodeToIndex(n)), 'Wrong index (duplicate) of '+ i.ToString + ' for node ' + n.Key);
+      for j := 0 to LNodes.Count - 1 do
+        Check(LNumbers.Contains(j), 'Missing index ' + j.ToString + ' for i = ' + i.ToString);
+      LTree.ConsistencyCheck;
+      CheckEquals(_COUNT-i, LTree.Count, 'Wrong tree count');
+    end;
+  finally
+    LNodes.Free;
+    LTree.Free;
+    LNumbers.Free;
+  end;
+end;
+
+procedure TTestTrees.Test_TAVLTreeMap_Notification;
+var
+  LTree: TAVLTreeMap<string, string>;
+  LNode, LA, LC: TAVLTreeMap<string, string>.PNode;
+begin
+  LTree := TAVLTreeMap<string, string>.Create;
+  LTree.OnKeyNotify := NotifyTestStr;
+  LTree.OnValueNotify := NotifyTestStr;
+  LTree.OnNodeNotify := NotifyTestNodeStr;
+  try
+    // simple add
+    NotificationAdd(LTree, ['Aaa', 'Bbb'], cnAdded);
+    NotificationAdd(LTree, 'Aaa', 'Bbb', nil, cnAdded, false, true);
+    LA := LTree.Add('Aaa', 'Bbb');
+    AssertNotificationsExecutedNodeStr;
+    AssertNotificationsExecutedStr;
+
+    // pair add
+    NotificationAdd(LTree, ['Ccc', 'Ddd'], cnAdded);
+    NotificationAdd(LTree, 'Ccc', 'Ddd', nil, cnAdded, false, true);
+    LC := LTree.Add(TAVLTreeMap<string, string>.TTreePair.Create('Ccc', 'Ddd'));
+    AssertNotificationsExecutedNodeStr;
+    AssertNotificationsExecutedStr;
+
+    // AddNode;
+    LNode := LTree.NewNode;
+    LNode.Key := 'Eee';
+    LNode.Value := 'Fff';
+    NotificationAdd(LTree, ['Eee', 'Fff'], cnAdded);
+    NotificationAdd(LTree, 'Eee', 'Fff', LNode, cnAdded, false, false);
+    AssertTrue(LTree.AddNode(LNode));
+    AssertNotificationsExecutedNodeStr;
+    AssertNotificationsExecutedStr;
+
+    // Delete
+    NotificationAdd(LTree, ['Eee', 'Fff'], cnRemoved);
+    NotificationAdd(LTree, 'Eee', 'Fff', LNode, cnRemoved, false, false);
+    LTree.Delete(LNode, false);
+    AssertNotificationsExecutedNodeStr;
+    AssertNotificationsExecutedStr;
+    LTree.DisposeNode(LNode);
+
+    // remove
+    NotificationAdd(LTree, ['Aaa', 'Bbb'], cnRemoved);
+    NotificationAdd(LTree, 'Aaa', 'Bbb', LA, cnRemoved, true, false);
+    LTree.Remove('Aaa');
+    AssertNotificationsExecutedNodeStr;
+    AssertNotificationsExecutedStr;
+
+
+    // free
+    NotificationAdd(LTree, ['Ccc', 'Ddd'], cnRemoved);
+    NotificationAdd(LTree, 'Ccc', 'Ddd', LC, cnRemoved, true, false);
+  finally
+    LTree.Free;
+    AssertNotificationsExecutedNodeStr;
+    AssertNotificationsExecutedStr;
+  end;
+end;
+
+begin
+  RegisterTest(TTestTrees);
+end.
+

packages/rtl-generics/tests/tests.generics.utils.pas

@@ -0,0 +1,518 @@
+unit tests.generics.utils;
+
+{$mode delphi}
+
+interface
+
+uses
+  fpcunit, testutils, testregistry,
+  Classes, SysUtils, Generics.Collections;
+
+type
+  TNotificationRec<T> = record
+    Sender: TObject;
+    Item: T;
+    Action: TCollectionNotification;
+    Executed: boolean;
+  end;
+
+  TNotificationNodeRec<TValue, TInfo> = record
+    Sender: TObject;
+    Key: string;
+    Value: TValue;
+    IgnoreNodePtr: boolean;
+    Node: TCustomAVLTreeMap<string, TValue, TInfo>.PNode;
+    Action: TCollectionNotification;
+    Dispose: boolean;
+    Executed: boolean;
+  end;
+
+  TTestCollections = class(TTestCase)
+  private type
+    TNotificationRec_String = TNotificationRec<string>;
+    TNotificationRec_TObject = TNotificationRec<TObject>;
+    TNotificationNodeRec_String = TNotificationNodeRec<string, TEmptyRecord>;
+    TNotificationNodeRec_Empty = TNotificationNodeRec<TEmptyRecord, TEmptyRecord>;
+    PNode_String = TCustomAVLTreeMap<string, string, TEmptyRecord>.PNode;
+    PNode_Empty = TCustomAVLTreeMap<string, TEmptyRecord, TEmptyRecord>.PNode;
+  private
+    NotificationsListNode_String: TList<TNotificationNodeRec_String>;
+    NotificationsListNode_Empty: TList<TNotificationNodeRec_Empty>;
+    NotificationsListStr: TList<TNotificationRec_String>;
+    NotificationsListObj: TList<TNotificationRec_TObject>;
+    NotificationsIndex, NotificationsNodesIndex: Integer;
+  protected
+    procedure NotificationAdd(ASender: TObject; const AKey, AValue: string; ANode: PNode_String;
+      AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean); overload;
+    procedure NotificationAdd(ASender: TObject; const AKeys, AValues: array of string;
+      const ANodes: array of PNode_String; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean); overload;
+    procedure NotificationAdd(ASender: TObject; const AKey: string; ANode: PNode_Empty;
+      AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean); overload;
+    procedure NotificationAdd(ASender: TObject; const AKeys: array of string;
+      const ANodes: array of PNode_Empty; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean); overload;
+    procedure NotificationAdd(ASender: TObject; const AItem: string;
+      AAction: TCollectionNotification); overload;
+    procedure NotificationAdd(ASender: TObject; const AItems: array of string;
+      AAction: TCollectionNotification); overload;
+    procedure NotificationAdd(ASender: TObject; const AItem: TObject;
+      AAction: TCollectionNotification); overload;
+    procedure NotificationAdd(ASender: TObject; const AItems: array of TObject;
+      AAction: TCollectionNotification); overload;
+    procedure AssertNotificationsExecutedNodeStr;
+    procedure ClearNotificationsNodeStr;
+    procedure AssertNotificationsExecutedNodeEmpty;
+    procedure ClearNotificationsNodeEmpty;
+    procedure AssertNotificationsExecutedStr;
+    procedure ClearNotificationsStr;
+    procedure AssertNotificationsExecutedObj;
+    procedure ClearNotificationsObj;
+    procedure NotifyTestNodeStr(ASender: TObject; ANode: PNode_String; AAction: TCollectionNotification; ADispose: boolean);
+    procedure NotifyTestNodeEmpty(ASender: TObject; ANode: PNode_Empty; AAction: TCollectionNotification; ADispose: boolean);
+    procedure NotifyTestStr(ASender: TObject; constref AItem: string; AAction: TCollectionNotification);
+    procedure NotifyTestObj(ASender: TObject; constref AItem: TObject; AAction: TCollectionNotification);
+
+    procedure CreateObjects(var AArray: TArray<TObject>; ACount: Integer);
+    procedure FreeObjects(AArray: TArray<TObject>);
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+  end;
+
+  TStringList = TList<string>;
+
+  { TStringsEnumerator }
+
+  TStringsEnumerator = class(TInterfacedObject, IEnumerator<string>)
+  private
+    FEnumerator: TStringList.TEnumerator;
+    FCollection: TStringList;
+
+    function GetCurrent: string;
+    function MoveNext: Boolean;
+    procedure Reset;
+    property Current: string read GetCurrent;
+
+    constructor Create(AEnumerator: TStringList.TEnumerator; ACollection: TStringList);
+    destructor Destroy; override;
+  end;
+
+  { TStringsEnumerable }
+
+  TStringsEnumerable = class(TInterfacedObject, IEnumerable<string>)
+  private
+    FEnumerable: TStringList;
+
+    function GetEnumerator: IEnumerator<string>;
+
+    constructor Create(const AItems: array of string);
+  end;
+
+  TObjectList = TList<TObject>;
+
+  { TObjectEnumerator }
+
+  TObjectEnumerator = class(TInterfacedObject, IEnumerator<TObject>)
+  private
+    FEnumerator: TObjectList.TEnumerator;
+    FCollection: TObjectList;
+
+    function GetCurrent: TObject;
+    function MoveNext: Boolean;
+    procedure Reset;
+    property Current: TObject read GetCurrent;
+
+    constructor Create(AEnumerator: TObjectList.TEnumerator; ACollection: TObjectList);
+    destructor Destroy; override;
+  end;
+
+  { TObjectEnumerable }
+
+  TObjectEnumerable = class(TInterfacedObject, IEnumerable<TObject>)
+  private
+    FEnumerable: TObjectList;
+
+    function GetEnumerator: IEnumerator<TObject>;
+
+    constructor Create(const AItems: array of TObject);
+  end;
+
+function EnumerableStringsIntf(const AItems: array of string): IEnumerable<string>;
+function EnumerableStringsObj(const AItems: array of string): TEnumerable<string>;
+function EnumerableObjectsIntf(const AItems: array of TObject): IEnumerable<TObject>;
+function EnumerableObjectsObj(const AItems: array of TObject): TEnumerable<TObject>;
+
+implementation
+
+function EnumerableStringsIntf(const AItems: array of string): IEnumerable<string>;
+begin
+  Result := TStringsEnumerable.Create(AItems);
+end;
+
+function EnumerableStringsObj(const AItems: array of string): TEnumerable<string>;
+begin
+  Result := TStringList.Create;
+  TStringList(Result).AddRange(AItems);
+end;
+
+function EnumerableObjectsIntf(const AItems: array of TObject): IEnumerable<TObject>;
+begin
+  Result := TObjectEnumerable.Create(AItems);
+end;
+
+function EnumerableObjectsObj(const AItems: array of TObject): TEnumerable<TObject>;
+begin
+  Result := TObjectList.Create;
+  TObjectList(Result).AddRange(AItems);
+end;
+
+{ TTestCollections }
+
+procedure TTestCollections.NotificationAdd(ASender: TObject;
+  const AKey, AValue: string; ANode: PNode_String; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean);
+var
+  LNotification: TNotificationNodeRec_String;
+begin
+  LNotification.Sender := ASender;
+  LNotification.Key := AKey;
+  LNotification.Value := AValue;
+  LNotification.IgnoreNodePtr := AIgnoreNodePtr;
+  LNotification.Node := ANode;
+  LNotification.Action := AAction;
+  LNotification.Dispose := ADispose;
+  LNotification.Executed := False;
+  NotificationsListNode_String.Add(LNotification);
+end;
+
+procedure TTestCollections.NotificationAdd(ASender: TObject;
+  const AKeys, AValues: array of string; const ANodes: array of PNode_String; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean);
+var
+  i: Integer;
+begin
+  Assert(Length(AKeys) = Length(ANodes));
+  for i := 0 to High(AKeys) do
+    NotificationAdd(ASender, AKeys[i], AValues[i], ANodes[i], AAction, ADispose, AIgnoreNodePtr);
+end;
+
+procedure TTestCollections.NotificationAdd(ASender: TObject;
+  const AKey: string; ANode: PNode_Empty; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean);
+var
+  LNotification: TNotificationNodeRec_Empty;
+begin
+  LNotification.Sender := ASender;
+  LNotification.Key := AKey;
+  LNotification.Value := EmptyRecord;
+  LNotification.IgnoreNodePtr := AIgnoreNodePtr;
+  LNotification.Node := ANode;
+  LNotification.Action := AAction;
+  LNotification.Dispose := ADispose;
+  LNotification.Executed := False;
+  NotificationsListNode_Empty.Add(LNotification);
+end;
+
+procedure TTestCollections.NotificationAdd(ASender: TObject;
+  const AKeys: array of string; const ANodes: array of PNode_Empty; AAction: TCollectionNotification; ADispose, AIgnoreNodePtr: boolean);
+var
+  i: Integer;
+begin
+  Assert(Length(AKeys) = Length(ANodes));
+  for i := 0 to High(AKeys) do
+    NotificationAdd(ASender, AKeys[i], ANodes[i], AAction, ADispose, AIgnoreNodePtr);
+end;
+
+
+procedure TTestCollections.NotificationAdd(ASender: TObject;
+  const AItem: string; AAction: TCollectionNotification);
+var
+  LNotification: TNotificationRec_String;
+begin
+  LNotification.Sender := ASender;
+  LNotification.Item := AItem;
+  LNotification.Action := AAction;
+  LNotification.Executed := False;
+  NotificationsListStr.Add(LNotification);
+end;
+
+procedure TTestCollections.NotificationAdd(ASender: TObject;
+  const AItems: array of string; AAction: TCollectionNotification);
+var
+  s: string;
+begin
+  for s in AItems do
+    NotificationAdd(ASender, s, AAction);
+end;
+
+procedure TTestCollections.NotificationAdd(ASender: TObject;
+  const AItem: TObject; AAction: TCollectionNotification);
+var
+  LNotification: TNotificationRec_TObject;
+begin
+  LNotification.Sender := ASender;
+  LNotification.Item := AItem;
+  LNotification.Action := AAction;
+  LNotification.Executed := False;
+  NotificationsListObj.Add(LNotification);
+end;
+
+procedure TTestCollections.NotificationAdd(ASender: TObject;
+  const AItems: array of TObject; AAction: TCollectionNotification);
+var
+  o: TObject;
+begin
+  for o in AItems do
+    NotificationAdd(ASender, o, AAction);
+end;
+
+procedure TTestCollections.AssertNotificationsExecutedNodeStr;
+var
+  p: ^TNotificationNodeRec_String;
+begin
+  for p in NotificationsListNode_String.Ptr^ do
+    AssertTrue(p^.Executed);
+  AssertEquals(NotificationsNodesIndex, NotificationsListNode_String.Count);
+  ClearNotificationsStr;
+end;
+
+procedure TTestCollections.ClearNotificationsNodeStr;
+begin
+  NotificationsListNode_String.Clear;
+  NotificationsNodesIndex := 0;
+end;
+
+procedure TTestCollections.AssertNotificationsExecutedNodeEmpty;
+var
+  p: ^TNotificationNodeRec_Empty;
+begin
+  for p in NotificationsListNode_Empty.Ptr^ do
+    AssertTrue(p^.Executed);
+  AssertEquals(NotificationsNodesIndex, NotificationsListNode_Empty.Count);
+  ClearNotificationsStr;
+end;
+
+procedure TTestCollections.ClearNotificationsNodeEmpty;
+begin
+  NotificationsListNode_Empty.Clear;
+  NotificationsNodesIndex := 0;
+end;
+
+procedure TTestCollections.AssertNotificationsExecutedStr;
+var
+  p: ^TNotificationRec_String;
+begin
+  for p in NotificationsListStr.Ptr^ do
+    AssertTrue(p^.Executed);
+  AssertEquals(NotificationsIndex, NotificationsListStr.Count);
+  ClearNotificationsStr;
+end;
+
+procedure TTestCollections.ClearNotificationsStr;
+begin
+  NotificationsListStr.Clear;
+  NotificationsIndex := 0;
+end;
+
+procedure TTestCollections.AssertNotificationsExecutedObj;
+var
+  p: ^TNotificationRec_TObject;
+begin
+  for p in NotificationsListObj.Ptr^ do
+    AssertTrue(p^.Executed);
+  AssertEquals(NotificationsIndex, NotificationsListObj.Count);
+  ClearNotificationsObj;
+end;
+
+procedure TTestCollections.ClearNotificationsObj;
+begin
+  NotificationsListObj.Clear;
+  NotificationsIndex := 0;
+end;
+
+procedure TTestCollections.NotifyTestNodeStr(ASender: TObject; ANode: PNode_String; AAction: TCollectionNotification; ADispose: boolean);
+var
+  LNotification: TNotificationNodeRec_String;
+begin
+  AssertTrue(NotificationsNodesIndex < NotificationsListNode_String.Count);
+  LNotification := NotificationsListNode_String[NotificationsNodesIndex];
+  AssertTrue(ASender = LNotification.Sender);
+  AssertEquals(ANode.Key, LNotification.Key);
+  AssertEquals(ANode.Value, LNotification.Value);
+  if not LNotification.IgnoreNodePtr then
+    AssertSame(ANode, LNotification.Node);
+  AssertTrue(AAction = LNotification.Action);
+  AssertEquals(ADispose, LNotification.Dispose);
+  AssertFalse(LNotification.Executed);
+  LNotification.Executed := True;
+  NotificationsListNode_String[NotificationsNodesIndex] := LNotification;
+  Inc(NotificationsNodesIndex)
+end;
+
+procedure TTestCollections.NotifyTestNodeEmpty(ASender: TObject; ANode: PNode_Empty; AAction: TCollectionNotification; ADispose: boolean);
+var
+  LNotification: TNotificationNodeRec_Empty;
+begin
+  AssertTrue(NotificationsNodesIndex < NotificationsListNode_Empty.Count);
+  LNotification := NotificationsListNode_Empty[NotificationsNodesIndex];
+  AssertTrue(ASender = LNotification.Sender);
+  AssertEquals(ANode.Key, LNotification.Key);
+  if not LNotification.IgnoreNodePtr then
+    AssertSame(ANode, LNotification.Node);
+  AssertTrue(AAction = LNotification.Action);
+  AssertEquals(ADispose, LNotification.Dispose);
+  AssertFalse(LNotification.Executed);
+  LNotification.Executed := True;
+  NotificationsListNode_Empty[NotificationsNodesIndex] := LNotification;
+  Inc(NotificationsNodesIndex)
+end;
+
+procedure TTestCollections.NotifyTestStr(ASender: TObject; constref AItem: string; AAction: TCollectionNotification);
+var
+  LNotification: TNotificationRec_String;
+begin
+  AssertTrue(NotificationsIndex < NotificationsListStr.Count);
+  LNotification := NotificationsListStr[NotificationsIndex];
+  AssertTrue(ASender = LNotification.Sender);
+  AssertEquals(AItem, LNotification.Item);
+  AssertTrue(AAction = LNotification.Action);
+  AssertFalse(LNotification.Executed);
+  LNotification.Executed := True;
+  NotificationsListStr[NotificationsIndex] := LNotification;
+  Inc(NotificationsIndex)
+end;
+
+procedure TTestCollections.NotifyTestObj(ASender: TObject; constref AItem: TObject; AAction: TCollectionNotification);
+var
+  LNotification: TNotificationRec_TObject;
+begin
+  AssertTrue(NotificationsIndex < NotificationsListObj.Count);
+  LNotification := NotificationsListObj[NotificationsIndex];
+  AssertTrue(ASender = LNotification.Sender);
+  AssertTrue(AItem = LNotification.Item);
+  AssertTrue(AAction = LNotification.Action);
+  AssertFalse(LNotification.Executed);
+  LNotification.Executed := True;
+  NotificationsListObj[NotificationsIndex] := LNotification;
+  Inc(NotificationsIndex)
+end;
+
+procedure TTestCollections.CreateObjects(var AArray: TArray<TObject>; ACount: Integer);
+var
+  i: Integer;
+begin
+  SetLength(AArray, ACount);
+  for i := 0 to ACount - 1 do
+    AArray[i] := TObject.Create;
+end;
+
+procedure TTestCollections.FreeObjects(AArray: TArray<TObject>);
+var
+  o: TObject;
+begin
+  for o in AArray do
+    o.Free;
+end;
+
+constructor TTestCollections.Create;
+begin
+  inherited;
+  NotificationsListStr := TList<TNotificationRec_String>.Create;
+  NotificationsListObj := TList<TNotificationRec_TObject>.Create;
+  NotificationsListNode_String := TList<TNotificationNodeRec_String>.Create;
+  NotificationsListNode_Empty := TList<TNotificationNodeRec_Empty>.Create;
+end;
+
+destructor TTestCollections.Destroy;
+begin
+  NotificationsListNode_Empty.Free;
+  NotificationsListNode_String.Free;
+  NotificationsListObj.Free;
+  NotificationsListStr.Free;
+  inherited;
+end;
+
+{ TStringsEnumerable }
+
+function TStringsEnumerable.GetEnumerator: IEnumerator<string>;
+begin
+  Result := TStringsEnumerator.Create(FEnumerable.GetEnumerator, FEnumerable);
+end;
+
+constructor TStringsEnumerable.Create(const AItems: array of string);
+begin
+  FEnumerable := TStringList.Create;
+  FEnumerable.AddRange(AItems);
+end;
+
+{ TStringsEnumerator }
+
+function TStringsEnumerator.GetCurrent: string;
+begin
+  Result := FEnumerator.Current;
+end;
+
+function TStringsEnumerator.MoveNext: Boolean;
+begin
+  Result := FEnumerator.MoveNext;
+end;
+
+procedure TStringsEnumerator.Reset;
+begin
+  FEnumerator.Free;
+  FEnumerator := FCollection.GetEnumerator;
+end;
+
+constructor TStringsEnumerator.Create(AEnumerator: TStringList.TEnumerator; ACollection: TStringList);
+begin
+  FEnumerator := AEnumerator;
+  FCollection := ACollection;
+end;
+
+destructor TStringsEnumerator.Destroy;
+begin
+  FEnumerator.Free;
+  inherited Destroy;
+end;
+
+{ TObjectEnumerable }
+
+function TObjectEnumerable.GetEnumerator: IEnumerator<TObject>;
+begin
+  Result := TObjectEnumerator.Create(FEnumerable.GetEnumerator, FEnumerable);
+end;
+
+constructor TObjectEnumerable.Create(const AItems: array of TObject);
+begin
+  FEnumerable := TObjectList.Create;
+  FEnumerable.AddRange(AItems);
+end;
+
+{ TObjectEnumerator }
+
+function TObjectEnumerator.GetCurrent: TObject;
+begin
+  Result := FEnumerator.Current;
+end;
+
+function TObjectEnumerator.MoveNext: Boolean;
+begin
+  Result := FEnumerator.MoveNext;
+end;
+
+procedure TObjectEnumerator.Reset;
+begin
+  FEnumerator.Free;
+  FEnumerator := FCollection.GetEnumerator;
+end;
+
+constructor TObjectEnumerator.Create(AEnumerator: TObjectList.TEnumerator; ACollection: TObjectList);
+begin
+  FEnumerator := AEnumerator;
+  FCollection := ACollection;
+end;
+
+destructor TObjectEnumerator.Destroy;
+begin
+  FEnumerator.Free;
+  inherited Destroy;
+end;
+
+end.
+