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

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

Browse Source
This commit is contained in:
florian 2024-03-16 22:25:22 +01:00
parent c3b8b51cb5
commit 7c95ff434b
2 changed files with 3 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
rtl/objpas/classes/classes.inc
View File

@ -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? }

2
rtl/objpas/classes/classesh.inc
View File

@ -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;