paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-30 21:30:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Initial TDictionary implementation

Browse Source
This commit is contained in:
michael 2020-05-31 10:58:40 +00:00
parent 8bf4930531
commit f34c0a891f
2 changed files with 303 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
packages/rtl/generics.collections.pas
View File

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

263
test/tcgenericdictionary.pp
View File

@ -9,16 +9,32 @@ uses
Type
TMySimpleDict = Class(Specialize TDictionary<Integer,String>);
{$IFDEF FPC}
EDictionary = EListError;
TMyPair = specialize TPair<Integer,String>;
{$ENDIF}
{ TTestSimpleDictionary }
TTestSimpleDictionary = Class(TTestCase)
Private
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 DoAdd2;
Procedure DoneExpectKeys;
Procedure DoneExpectValues;
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
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 TearDown; override;
Property Dict : TMySimpleDict Read FDict;
@ -32,7 +48,17 @@ Type
Procedure TestAddDuplicate;
Procedure TestAddOrSet;
Procedure TestContainsKey;
Procedure TestContainsValue;
Procedure TestDelete;
Procedure TestToArray;
procedure TestKeys;
Procedure TestValues;
Procedure TestEnumerator;
Procedure TestNotification;
procedure TestNotificationDelete;
procedure TestValueNotification;
procedure TestValueNotificationDelete;
procedure TestKeyValueNotificationSet;
end;
implementation
@ -43,10 +69,19 @@ procedure TTestSimpleDictionary.SetUp;
begin
inherited SetUp;
FDict:=TMySimpleDict.Create;
FCurrentKeyNotify:=0;
FCurrentValueNotify:=0;
FExpectKeys:=[];
FExpectKeyAction:=[];
FExpectValues:=[];
FExpectValueAction:=[];
end;
procedure TTestSimpleDictionary.TearDown;
begin
// So we don't get clear messages
FDict.OnKeyNotify:=Nil;
FDict.OnValueNotify:=Nil;
FreeAndNil(FDict);
inherited TearDown;
end;
@ -137,6 +172,81 @@ begin
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;
Var
@ -162,6 +272,16 @@ begin
Dict.Add(2,'A new 2');
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;
begin
DoAdd(3);
@ -188,7 +308,20 @@ begin
AssertFalse('Has not 4',Dict.ContainsKey(4));
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;
begin
DoAdd(3);
Dict.Remove(2);
@ -196,6 +329,134 @@ begin
AssertFalse('Has not 2',Dict.ContainsKey(2));
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
RegisterTest(TTestSimpleDictionary);
end.