Browse Source

* Initial TDictionary implementation

michael 5 years ago
parent
commit
f34c0a891f
2 changed files with 302 additions and 11 deletions
  1. 40 10
      packages/rtl/generics.collections.pas
  2. 262 1
      test/tcgenericdictionary.pp

+ 40 - 10
packages/rtl/generics.collections.pas

@@ -220,6 +220,7 @@ type
     function DoRemove(const Key: TKey; Notification: TCollectionNotification): TValue;
     function DoRemove(const Key: TKey; Notification: TCollectionNotification): TValue;
     Function GetCount : Integer;
     Function GetCount : Integer;
   protected
   protected
+    Function CanClearMap : Boolean; virtual;
     function DoGetEnumerator: TEnumerator<TPair<TKey,TValue>>; override;
     function DoGetEnumerator: TEnumerator<TPair<TKey,TValue>>; override;
     procedure PairNotify(const Key: TKey; Value : TValue; Action: TCollectionNotification); virtual;
     procedure PairNotify(const Key: TKey; Value : TValue; Action: TCollectionNotification); virtual;
     procedure KeyNotify(const Key: TKey; Action: TCollectionNotification); virtual;
     procedure KeyNotify(const Key: TKey; Action: TCollectionNotification); virtual;
@@ -275,7 +276,7 @@ type
         function DoMoveNext: Boolean; override;
         function DoMoveNext: Boolean; override;
       public
       public
         constructor Create(const AIter: TJSIterator); overload;
         constructor Create(const AIter: TJSIterator); overload;
-        constructor Create(const ADictionary: TMyType); overload;
+        constructor Create2(const ADictionary: TMyType); overload;
         function MoveNext: Boolean; reintroduce;
         function MoveNext: Boolean; reintroduce;
         property Current: TKey read GetCurrent;
         property Current: TKey read GetCurrent;
       end;
       end;
@@ -292,7 +293,7 @@ type
         function DoMoveNext: Boolean; override;
         function DoMoveNext: Boolean; override;
       public
       public
         constructor Create(const AIter: TJSIterator); overload;
         constructor Create(const AIter: TJSIterator); overload;
-        constructor Create(const ADictionary: TMyType); overload;
+        constructor Create2(const ADictionary: TMyType); overload;
         function MoveNext: Boolean; reintroduce;
         function MoveNext: Boolean; reintroduce;
         property Current: TValue read GetCurrent;
         property Current: TValue read GetCurrent;
       end;
       end;
@@ -1042,7 +1043,7 @@ Var
 
 
 begin
 begin
   V:=FMap.Get(Key);
   V:=FMap.Get(Key);
-  if isUndefined(v) then
+  if Not isUndefined(v) then
     ValueNotify(TValue(V),cnRemoved);
     ValueNotify(TValue(V),cnRemoved);
   FMap.&Set(Key,Value);
   FMap.&Set(Key,Value);
   ValueNotify(Value, cnAdded);
   ValueNotify(Value, cnAdded);
@@ -1102,7 +1103,6 @@ end;
 
 
 constructor TDictionary<TKey, TValue>.Create(ACapacity: Integer = 0);
 constructor TDictionary<TKey, TValue>.Create(ACapacity: Integer = 0);
 begin
 begin
-
   FMap:=TJSMap.New;
   FMap:=TJSMap.New;
 end;
 end;
 
 
@@ -1150,9 +1150,39 @@ begin
     Result.Create(Key,Default(TValue));
     Result.Create(Key,Default(TValue));
 end;
 end;
 
 
+Function TDictionary<TKey, TValue>.CanClearMap : Boolean;
+
+begin
+  Result:=(FOnKeyNotify=Nil) and (FOnValueNotify=Nil);
+end;
+
 procedure TDictionary<TKey, TValue>.Clear;
 procedure TDictionary<TKey, TValue>.Clear;
+
+Var
+  Iter : TJSIterator;
+  IVal : TJSIteratorValue;
+  A : TJSValueDynArray;
+  K : TKey;
+  V : TValue;
+
 begin
 begin
-  FMap.Clear;
+  if CanClearMap then
+    Fmap.Clear
+  else
+    begin
+    Iter:=FMap.Entries;
+    Repeat
+      IVal:=Iter.next;
+      if not ival.Done then
+        begin
+        A:=TJSValueDynArray(IVal.Value);
+        K:=TKey(A[0]);
+        V:=TValue(A[1]);
+        FMap.delete(k);
+        PairNotify(K,V,cnRemoved);
+        end;
+    Until Ival.Done;
+    end;
 end;
 end;
 
 
 
 
@@ -1235,7 +1265,7 @@ end;
 
 
 function TDictionary<TKey, TValue>.TPairEnumerator.DoMoveNext: Boolean;
 function TDictionary<TKey, TValue>.TPairEnumerator.DoMoveNext: Boolean;
 begin
 begin
-  FIter.Next;
+  FVal:=FIter.Next;
   Result:=Not FVal.Done;
   Result:=Not FVal.Done;
 end;
 end;
 
 
@@ -1263,11 +1293,11 @@ end;
 
 
 function TDictionary<TKey, TValue>.TKeyEnumerator.DoMoveNext: Boolean;
 function TDictionary<TKey, TValue>.TKeyEnumerator.DoMoveNext: Boolean;
 begin
 begin
-  FIter.Next;
+  FVal:=FIter.Next;
   Result:=Not FVal.Done;
   Result:=Not FVal.Done;
 end;
 end;
 
 
-constructor TDictionary<TKey, TValue>.TKeyEnumerator.Create(const ADictionary: TMyType);
+constructor TDictionary<TKey, TValue>.TKeyEnumerator.Create2(const ADictionary: TMyType);
 begin
 begin
   Create(ADictionary.FMap.Keys);
   Create(ADictionary.FMap.Keys);
 end;
 end;
@@ -1296,11 +1326,11 @@ end;
 
 
 function TDictionary<TKey, TValue>.TValueEnumerator.DoMoveNext: Boolean;
 function TDictionary<TKey, TValue>.TValueEnumerator.DoMoveNext: Boolean;
 begin
 begin
-  FIter.Next;
+  FVal:=FIter.Next;
   Result:=Not FVal.Done;
   Result:=Not FVal.Done;
 end;
 end;
 
 
-constructor TDictionary<TKey, TValue>.TValueEnumerator.Create(const ADictionary: TMyType);
+constructor TDictionary<TKey, TValue>.TValueEnumerator.Create2(const ADictionary: TMyType);
 begin
 begin
   Create(aDictionary.FMap.Values);
   Create(aDictionary.FMap.Values);
 end;
 end;

+ 262 - 1
test/tcgenericdictionary.pp

@@ -9,16 +9,32 @@ uses
 
 
 Type
 Type
   TMySimpleDict = Class(Specialize TDictionary<Integer,String>);
   TMySimpleDict = Class(Specialize TDictionary<Integer,String>);
-
+{$IFDEF FPC}
+  EDictionary = EListError;
+  TMyPair = specialize TPair<Integer,String>;
+{$ENDIF}
   { TTestSimpleDictionary }
   { TTestSimpleDictionary }
 
 
   TTestSimpleDictionary = Class(TTestCase)
   TTestSimpleDictionary = Class(TTestCase)
   Private
   Private
     FDict : TMySimpleDict;
     FDict : TMySimpleDict;
+    FnotifyMessage : String;
+    FCurrentKeyNotify : Integer;
+    FCurrentValueNotify : Integer;
+    FExpectKeys : Array of Integer;
+    FExpectValues : Array of String;
+    FExpectValueAction,
+    FExpectKeyAction: Array of TCollectionNotification;
     procedure DoAdd(aCount: Integer; aOffset: Integer=0);
     procedure DoAdd(aCount: Integer; aOffset: Integer=0);
     procedure DoAdd2;
     procedure DoAdd2;
+    Procedure DoneExpectKeys;
+    Procedure DoneExpectValues;
     procedure DoGetValue(aKey: Integer; Match: String; ExceptionClass: TClass=nil);
     procedure DoGetValue(aKey: Integer; Match: String; ExceptionClass: TClass=nil);
+    procedure DoKeyNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: Integer; AAction: TCollectionNotification);
+    procedure DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
   Public
   Public
+    Procedure SetExpectKeys(aMessage : string; AKeys : Array of Integer; AActions : Array of TCollectionNotification; DoReverse : Boolean = False);
+    Procedure SetExpectValues(aMessage : string; AKeys : Array of String; AActions : Array of TCollectionNotification; DoReverse : Boolean = False);
     Procedure SetUp; override;
     Procedure SetUp; override;
     Procedure TearDown; override;
     Procedure TearDown; override;
     Property Dict : TMySimpleDict Read FDict;
     Property Dict : TMySimpleDict Read FDict;
@@ -32,7 +48,17 @@ Type
     Procedure TestAddDuplicate;
     Procedure TestAddDuplicate;
     Procedure TestAddOrSet;
     Procedure TestAddOrSet;
     Procedure TestContainsKey;
     Procedure TestContainsKey;
+    Procedure TestContainsValue;
     Procedure TestDelete;
     Procedure TestDelete;
+    Procedure TestToArray;
+    procedure TestKeys;
+    Procedure TestValues;
+    Procedure TestEnumerator;
+    Procedure TestNotification;
+    procedure TestNotificationDelete;
+    procedure TestValueNotification;
+    procedure TestValueNotificationDelete;
+    procedure TestKeyValueNotificationSet;
   end;
   end;
 
 
 implementation
 implementation
@@ -43,10 +69,19 @@ procedure TTestSimpleDictionary.SetUp;
 begin
 begin
   inherited SetUp;
   inherited SetUp;
   FDict:=TMySimpleDict.Create;
   FDict:=TMySimpleDict.Create;
+  FCurrentKeyNotify:=0;
+  FCurrentValueNotify:=0;
+  FExpectKeys:=[];
+  FExpectKeyAction:=[];
+  FExpectValues:=[];
+  FExpectValueAction:=[];
 end;
 end;
 
 
 procedure TTestSimpleDictionary.TearDown;
 procedure TTestSimpleDictionary.TearDown;
 begin
 begin
+  // So we don't get clear messages
+  FDict.OnKeyNotify:=Nil;
+  FDict.OnValueNotify:=Nil;
   FreeAndNil(FDict);
   FreeAndNil(FDict);
   inherited TearDown;
   inherited TearDown;
 end;
 end;
@@ -137,6 +172,81 @@ begin
     end;
     end;
 end;
 end;
 
 
+procedure TTestSimpleDictionary.DoKeyNotify(ASender: TObject;  {$ifdef fpc}constref{$else}const{$endif}  AItem: Integer; AAction: TCollectionNotification);
+begin
+  Writeln(FnotifyMessage+' Notification',FCurrentKeyNotify);
+  AssertSame(FnotifyMessage+' Correct sender', FDict,aSender);
+  if (FCurrentKeyNotify>=Length(FExpectKeys)) then
+    Fail(FnotifyMessage+' Too many notificiations');
+  AssertEquals(FnotifyMessage+' Notification Key no '+IntToStr(FCurrentKeyNotify),FExpectKeys[FCurrentKeyNotify],aItem);
+  Inc(FCurrentKeyNotify);
+end;
+
+procedure TTestSimpleDictionary.DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
+begin
+  Writeln(FnotifyMessage+' value Notification',FCurrentValueNotify);
+  AssertSame(FnotifyMessage+' value Correct sender', FDict,aSender);
+  if (FCurrentValueNotify>=Length(FExpectValues)) then
+    Fail(FnotifyMessage+' Too many value notificiations');
+  AssertEquals(FnotifyMessage+' Notification value no '+IntToStr(FCurrentValueNotify),FExpectValues[FCurrentValueNotify],aItem);
+  Inc(FCurrentValueNotify);
+end;
+
+procedure TTestSimpleDictionary.SetExpectKeys(aMessage: string; AKeys: array of Integer;
+  AActions: array of TCollectionNotification; DoReverse: Boolean = False);
+
+Var
+  I,L : integer;
+
+begin
+  FnotifyMessage:=aMessage;
+  FCurrentKeyNotify:=0;
+  L:=Length(aKeys);
+  AssertEquals('SetExpectkeys: Lengths arrays equal',l,Length(aActions));
+  SetLength(FExpectKeys,L);
+  SetLength(FExpectKeyAction,L);
+  Dec(L);
+  if DoReverse then
+    For I:=0 to L do
+      begin
+      FExpectKeys[L-i]:=AKeys[i];
+      FExpectKeyAction[L-i]:=AActions[I];
+      end
+  else
+    For I:=0 to L do
+      begin
+      FExpectKeys[i]:=AKeys[i];
+      FExpectKeyAction[i]:=AActions[I];
+      end;
+end;
+
+procedure TTestSimpleDictionary.SetExpectValues(aMessage: string; AKeys: array of String;
+  AActions: array of TCollectionNotification; DoReverse: Boolean);
+Var
+  I,L : integer;
+
+begin
+  FnotifyMessage:=aMessage;
+  FCurrentValueNotify:=0;
+  L:=Length(aKeys);
+  AssertEquals('SetExpectValues: Lengths arrays equal',l,Length(aActions));
+  SetLength(FExpectValues,L);
+  SetLength(FExpectValueAction,L);
+  Dec(L);
+  if DoReverse then
+    For I:=0 to L do
+      begin
+      FExpectValues[L-i]:=AKeys[i];
+      FExpectValueAction[L-i]:=AActions[I];
+      end
+  else
+    For I:=0 to L do
+      begin
+      FExpectValues[i]:=AKeys[i];
+      FExpectValueAction[i]:=AActions[I];
+      end;
+end;
+
 procedure TTestSimpleDictionary.TestGetValue;
 procedure TTestSimpleDictionary.TestGetValue;
 
 
 Var
 Var
@@ -162,6 +272,16 @@ begin
   Dict.Add(2,'A new 2');
   Dict.Add(2,'A new 2');
 end;
 end;
 
 
+procedure TTestSimpleDictionary.DoneExpectKeys;
+begin
+  AssertEquals(FnotifyMessage+' Expected number of keys seen',Length(FExpectKeys),FCurrentKeyNotify);
+end;
+
+procedure TTestSimpleDictionary.DoneExpectValues;
+begin
+  AssertEquals(FnotifyMessage+' Expected number of values seen',Length(FExpectValues),FCurrentValueNotify);
+end;
+
 procedure TTestSimpleDictionary.TestAddDuplicate;
 procedure TTestSimpleDictionary.TestAddDuplicate;
 begin
 begin
   DoAdd(3);
   DoAdd(3);
@@ -188,7 +308,20 @@ begin
   AssertFalse('Has not 4',Dict.ContainsKey(4));
   AssertFalse('Has not 4',Dict.ContainsKey(4));
 end;
 end;
 
 
+procedure TTestSimpleDictionary.TestContainsValue;
+
+Var
+  I : Integer;
+
+begin
+  DoAdd(3);
+  For I:=1 to 3 do
+    AssertTrue('Has '+IntToStr(i),Dict.ContainsValue(IntToStr(i)));
+  AssertFalse('Has not 4',Dict.ContainsValue('4'));
+end;
+
 procedure TTestSimpleDictionary.TestDelete;
 procedure TTestSimpleDictionary.TestDelete;
+
 begin
 begin
   DoAdd(3);
   DoAdd(3);
   Dict.Remove(2);
   Dict.Remove(2);
@@ -196,6 +329,134 @@ begin
   AssertFalse('Has not 2',Dict.ContainsKey(2));
   AssertFalse('Has not 2',Dict.ContainsKey(2));
 end;
 end;
 
 
+procedure TTestSimpleDictionary.TestToArray;
+
+Var
+{$ifdef fpc}
+  A : specialize TArray<TMyPair>;
+{$else}
+  A : specialize TArray<TMySimpleDict.TMyPair>;
+{$endif}
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  A:=Dict.ToArray;
+  AssertEquals('Length Ok',3,Length(A));
+  For I:=1 to 3 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('key '+SI,I,A[i-1].Key);
+    AssertEquals('Value '+SI,SI,A[i-1].Value);
+    end;
+end;
+
+procedure TTestSimpleDictionary.TestKeys;
+
+Var
+  A : Array of Integer;
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  A:=Dict.Keys.ToArray;
+  AssertEquals('Length Ok',3,Length(A));
+  For I:=1 to 3 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('key '+SI,I,A[i-1]);
+    end;
+end;
+
+procedure TTestSimpleDictionary.TestValues;
+Var
+  A : Array of String;
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  A:=Dict.Values.ToArray;
+  AssertEquals('Length Ok',3,Length(A));
+  For I:=1 to 3 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('Value '+SI,SI,A[i-1]);
+    end;
+end;
+
+procedure TTestSimpleDictionary.TestEnumerator;
+
+Var
+{$ifdef fpc}
+  A : TMyPair;
+{$else}
+  A : TMySimpleDict.TMyPair;
+{$endif}
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  I:=1;
+  For A in Dict do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('key '+SI,I,A.Key);
+    AssertEquals('Value '+SI,SI,A.Value);
+    Inc(I);
+    end;
+end;
+
+procedure TTestSimpleDictionary.TestNotification;
+begin
+  Dict.OnKeyNotify:=@DoKeyNotify;
+  SetExpectKeys('Add',[1,2,3],[cnAdded,cnAdded,cnAdded]);
+  DoAdd(3);
+  DoneExpectKeys;
+end;
+
+procedure TTestSimpleDictionary.TestNotificationDelete;
+
+begin
+  DoAdd(3);
+  Dict.OnKeyNotify:=@DoKeyNotify;
+  SetExpectKeys('Clear',[1,2,3],[cnRemoved,cnRemoved,cnRemoved],{$IFDEF FPC}true{$ELSE}False{$endif});
+  Dict.Clear;
+  DoneExpectKeys;
+end;
+
+procedure TTestSimpleDictionary.TestValueNotification;
+begin
+  Dict.OnValueNotify:=@DoValueNotify;
+  SetExpectValues('Add',['1','2','3'],[cnAdded,cnAdded,cnAdded]);
+  DoAdd(3);
+  DoneExpectValues;
+end;
+
+procedure TTestSimpleDictionary.TestValueNotificationDelete;
+begin
+  DoAdd(3);
+  Dict.OnValueNotify:=@DoValueNotify;
+  SetExpectValues('Clear',['1','2','3'],[cnRemoved,cnRemoved,cnRemoved],{$IFDEF FPC}true{$ELSE}False{$endif});
+  Dict.Clear;
+  DoneExpectValues;
+end;
+
+procedure TTestSimpleDictionary.TestKeyValueNotificationSet;
+begin
+  DoAdd(3);
+  Dict.OnValueNotify:=@DoValueNotify;
+  Dict.OnKeyNotify:=@DoKeyNotify;
+  SetExpectValues('Set',['2','Six'],[cnRemoved,cnAdded]);
+  SetExpectKeys('Set',[],[]);
+  Dict[2]:='Six';
+  DoneExpectKeys;
+  DoneExpectValues;
+end;
+
 begin
 begin
   RegisterTest(TTestSimpleDictionary);
   RegisterTest(TTestSimpleDictionary);
 end.
 end.