From 3447dcfaa68370206747b622912b037ef7802e06 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 14 Apr 2021 11:34:05 +0000 Subject: [PATCH] * Merging revisions 1147 from trunk: ------------------------------------------------------------------------ r1147 | michael | 2021-04-14 12:38:27 +0200 (Wed, 14 Apr 2021) | 1 line * Add comparer version of dictionary ------------------------------------------------------------------------ --- packages/rtl/generics.collections.pas | 82 +++++++++++++++++----- test/tcgenericdictionary.pp | 99 ++++++++++++++++++++++++++- 2 files changed, 163 insertions(+), 18 deletions(-) diff --git a/packages/rtl/generics.collections.pas b/packages/rtl/generics.collections.pas index 9c1ca07..6787ced 100644 --- a/packages/rtl/generics.collections.pas +++ b/packages/rtl/generics.collections.pas @@ -362,6 +362,8 @@ type TDictionary = class(TEnumerable>) private FMap: TJSMap; + FComparer: IComparer; + 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); overload; + constructor Create(const AComparer: IComparer); 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.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.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.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.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.DoGetEnumerator: TEnumerator; +function TDictionary.DoGetEnumerator: TEnumerator>; begin Result:=TPairEnumerator.Create(Self); end; @@ -1284,6 +1314,12 @@ begin Add(aPair.Key,aPair.Value); end; +constructor TDictionary.Create(const AComparer: IComparer); +begin + Create(0); + FComparer:=aComparer; +end; + destructor TDictionary.Destroy; begin FreeAndNil(FKeyCollection); @@ -1295,7 +1331,7 @@ end; procedure TDictionary.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; @@ -1307,18 +1343,22 @@ end; function TDictionary.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.CanClearMap : Boolean; +function TDictionary.CanClearMap: Boolean; begin Result:=(FOnKeyNotify=Nil) and (FOnValueNotify=Nil); @@ -1355,23 +1395,33 @@ end; function TDictionary.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.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.ContainsKey(const Key: TKey): Boolean; begin - Result:=FMap.Has(Key); + Result:=FMap.Has(GetEffectiveKey(Key)); end; function TDictionary.ContainsValue(const Value: TValue): Boolean; diff --git a/test/tcgenericdictionary.pp b/test/tcgenericdictionary.pp index 44abc9f..3d06b6b 100644 --- a/test/tcgenericdictionary.pp +++ b/test/tcgenericdictionary.pp @@ -110,8 +110,102 @@ Type Procedure TestNoFreeOnRemove; end; + TMyStringDict = Class(Specialize TDictionary); + TMyStringComparer = Specialize TComparer; + + { 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.