paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 12:05:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@35610 -
This commit is contained in:
maciej-izak 2017-03-16 21:01:14 +00:00
parent cc5027cd75
commit 154216788e
2 changed files with 39 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
packages/rtl-generics/src/inc/generics.dictionaries.inc
View File

@ -802,23 +802,53 @@ begin
end; end;
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; constref AKey: TKey; out AHash: UInt32): SizeInt;
var var
LItem: {TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.}_TItem; // for workaround Lazarus bug #25613 LItem: {TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.}_TItem; // for workaround Lazarus bug #25613
LLengthMask: SizeInt; i: SizeInt;
i, m: SizeInt;
LHash: UInt32; LHash: UInt32;
begin begin
m := Length(AItems);
LLengthMask := m - 1;
LHash := FEqualityComparer.GetHashCode(AKey); LHash := FEqualityComparer.GetHashCode(AKey);
i := 0; i := 0;
AHash := LHash or UInt32.GetSignMask; AHash := LHash or UInt32.GetSignMask;
if m = 0 then 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 Length(AItems) = 0 then
Exit(-1); Exit(-1);
for i := 0 to FPrimaryNumberAsSizeApproximation - 1 do for i := 0 to FPrimaryNumberAsSizeApproximation - 1 do

2
packages/rtl-generics/src/inc/generics.dictionariesh.inc
View File

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