* Add comparer version of dictionary

packages/rtl/generics.collections.pas

@@ -362,6 +362,8 @@ type
   TDictionary<TKey,TValue> = class(TEnumerable<TPair<TKey,TValue>>)
   private
     FMap: TJSMap;
+    FComparer: IComparer<TKey>;
+    function GetEffectiveKey(Key : TKey) : TKey;
     function GetItem(const Key: TKey): TValue;
     procedure SetItem(const Key: TKey; const Value: TValue);
     procedure DoAdd(const Key: TKey; const Value: TValue);
@@ -380,6 +382,7 @@ type
 
     constructor Create(ACapacity: Integer=0); overload;
     constructor Create(const Collection: TEnumerable<TMyPair>); overload;
+    constructor Create(const AComparer: IComparer<TKey>); overload;
     destructor Destroy; override;
 
     procedure Add(const Key: TKey; const Value: TValue);
@@ -1191,13 +1194,35 @@ ResourceString
   SErrDictKeyNotFound = 'Key value not found';
   SErrDictDuplicateKey = 'Duplicate key value';
 
+function TDictionary<TKey, TValue>.GetEffectiveKey(Key: TKey): TKey;
+
+Var
+  it : TJSIterator;
+  v : TJSIteratorValue;
+  vv : JSValue;
+
+begin
+  if Not assigned(FComparer) then
+    Exit(key);
+  it:=FMap.Keys;
+  v:=it.next;
+  While not v.Done do
+    begin
+    Result:=TKey(v.Value);
+    if FComparer.Compare(Result,Key)=0 then
+      exit;
+    v:=it.Next;
+    end;
+  Result:=Key;
+end;
+
 function TDictionary<TKey, TValue>.GetItem(const Key: TKey): TValue;
 
 Var
   V : JSValue;
 
 begin
-  V:=FMap.Get(Key);
+  v:=FMap.Get(GetEffectiveKey(Key));
   if isUndefined(v) then
     Raise EDictionary.Create(SErrDictKeyNotFound);
   Result:=TValue(V);
@@ -1209,7 +1234,7 @@ Var
   V : JSValue;
 
 begin
-  V:=FMap.Get(Key);
+  v:=FMap.Get(GetEffectiveKey(Key));
   if Not isUndefined(v) then
     ValueNotify(TValue(V),cnRemoved);
   FMap.&Set(Key,Value);
@@ -1217,8 +1242,10 @@ begin
 end;
 
 procedure TDictionary<TKey, TValue>.DoAdd(const Key: TKey; const Value: TValue);
+Var
+  k : Tkey;
 begin
-  FMap.&Set(Key,Value);
+  FMap.&Set(GetEffectiveKey(Key),Value);
   KeyNotify(Key,cnAdded);
   ValueNotify(Value,cnAdded);
 end;
@@ -1227,12 +1254,14 @@ end;
 function TDictionary<TKey, TValue>.DoRemove(const Key: TKey; Notification: TCollectionNotification): TValue;
 Var
   V : JSValue;
+  K : TKey;
 
 begin
-  V:=FMap.Get(Key);
+  K:=GetEffectiveKey(Key);
+  V:=FMap.Get(k);
   if Not isUndefined(v) then
     begin
-    FMap.Delete(Key);
+    FMap.Delete(k);
     Result:=TValue(v);
     KeyNotify(Key,Notification);
     ValueNotify(Result,Notification);
@@ -1244,7 +1273,8 @@ begin
   Result:=FMap.Size;
 end;
 
-function TDictionary<TKey, TValue>.DoGetEnumerator: TEnumerator<TMyPair>;
+function TDictionary<TKey, TValue>.DoGetEnumerator: TEnumerator<TPair<TKey,
+  TValue>>;
 begin
   Result:=TPairEnumerator.Create(Self);
 end;
@@ -1285,6 +1315,12 @@ begin
     Add(aPair.Key,aPair.Value);
 end;
 
+constructor TDictionary<TKey, TValue>.Create(const AComparer: IComparer<TKey>);
+begin
+  Create(0);
+  FComparer:=aComparer;
+end;
+
 destructor TDictionary<TKey, TValue>.Destroy;
 begin
   FreeAndNil(FKeyCollection);
@@ -1296,7 +1332,7 @@ end;
 
 procedure TDictionary<TKey, TValue>.Add(const Key: TKey; const Value: TValue);
 begin
-  if FMap.Has(Key) then
+  if FMap.Has(GetEffectiveKey(Key)) then
     Raise EDictionary.Create(SErrDictDuplicateKey);
   DoAdd(Key,Value);
 end;
@@ -1308,18 +1344,22 @@ end;
 
 function TDictionary<TKey, TValue>.ExtractPair(const Key: TKey): TMyPair;
 
+Var
+  K : TKey;
+
 begin
   Result:=Default(TMyPair);
-  if FMap.Has(Key) then
+  K:=GetEffectiveKey(Key);
+  if FMap.Has(K) then
     begin
-    Result.Create(Key,TValue(FMap.get(key)));
-    FMap.Delete(Key);
+    Result.Create(Key,TValue(FMap.get(K)));
+    FMap.Delete(k);
     end
   else
     Result.Create(Key,Default(TValue));
 end;
 
-Function TDictionary<TKey, TValue>.CanClearMap : Boolean;
+function TDictionary<TKey, TValue>.CanClearMap: Boolean;
 
 begin
   Result:=(FOnKeyNotify=Nil) and (FOnValueNotify=Nil);
@@ -1356,23 +1396,33 @@ end;
 
 
 function TDictionary<TKey, TValue>.TryGetValue(const Key: TKey; out Value: TValue): Boolean;
+
+Var
+  K : TKey;
 begin
-  Result:=FMap.Has(Key);
+  K:=GetEffectiveKey(Key);
+  Result:=FMap.Has(K);
   If Result then
-    Value:=TValue(FMap.get(Key));
+    Value:=TValue(FMap.get(K));
 end;
 
+
 procedure TDictionary<TKey, TValue>.AddOrSetValue(const Key: TKey; const Value: TValue);
+
+Var
+  k : TKey;
+
 begin
-  if Not FMap.Has(Key) then
+  K:=GetEffectiveKey(Key);
+  if Not FMap.Has(k) then
     DoAdd(Key,Value)
   else
-    SetItem(Key,Value);
+    SetItem(K,Value);
 end;
 
 function TDictionary<TKey, TValue>.ContainsKey(const Key: TKey): Boolean;
 begin
-  Result:=FMap.Has(Key);
+  Result:=FMap.Has(GetEffectiveKey(Key));
 end;
 
 function TDictionary<TKey, TValue>.ContainsValue(const Value: TValue): Boolean;

test/tcgenericdictionary.pp

@@ -110,8 +110,102 @@ Type
     Procedure TestNoFreeOnRemove;
   end;
 
+  TMyStringDict = Class(Specialize TDictionary<string,string>);
+  TMyStringComparer = Specialize TComparer<string>;
+
+  { TTestComparerDictionary }
+
+  TTestComparerDictionary = Class(TTestCase)
+  private
+    FDict: TMyStringDict;
+  public
+    Procedure Setup; override;
+    Procedure TearDown; override;
+    Procedure FillDict;
+    Property Dict : TMyStringDict Read FDict;
+  Published
+    Procedure TestHasKey;
+    Procedure TestTryGetValue;
+    Procedure TestAddOrSet;
+    Procedure TestRemove;
+  end;
+
 implementation
 
+{ TTestComparerDictionary }
+
+procedure TTestComparerDictionary.Setup;
+begin
+  inherited Setup;
+  FDict:=TMyStringDict.Create(TMyStringComparer.Construct(function (Const a,b : String) : integer
+    begin
+      Result:=CompareText(a,b);
+      // writeln('Comparing ',a,' and ',b,' result: ',Result);
+    end
+    ));
+  FillDict;
+end;
+
+procedure TTestComparerDictionary.TearDown;
+begin
+  FreeAndNil(FDict);
+  inherited TearDown;
+end;
+
+procedure TTestComparerDictionary.FillDict;
+begin
+  With Dict do
+    begin
+    add('a','A');
+    add('B','b');
+    add('c','C');
+    end;
+end;
+
+procedure TTestComparerDictionary.TestHasKey;
+begin
+  AssertTrue('ContainsKey A',Dict.ContainsKey('A'));
+  AssertTrue('ContainsKey b',Dict.ContainsKey('b'));
+  AssertTrue('ContainsKey c',Dict.ContainsKey('c'));
+  AssertFalse('ContainsKey D',Dict.ContainsKey('D'));
+end;
+
+procedure TTestComparerDictionary.TestTryGetValue;
+
+Var
+  S : String;
+
+begin
+  AssertTrue('A',Dict.TryGetValue('A',S));
+  AssertEquals('Value A','A',S);
+  AssertTrue('b',Dict.TryGetValue('b',S));
+  AssertEquals('Value b','b',S);
+  AssertTrue('c',Dict.TryGetValue('c',S));
+  AssertEquals('Value C','C',S);
+  AssertFalse('d',Dict.TryGetValue('D',S));
+end;
+
+procedure TTestComparerDictionary.TestAddOrSet;
+
+Var
+  S : String;
+
+begin
+  Dict.AddOrSetValue('d','E');
+  AssertTrue('d',Dict.TryGetValue('d',S));
+  AssertEquals('Value d','E',S);
+  Dict.AddOrSetValue('D','D');
+  AssertTrue('D',Dict.TryGetValue('D',S));
+  AssertEquals('Value D','D',S);
+end;
+
+procedure TTestComparerDictionary.TestRemove;
+begin
+  Dict.Remove('C');
+  AssertFalse('ContainsKey C',Dict.ContainsKey('C'));
+  AssertFalse('ContainsKey c',Dict.ContainsKey('c'));
+end;
+
 { TTestSingleObjectDict }
 
 procedure TTestSingleObjectDict.SetUp;
@@ -668,8 +762,9 @@ begin
 end;
 
 begin
-  RegisterTests([TTestSimpleDictionary,
+  RegisterTests([{TTestSimpleDictionary,
                  TTestSingleObjectDict,
-                 TTestDualObjectDict]);
+                 TTestDualObjectDict,}
+                 TTestComparerDictionary]);
 end.