paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 09:19:39 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fix for Mantis #35919: apply patch by Maciej Izak

Browse Source 
git-svn-id: trunk@42557 -
This commit is contained in:
svenbarth 2019-08-02 13:16:09 +00:00
parent e8a7661bcf
commit 50fec47b9a
2 changed files with 46 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
packages/rtl-generics/src/generics.collections.pas
View File

@ -679,7 +679,10 @@ type
procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); inline; procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); inline;
procedure NodeNotify(ANode: PNode; ACollectionNotification: TCollectionNotification; ADispose: boolean); inline; procedure NodeNotify(ANode: PNode; ACollectionNotification: TCollectionNotification; ADispose: boolean); inline;
procedure SetValue(var AValue: TValue; constref ANewValue: TValue); procedure SetValue(var AValue: TValue; constref ANewValue: TValue);
function GetItem(const AKey: TKey): TValue;
procedure SetItem(const AKey: TKey; const AValue: TValue);
property Items[Index: TKey]: TValue read GetItem write SetItem;
// for reporting // for reporting
procedure WriteStr(AStream: TStream; const AText: string); procedure WriteStr(AStream: TStream; const AText: string);
public type public type
@ -782,6 +785,8 @@ type
end; end;
TAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, TEmptyRecord>) TAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, TEmptyRecord>)
public
property Items; default;
end; end;
TIndexedAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, SizeInt>) TIndexedAVLTreeMap<TKey, TValue> = class(TCustomAVLTreeMap<TKey, TValue, SizeInt>)
@ -808,6 +813,7 @@ type
protected protected
property OnKeyNotify; property OnKeyNotify;
property OnValueNotify; property OnValueNotify;
property Items;
public type public type
TItemEnumerator = TKeyEnumerator; TItemEnumerator = TKeyEnumerator;
public public
@ -3319,6 +3325,21 @@ begin
Result := TValueCollection(FValues); Result := TValueCollection(FValues);
end; end;
function TCustomAVLTreeMap<TREE_CONSTRAINTS>.GetItem(const AKey: TKey): TValue;
var
LNode: PNode;
begin
LNode := Find(AKey);
if not Assigned(LNode) then
raise EAVLTree.CreateRes(@SDictionaryKeyDoesNotExist);
result := LNode.Value;
end;
procedure TCustomAVLTreeMap<TREE_CONSTRAINTS>.SetItem(const AKey: TKey; const AValue: TValue);
begin
Find(AKey).Value := AValue;
end;
constructor TCustomAVLTreeMap<TREE_CONSTRAINTS>.Create; constructor TCustomAVLTreeMap<TREE_CONSTRAINTS>.Create;
begin begin
FComparer := TComparer<TKey>.Default; FComparer := TComparer<TKey>.Default;

25
packages/rtl-generics/tests/tests.generics.trees.pas
View File

@ -42,6 +42,7 @@ type
procedure Test_IndexedAVLTree_Add_General; procedure Test_IndexedAVLTree_Add_General;
procedure Test_IndexedAVLTree_Add; procedure Test_IndexedAVLTree_Add;
procedure Test_IndexedAVLTree_Delete; procedure Test_IndexedAVLTree_Delete;
procedure Test_IndexedAVLTree_Items;
procedure Test_TAVLTreeMap_Notification; procedure Test_TAVLTreeMap_Notification;
end; end;
@ -50,6 +51,7 @@ implementation
type type
TStringsTree = TIndexedAVLTree<string>; TStringsTree = TIndexedAVLTree<string>;
TMapTree = TAVLTreeMap<string, Integer>;
{ TTestTrees } { TTestTrees }
@ -138,6 +140,29 @@ begin
end; end;
end; end;
procedure TTestTrees.Test_IndexedAVLTree_Items;
var
LTree: TMapTree;
begin
LTree := TMapTree.Create;
try
Check(LTree.Add('A', 1)<>nil);
Check(LTree.Add('B', 2)<>nil);
Check(LTree.Add('C', 3)<>nil);
CheckEquals(LTree.Items['A'], 1);
CheckEquals(LTree.Items['B'], 2);
CheckEquals(LTree.Items['C'], 3);
LTree.Items['A'] := 4;
LTree.Items['B'] := 5;
LTree.Items['C'] := 6;
CheckEquals(LTree.Items['A'], 4);
CheckEquals(LTree.Items['B'], 5);
CheckEquals(LTree.Items['C'], 6);
finally
LTree.Free;
end;
end;
procedure TTestTrees.Test_TAVLTreeMap_Notification; procedure TTestTrees.Test_TAVLTreeMap_Notification;
var var
LTree: TAVLTreeMap<string, string>; LTree: TAVLTreeMap<string, string>;