From 0d415cb2353fbcf7d87b4118e32f8e3629ab4795 Mon Sep 17 00:00:00 2001
From: Martin <laz.git@mfriebe.de>
Date: Sun, 2 Apr 2023 20:33:48 +0200
Subject: [PATCH] LCL: Fix endless loop in ReleaseComponent (invoking itself
 via WM_NULL). Issue #40183 Change to only re-invoke ReleaseComponent if any
 component actually reached a ref-count of 0. If Components are re-added after
 a crash during destroying one of them, then they (may or may not) re-invoke
 immediately. But excluding the crashed one, so there is work to continue.

---
 lcl/forms.pp                |  1 +
 lcl/include/application.inc | 15 +++++++++++++--
 lcl/lclclasses.pp           |  5 +++++
 3 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/lcl/forms.pp b/lcl/forms.pp
index 634f55c514..ce26a9403d 100644
--- a/lcl/forms.pp
+++ b/lcl/forms.pp
@@ -1523,6 +1523,7 @@ type
     procedure DoIdleActions;
     procedure MenuPopupHandler(Sender: TObject);
     procedure ProcessAsyncCallQueue;
+    procedure DoDecLCLRefcountToZero(Sender: TObject);
     procedure FreeComponent(Data: PtrInt);
     procedure ReleaseComponents;
     procedure DoBeforeFinalization;
diff --git a/lcl/include/application.inc b/lcl/include/application.inc
index 6e2ecc07d0..e44c6c4edc 100644
--- a/lcl/include/application.inc
+++ b/lcl/include/application.inc
@@ -135,6 +135,7 @@ begin
   if Assigned(FOnDestroy) then FOnDestroy(Self);
 
   ProcessAsyncCallQueue;
+  OnDecLCLRefcountToZero := nil;
 
   if OnMenuPopupHandler=@MenuPopupHandler then
     OnMenuPopupHandler:=nil;
@@ -2331,6 +2332,12 @@ begin
   end;
 end;
 
+procedure TApplication.DoDecLCLRefcountToZero(Sender: TObject);
+begin
+  OnDecLCLRefcountToZero := nil;
+  QueueAsyncCall(@FreeComponent, 0);
+end;
+
 procedure TApplication.FreeComponent(Data: PtrInt);
 begin
   if Data<>0 then
@@ -2401,8 +2408,12 @@ begin
       exit;
     FComponentsToRelease.Add(AComponent);
     AComponent.FreeNotification(Self);
-    if IsFirstItem then
-      QueueAsyncCall(@FreeComponent, 0);
+    if IsFirstItem then begin
+      if TLCLComponent(AComponent).LCLRefCount>0 then
+        OnDecLCLRefcountToZero := @DoDecLCLRefcountToZero
+      else
+        QueueAsyncCall(@FreeComponent, 0);
+    end;
   end;
 end;
 
diff --git a/lcl/lclclasses.pp b/lcl/lclclasses.pp
index 2b82808624..ea52075193 100644
--- a/lcl/lclclasses.pp
+++ b/lcl/lclclasses.pp
@@ -85,6 +85,9 @@ type
     property ReferenceAllocated: Boolean read GetReferenceAllocated;
   end;
 
+var
+  OnDecLCLRefcountToZero: TNotifyEvent;
+
 implementation
 
 uses
@@ -180,6 +183,8 @@ end;
 procedure TLCLComponent.DecLCLRefCount;
 begin
   dec(FLCLRefCount);
+  if (FLCLRefCount <= 0) and (OnDecLCLRefcountToZero <> nil) then
+    OnDecLCLRefcountToZero(Self);
 end;
 
 { TLCLReferenceComponent }