From e6648da56771939ed9ab65059a337fd3d715b32b Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Thu, 7 Jan 2010 13:41:43 +0000
Subject: [PATCH] * 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 -
---
 .gitattributes           |  3 +++
 rtl/inc/heaptrc.pp       |  6 ++++++
 rtl/win/systhrd.inc      |  2 +-
 rtl/win/syswin.inc       |  4 ++--
 tests/webtbs/tw14992a.pp |  7 +++++++
 tests/webtbs/tw14992b.pp |  7 +++++++
 tests/webtbs/tw14992c.pp | 34 ++++++++++++++++++++++++++++++++++
 7 files changed, 60 insertions(+), 3 deletions(-)
 create mode 100644 tests/webtbs/tw14992a.pp
 create mode 100644 tests/webtbs/tw14992b.pp
 create mode 100644 tests/webtbs/tw14992c.pp

diff --git a/.gitattributes b/.gitattributes
index fbc3fb2864..b61d241436 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -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
diff --git a/rtl/inc/heaptrc.pp b/rtl/inc/heaptrc.pp
index e081c022c6..715f2069df 100644
--- a/rtl/inc/heaptrc.pp
+++ b/rtl/inc/heaptrc.pp
@@ -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;
diff --git a/rtl/win/systhrd.inc b/rtl/win/systhrd.inc
index 345cae28e1..f017dc39eb 100644
--- a/rtl/win/systhrd.inc
+++ b/rtl/win/systhrd.inc
@@ -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;
+
diff --git a/rtl/win/syswin.inc b/rtl/win/syswin.inc
index e003199d92..21b5fb60a9 100644
--- a/rtl/win/syswin.inc
+++ b/rtl/win/syswin.inc
@@ -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... }
diff --git a/tests/webtbs/tw14992a.pp b/tests/webtbs/tw14992a.pp
new file mode 100644
index 0000000000..543d54980b
--- /dev/null
+++ b/tests/webtbs/tw14992a.pp
@@ -0,0 +1,7 @@
+{ %target=win32,wince,win64 }
+{ %opt=-gh }
+{ %norun }
+library dll1;
+begin
+  IsMultiThread:=True;
+end.
diff --git a/tests/webtbs/tw14992b.pp b/tests/webtbs/tw14992b.pp
new file mode 100644
index 0000000000..cdc90efdc6
--- /dev/null
+++ b/tests/webtbs/tw14992b.pp
@@ -0,0 +1,7 @@
+{ %target=win32,wince,win64 }
+{ %opt=-gh }
+{ %norun }
+library dll2;
+begin
+  IsMultiThread:=True;
+end.
diff --git a/tests/webtbs/tw14992c.pp b/tests/webtbs/tw14992c.pp
new file mode 100644
index 0000000000..5d75e4907f
--- /dev/null
+++ b/tests/webtbs/tw14992c.pp
@@ -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.