Răsfoiți Sursa

* fix for Mantis #37609: add support for TryAdd for the TDictionary<,> hierarchy
+ added testcase

git-svn-id: trunk@46839 -

svenbarth 4 ani în urmă
părinte
comite
6efd9cc93f

+ 9 - 0
packages/rtl-generics/src/inc/generics.dictionaries.inc

@@ -604,6 +604,15 @@ begin
     AValue := Default(TValue);
 end;
 
+function TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.TryAdd(constref AKey: TKey; constref AValue: TValue): Boolean;
+var
+  LHash: UInt32;
+begin
+  Result := FindBucketIndex(FItems, AKey, LHash) < 0;
+  if Result then
+    DoAdd(AKey, AValue);
+end;
+
 procedure TOpenAddressing<OPEN_ADDRESSING_CONSTRAINTS>.AddOrSetValue(constref AKey: TKey; constref AValue: TValue);
 var
   LIndex: SizeInt;

+ 1 - 0
packages/rtl-generics/src/inc/generics.dictionariesh.inc

@@ -262,6 +262,7 @@ type
     procedure Clear; override;
     procedure TrimExcess;
     function TryGetValue(constref AKey: TKey; out AValue: TValue): Boolean;
+    function TryAdd(constref AKey: TKey; constref AValue: TValue): Boolean;
     procedure AddOrSetValue(constref AKey: TKey; constref AValue: TValue);
     function ContainsKey(constref AKey: TKey): Boolean; inline;
     function ContainsValue(constref AValue: TValue): Boolean; overload;

+ 8 - 0
packages/rtl-generics/tests/tests.generics.dictionary.pas

@@ -47,6 +47,7 @@ Type
     Procedure TestSetValue;
     Procedure TestAddDuplicate;
     Procedure TestAddOrSet;
+    Procedure TestTryAdd;
     Procedure TestContainsKey;
     Procedure TestContainsValue;
     Procedure TestDelete;
@@ -296,6 +297,13 @@ begin
   DoGetValue(2,'a new 2');
 end;
 
+procedure TTestSimpleDictionary.TestTryAdd;
+begin
+  AssertTrue(Dict.TryAdd(1, 'Foobar'));
+  AssertFalse(Dict.TryAdd(1, 'Foo'));
+  AssertTrue(Dict.TryAdd(2, 'Bar'));
+end;
+
 procedure TTestSimpleDictionary.TestContainsKey;
 
 Var