From 7c95ff434bb2009f10c25b19e20eeee678291a5e Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Sat, 16 Mar 2024 22:25:22 +0100
Subject: [PATCH]   * patch by Rika: fix incorrect exception handling if an
 exception raised in TThread decendant class's constructor, resolves #40677

---
 rtl/objpas/classes/classes.inc  | 3 ++-
 rtl/objpas/classes/classesh.inc | 2 +-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/rtl/objpas/classes/classes.inc b/rtl/objpas/classes/classes.inc
index 1e7becf4a8..dd146af4a0 100644
--- a/rtl/objpas/classes/classes.inc
+++ b/rtl/objpas/classes/classes.inc
@@ -265,6 +265,7 @@ begin
   inherited Create;
 {$ifdef FPC_HAS_FEATURE_THREADING}
     InterlockedIncrement(ThreadQueueLockCounter);
+    FThreadQueueLockCounted := true; { Guard against exception in descendant’s Create. }
 {$endif}
   if FExternalThread then
 {$ifdef FPC_HAS_FEATURE_THREADING}
@@ -289,7 +290,7 @@ begin
   RemoveQueuedEvents(Self);
   DoneSynchronizeEvent;
 {$ifdef FPC_HAS_FEATURE_THREADING}
-  if InterlockedDecrement(ThreadQueueLockCounter)=0 then
+  if FThreadQueueLockCounted and (InterlockedDecrement(ThreadQueueLockCounter)=0) then
     DoneCriticalSection(ThreadQueueLock);
 {$endif}
   { set CurrentThreadVar to Nil? }
diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc
index 663429cd77..57cf3fd8db 100644
--- a/rtl/objpas/classes/classesh.inc
+++ b/rtl/objpas/classes/classesh.inc
@@ -2230,7 +2230,7 @@ type
     FReturnValue: Integer;
     FOnTerminate: TNotifyEvent;
     FFatalException: TObject;
-    FExternalThread: Boolean;
+    FExternalThread, FThreadQueueLockCounted: Boolean;
     FSynchronizeEntry: PThreadQueueEntry;
     class function GetCurrentThread: TThread; static;
     class function GetIsSingleProcessor: Boolean; static; inline;