rtl-generics: Override TOpenAddressingQP<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndex for quadratic probing to omit infinite loop (for ContainsKey). Small refactoring for FindBucketIndexOrTombstone (no functional change).

git-svn-id: trunk@35610 -

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

@@ -802,23 +802,53 @@ begin
     end;
 end;
 
-function TOpenAddressingQP<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndexOrTombstone(constref AItems: TArray<TItem>;
+function TOpenAddressingQP<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndex(constref AItems: TArray<TItem>;
   constref AKey: TKey; out AHash: UInt32): SizeInt;
 var
   LItem: {TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.}_TItem; // for workaround Lazarus bug #25613
-  LLengthMask: SizeInt;
-  i, m: SizeInt;
+  i: SizeInt;
   LHash: UInt32;
 begin
-  m := Length(AItems);
-  LLengthMask := m - 1;
+  LHash := FEqualityComparer.GetHashCode(AKey);
+
+  i := 0;
+  AHash := LHash or UInt32.GetSignMask;
 
+  if Length(AItems) = 0 then
+    Exit(-1);
+
+  for i := 0 to FPrimaryNumberAsSizeApproximation - 1 do
+  begin
+    Result := TProbeSequence.Probe(i, AHash) mod FPrimaryNumberAsSizeApproximation;
+    LItem := _TItem(AItems[Result]);
+
+    // Empty position
+    if LItem.Hash = 0 then
+      Exit(not Result); // insert!
+
+    // Same position?
+    if LItem.Hash = AHash then
+      if FEqualityComparer.Equals(AKey, LItem.Pair.Key) then
+        Exit;
+  end;
+
+  Result := -1;
+end;
+
+
+function TOpenAddressingQP<OPEN_ADDRESSING_CONSTRAINTS>.FindBucketIndexOrTombstone(constref AItems: TArray<TItem>;
+  constref AKey: TKey; out AHash: UInt32): SizeInt;
+var
+  LItem: {TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.}_TItem; // for workaround Lazarus bug #25613
+  i: SizeInt;
+  LHash: UInt32;
+begin
   LHash := FEqualityComparer.GetHashCode(AKey);
 
   i := 0;
   AHash := LHash or UInt32.GetSignMask;
 
-  if m = 0 then
+  if Length(AItems) = 0 then
     Exit(-1);
 
   for i := 0 to FPrimaryNumberAsSizeApproximation - 1 do

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

@@ -272,6 +272,8 @@ type
     FPrimaryNumberAsSizeApproximation: SizeInt;
   protected
     procedure UpdateItemsThreshold(ASize: SizeInt); override;
+    function FindBucketIndex(constref AItems: TArray<TItem>;
+      constref AKey: TKey; out AHash: UInt32): SizeInt; override; overload;
     function FindBucketIndexOrTombstone(constref AItems: TArray<TItem>;
       constref AKey: TKey; out AHash: UInt32): SizeInt; override;
   end;