Просмотр исходного кода

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

git-svn-id: trunk@35567 -
florian 8 лет назад
Родитель
Сommit
bb8b8f2eae
4 измененных файлов с 21 добавлено и 6 удалено
  1. 1 0
      .gitattributes
  2. 6 1
      rtl/inc/heaptrc.pp
  3. 4 5
      rtl/win/systhrd.inc
  4. 10 0
      tests/webtbs/tw30535.pp

+ 1 - 0
.gitattributes

@@ -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

+ 6 - 1
rtl/inc/heaptrc.pp

@@ -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;
 
 

+ 4 - 5
rtl/win/systhrd.inc

@@ -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 - 0
tests/webtbs/tw30535.pp

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