mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-10 02:28:22 +02:00
* make heaptrc aware of the fact that multi threading could be initialized before heaptrc itself is initialized, this is currently the case for windows dlls
git-svn-id: trunk@14560 -
This commit is contained in:
parent
fb07fe5856
commit
e6648da567
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -10157,6 +10157,9 @@ tests/webtbs/tw1485.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1489.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14958a.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14958b.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14992a.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw14992b.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw14992c.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw1501.pp svneol=native#text/plain
|
||||
tests/webtbs/tw15015.pp svneol=native#text/plain
|
||||
tests/webtbs/tw15088.pp svneol=native#text/plain
|
||||
|
@ -1344,6 +1344,12 @@ begin
|
||||
Rewrite(error_file);
|
||||
end;
|
||||
{$endif EXTRA}
|
||||
{ if multithreading was initialized before heaptrc gets initialized (this is currently
|
||||
the case for windows dlls), then RelocateHeap gets never called and the lock
|
||||
must be initialized already here
|
||||
}
|
||||
if IsMultithread then
|
||||
initcriticalsection(todo_lock);
|
||||
end;
|
||||
|
||||
procedure TraceExit;
|
||||
|
@ -177,7 +177,6 @@ CONST
|
||||
if dataindex=nil then
|
||||
begin
|
||||
SysAllocateThreadVars;
|
||||
|
||||
dataindex:=TlsGetValue(tlskey);
|
||||
end;
|
||||
SetLastError(errorsave);
|
||||
@ -484,3 +483,4 @@ begin
|
||||
if IsLibrary then
|
||||
SysInitMultithreading;
|
||||
end;
|
||||
|
||||
|
@ -56,9 +56,9 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
|
||||
WinEnterCriticalSection(AttachingThread);
|
||||
if Win32GetCurrentThreadId <> MainThreadIdWin32 then
|
||||
begin
|
||||
{ Set up TLS slot for the DLL }
|
||||
SysInitMultiThreading;
|
||||
{ Allocate Threadvars }
|
||||
SysAllocateThreadVars;
|
||||
|
||||
{ NS : no idea what is correct to pass here - pass dummy value for now }
|
||||
{ passing a dummy is ok, the correct value is read from the coff header of SysInstance (FK) }
|
||||
InitThread($1000000); { Assume everything is idempotent there, as the thread could have been created with BeginThread... }
|
||||
|
7
tests/webtbs/tw14992a.pp
Normal file
7
tests/webtbs/tw14992a.pp
Normal file
@ -0,0 +1,7 @@
|
||||
{ %target=win32,wince,win64 }
|
||||
{ %opt=-gh }
|
||||
{ %norun }
|
||||
library dll1;
|
||||
begin
|
||||
IsMultiThread:=True;
|
||||
end.
|
7
tests/webtbs/tw14992b.pp
Normal file
7
tests/webtbs/tw14992b.pp
Normal file
@ -0,0 +1,7 @@
|
||||
{ %target=win32,wince,win64 }
|
||||
{ %opt=-gh }
|
||||
{ %norun }
|
||||
library dll2;
|
||||
begin
|
||||
IsMultiThread:=True;
|
||||
end.
|
34
tests/webtbs/tw14992c.pp
Normal file
34
tests/webtbs/tw14992c.pp
Normal file
@ -0,0 +1,34 @@
|
||||
{ %target=win32,wince,win64 }
|
||||
{ %opt=-gh }
|
||||
{$AppType CONSOLE}
|
||||
uses Windows;
|
||||
{$C+}
|
||||
|
||||
|
||||
var
|
||||
dll1, dll2: HModule;
|
||||
|
||||
function T1(Parameter: Pointer): LongInt;
|
||||
begin
|
||||
//Sleep(100);
|
||||
end;
|
||||
|
||||
function T2(Parameter: Pointer): LongInt;
|
||||
begin
|
||||
//Sleep(100);
|
||||
end;
|
||||
|
||||
var
|
||||
h: array[0..1] of THandle;
|
||||
id1, id2: DWORD;
|
||||
p : pointer;
|
||||
begin
|
||||
IsMultiThread:=True;
|
||||
dll1:=LoadLibrary('tw14992a.dll');
|
||||
dll2:=LoadLibrary('tw14992b.dll');
|
||||
h[0]:=BeginThread(nil, 0, @T1, nil, 0, id1);
|
||||
h[1]:=BeginThread(nil, 0, @T2, nil, 0, id2);
|
||||
WaitForMultipleObjects(Length(h), @h[0], true, infinite);
|
||||
FreeLibrary(dll2);
|
||||
FreeLibrary(dll1);
|
||||
end.
|
Loading…
Reference in New Issue
Block a user