From 663ee7bc2007a22c48f97927afd4086cc8e56490 Mon Sep 17 00:00:00 2001
From: "J. Gareth \"Curious Kit\" Moreton" <gareth@moreton-family.com>
Date: Fri, 9 Dec 2022 01:43:25 +0000
Subject: [PATCH]   * Fix to TObjectOpenAddressingLP in generics.collections
 where SetValue     would free the object if the current value is the same as
 the new value     (fixes #40024)

---
 .../rtl-generics/src/inc/generics.dictionaries.inc | 14 ++++++++++++++
 .../src/inc/generics.dictionariesh.inc             |  3 ++-
 2 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/packages/rtl-generics/src/inc/generics.dictionaries.inc b/packages/rtl-generics/src/inc/generics.dictionaries.inc
index 03c5e124ee..4af47bff4e 100644
--- a/packages/rtl-generics/src/inc/generics.dictionaries.inc
+++ b/packages/rtl-generics/src/inc/generics.dictionaries.inc
@@ -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
diff --git a/packages/rtl-generics/src/inc/generics.dictionariesh.inc b/packages/rtl-generics/src/inc/generics.dictionariesh.inc
index a3472aadd5..6c39c52c5f 100644
--- a/packages/rtl-generics/src/inc/generics.dictionariesh.inc
+++ b/packages/rtl-generics/src/inc/generics.dictionariesh.inc
@@ -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