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

+ TThread.WaitFor needs to call CheckSynchronize

Browse Source 
git-svn-id: trunk@1661 -
This commit is contained in:
florian 2005-11-05 17:42:13 +00:00
parent 3f2f8609e3
commit 375bc7bbb0
2 changed files with 19 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
rtl/linux/tthread.inc
View File

@ -294,6 +294,9 @@ end;
function TThread.WaitFor: Integer;
begin
WRITE_DEBUG('waiting for thread ',FHandle);
if GetCurrentThreadID=MainThreadID then
while not(FFinished) do
CheckSynchronize(1000);
WaitFor := WaitForThreadTerminate(FHandle, 0);
WRITE_DEBUG('thread terminated');
end;

18
rtl/win32/tthread.inc
View File

@ -205,10 +205,24 @@ end;
function TThread.WaitFor: Integer;
var
Msg: TMsg;
WaitHandles : array[0..1] of THandle;
begin
if GetCurrentThreadID = MainThreadID then
while MsgWaitForMultipleObjects(1, FHandle, False, INFINITE, QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do
PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
begin
WaitHandles[0]:=FHandle;
WaitHandles[1]:=THandle(SynchronizeTimeoutEvent);
while true do
begin
case MsgWaitForMultipleObjects(2, WaitHandles, False, INFINITE, QS_SENDMESSAGE) of
WAIT_OBJECT_0:
break;
WAIT_OBJECT_0+1:
CheckSynchronize;
WAIT_OBJECT_0+2:
PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
end;
end;
end
else
WaitForSingleObject(ulong(FHandle), INFINITE);
GetExitCodeThread(FHandle, DWord(Result));