paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-06 17:35:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

* do not set IsMultithread on windows, if no second thread is started, resolves #30535

Browse Source 
git-svn-id: trunk@35567 -
This commit is contained in:
florian 2017-03-11 21:35:48 +00:00
parent ec3aa1f56a
commit bb8b8f2eae
4 changed files with 21 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -15341,6 +15341,7 @@ tests/webtbs/tw30524a.pp svneol=native#text/pascal
tests/webtbs/tw30524b.pp svneol=native#text/pascal tests/webtbs/tw30524b.pp svneol=native#text/pascal
tests/webtbs/tw30530.pp svneol=native#text/pascal tests/webtbs/tw30530.pp svneol=native#text/pascal
tests/webtbs/tw30534.pp svneol=native#text/pascal tests/webtbs/tw30534.pp svneol=native#text/pascal
tests/webtbs/tw30535.pp svneol=native#text/pascal
tests/webtbs/tw30537.pp svneol=native#text/pascal tests/webtbs/tw30537.pp svneol=native#text/pascal
tests/webtbs/tw30552.pp svneol=native#text/pascal tests/webtbs/tw30552.pp svneol=native#text/pascal
tests/webtbs/tw30570.pp svneol=native#text/plain tests/webtbs/tw30570.pp svneol=native#text/plain

7
rtl/inc/heaptrc.pp
View File

@ -1446,9 +1446,14 @@ begin
{$endif EXTRA} {$endif EXTRA}
{ if multithreading was initialized before heaptrc gets initialized (this is currently { if multithreading was initialized before heaptrc gets initialized (this is currently
the case for windows dlls), then RelocateHeap gets never called and the lock the case for windows dlls), then RelocateHeap gets never called and the lock
must be initialized already here must be initialized already here,
however, IsMultithread is not set in this case on windows,
it is set only if a new thread is started
} }
{$IfNDef WINDOWS}
if IsMultithread then if IsMultithread then
{$EndIf WINDOWS}
TraceRelocateHeap; TraceRelocateHeap;
end; end;

9
rtl/win/systhrd.inc
View File

@ -141,7 +141,7 @@ var
function SysRelocateThreadvar(offset : dword) : pointer; forward; function SysRelocateThreadvar(offset : dword) : pointer; forward;
procedure SysInitMultithreading; procedure SysInitTLS;
begin begin
{ do not check IsMultiThread, as program could have altered it, out of Delphi habit } { do not check IsMultiThread, as program could have altered it, out of Delphi habit }
@ -151,8 +151,6 @@ var
{ We're still running in single thread mode, setup the TLS } { We're still running in single thread mode, setup the TLS }
TLSKey^:=TlsAlloc; TLSKey^:=TlsAlloc;
InitThreadVars(@SysRelocateThreadvar); InitThreadVars(@SysRelocateThreadvar);
IsMultiThread:=true;
end; end;
end; end;
@ -250,7 +248,8 @@ var
writeln('Creating new thread'); writeln('Creating new thread');
{$endif DEBUG_MT} {$endif DEBUG_MT}
{ Initialize multithreading if not done } { Initialize multithreading if not done }
SysInitMultithreading; SysInitTLS;
IsMultiThread:=true;
{ the only way to pass data to the newly created thread { the only way to pass data to the newly created thread
in a MT safe way, is to use the heap } in a MT safe way, is to use the heap }
@ -544,7 +543,7 @@ begin
{$ifndef FPC_USE_TLS_DIRECTORY} {$ifndef FPC_USE_TLS_DIRECTORY}
if IsLibrary then if IsLibrary then
{$endif} {$endif}
SysInitMultithreading; SysInitTLS;
{$IFDEF SUPPORT_WIN95} {$IFDEF SUPPORT_WIN95}
{ Try to find TryEnterCriticalSection function } { Try to find TryEnterCriticalSection function }
KernelHandle:=GetModuleHandle(KernelDLL); KernelHandle:=GetModuleHandle(KernelDLL);

10
tests/webtbs/tw30535.pp Normal file
View File

@ -0,0 +1,10 @@
{$ifdef unix}
uses
cthreads;
{$endif}
begin
if IsMultiThread then
halt(1);
Writeln('ok');
end.