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

* Fix to TObjectOpenAddressingLP in generics.collections where SetValue

Browse Source 
would free the object if the current value is the same as the new value
    (fixes #40024)
This commit is contained in:
J. Gareth "Curious Kit" Moreton 2022-12-09 01:43:25 +00:00
parent b787203db7
commit 663ee7bc20
2 changed files with 16 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
packages/rtl-generics/src/inc/generics.dictionaries.inc
View File

@ -2233,6 +2233,20 @@ begin
FOwnerships := AOwnerships;
end;
procedure TObjectOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.SetValue(var AValue: TValue; constref ANewValue: TValue);
var
LOldValue: TValue;
begin
if TObject((@AValue)^) <> TObject((@ANewValue)^) then
begin
LOldValue := AValue;
AValue := ANewValue;
ValueNotify(LOldValue, cnRemoved);
ValueNotify(ANewValue, cnAdded);
end;
end;
procedure TObjectOpenAddressingLP<OPEN_ADDRESSING_CONSTRAINTS>.KeyNotify(
constref AKey: TKey; ACollectionNotification: TCollectionNotification);
begin

3
packages/rtl-generics/src/inc/generics.dictionariesh.inc
View File

@ -98,7 +98,7 @@ type
procedure KeyNotify(constref AKey: TKey; ACollectionNotification: TCollectionNotification); virtual;
procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); virtual;
procedure PairNotify(constref APair: TDictionaryPair; ACollectionNotification: TCollectionNotification); inline;
procedure SetValue(var AValue: TValue; constref ANewValue: TValue);
procedure SetValue(var AValue: TValue; constref ANewValue: TValue); dynamic;
public
property OnKeyNotify: TCollectionNotifyEvent<TKey> read FOnKeyNotify write FOnKeyNotify;
property OnValueNotify: TCollectionNotifyEvent<TValue> read FOnValueNotify write FOnValueNotify;
@ -597,6 +597,7 @@ type
private
FOwnerships: TDictionaryOwnerships;
protected
procedure SetValue(var AValue: TValue; constref ANewValue: TValue); override;
procedure KeyNotify(constref AKey: TKey; ACollectionNotification: TCollectionNotification); override;
procedure ValueNotify(constref AValue: TValue; ACollectionNotification: TCollectionNotification); override;
public