Browse Source

* patch by Rika: fix incorrect exception handling if an exception raised in TThread decendant class's constructor, resolves #40677

florian 1 năm trước cách đây
mục cha
commit
7c95ff434b
2 tập tin đã thay đổi với 3 bổ sung2 xóa
  1. 2 1
      rtl/objpas/classes/classes.inc
  2. 1 1
      rtl/objpas/classes/classesh.inc

+ 2 - 1
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? }

+ 1 - 1
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;