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

* proper error handling in case of thread creation failure on windows, resolves #13768, no test case due because such a test is too sensitive regarding race conditions etc. and might cause false failures

Browse Source 
git-svn-id: trunk@13222 -
This commit is contained in:
florian 2009-06-01 14:17:01 +00:00
parent 287758598e
commit 88f6b8854e
2 changed files with 26 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
rtl/win/systhrd.inc
View File

@ -160,17 +160,17 @@ CONST
{ Allocate local thread vars, this must be the first thing, { Allocate local thread vars, this must be the first thing,
because the exception management and io depends on threadvars } because the exception management and io depends on threadvars }
SysAllocateThreadVars; SysAllocateThreadVars;
{ Copy parameter to local data } { Copy parameter to local data }
{$ifdef DEBUG_MT}
writeln('New thread started, initialising ...');
{$endif DEBUG_MT}
ti:=pthreadinfo(param)^; ti:=pthreadinfo(param)^;
dispose(pthreadinfo(param)); dispose(pthreadinfo(param));
{ Initialize thread } { Initialize thread }
InitThread(ti.stklen); InitThread(ti.stklen);
{ Start thread function } { Start thread function }
{$ifdef DEBUG_MT} {$ifdef DEBUG_MT}
writeln('Jumping to thread function'); writeln('Jumping to thread function of thread ',Win32GetCurrentThreadId);
{$endif DEBUG_MT} {$endif DEBUG_MT}
ThreadMain:=ti.f(ti.p); ThreadMain:=ti.f(ti.p);
end; end;
@ -181,7 +181,7 @@ CONST
creationFlags : dword;var ThreadId : TThreadID) : TThreadID; creationFlags : dword;var ThreadId : TThreadID) : TThreadID;
var var
ti : pthreadinfo; ti : pthreadinfo;
_threadid : DWord; _threadid : TThreadID;
begin begin
{$ifdef DEBUG_MT} {$ifdef DEBUG_MT}
writeln('Creating new thread'); writeln('Creating new thread');
@ -200,12 +200,21 @@ CONST
ti^.f:=ThreadFunction; ti^.f:=ThreadFunction;
ti^.p:=p; ti^.p:=p;
ti^.stklen:=stacksize; ti^.stklen:=stacksize;
{ call pthread_create }
{$ifdef DEBUG_MT} {$ifdef DEBUG_MT}
writeln('Starting new thread'); writeln('Starting new thread');
{$endif DEBUG_MT} {$endif DEBUG_MT}
_threadid:=ThreadID; _threadid:=ThreadID;
SysBeginThread:=CreateThread(sa,stacksize,@ThreadMain,ti,creationflags,_threadid); SysBeginThread:=CreateThread(sa,stacksize,@ThreadMain,ti,creationflags,_threadid);
{ creation failed? if yes, we dispose the parameter record }
if SysBeginThread=0 then
begin
{$ifdef DEBUG_MT}
writeln('Thread creation failed');
{$endif DEBUG_MT}
dispose(ti);
end;
ThreadID:=_threadid; ThreadID:=_threadid;
end; end;

18
rtl/win/tthread.inc
View File

@ -22,19 +22,23 @@ begin
FThreadID); FThreadID);
if FHandle = TThreadID(0) then if FHandle = TThreadID(0) then
raise EThread.create('Failed to create new thread, code:'+inttostr(getlasterror)); raise EThread.create('Failed to create new thread, code:'+inttostr(getlasterror));
FFatalException := nil; FFatalException := nil;
end; end;
destructor TThread.Destroy; destructor TThread.Destroy;
begin begin
if not FFinished and not Suspended then if FHandle<>0 then
begin begin
Terminate; if not FFinished and not Suspended then
WaitFor; begin
end; Terminate;
if FHandle <> 0 then CloseHandle(FHandle); WaitFor;
end;
CloseHandle(FHandle);
end;
FFatalException.Free; FFatalException.Free;
FFatalException := nil; FFatalException := nil;
inherited Destroy; inherited Destroy;