--- Merging r14557 into '.':

U    rtl/win/syswin.inc
U    rtl/win/systhrd.inc
--- Merging r14560 into '.':
G    rtl/win/syswin.inc
G    rtl/win/systhrd.inc
U    rtl/inc/heaptrc.pp
A    tests/webtbs/tw14992b.pp
A    tests/webtbs/tw14992a.pp
A    tests/webtbs/tw14992c.pp
--- Merging r15023 into '.':
U    rtl/objpas/sysutils/sysutils.inc
--- Merging r15024 into '.':
G    rtl/objpas/sysutils/sysutils.inc
--- Merging r15025 into '.':
U    packages/paszlib/src/zipper.pp
U    packages/paszlib/examples/extractodt.pas
--- Merging r15026 into '.':
U    rtl/unix/cthreads.pp
U    rtl/haiku/pthread.inc
U    rtl/freebsd/pthread.inc
G    rtl/win/systhrd.inc
U    rtl/inc/threadh.inc
U    rtl/inc/thread.inc
U    packages/fcl-base/src/syncobjs.pp
A    packages/fcl-base/examples/crittest.pp

# revisions: 14557,14560,15023,15024,15025,15026
------------------------------------------------------------------------
r14557 | florian | 2010-01-06 22:26:49 +0100 (Wed, 06 Jan 2010) | 1 line
Changed paths:
   M /trunk/rtl/win/systhrd.inc
   M /trunk/rtl/win/syswin.inc

* always assume a multithreaded application when using threadvars in dlls, resolves #14992
------------------------------------------------------------------------
------------------------------------------------------------------------
r14560 | florian | 2010-01-07 14:41:43 +0100 (Thu, 07 Jan 2010) | 1 line
Changed paths:
   M /trunk/rtl/inc/heaptrc.pp
   M /trunk/rtl/win/systhrd.inc
   M /trunk/rtl/win/syswin.inc
   A /trunk/tests/webtbs/tw14992a.pp
   A /trunk/tests/webtbs/tw14992b.pp
   A /trunk/tests/webtbs/tw14992c.pp

* 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
------------------------------------------------------------------------
------------------------------------------------------------------------
r15023 | marco | 2010-03-20 14:03:45 +0100 (Sat, 20 Mar 2010) | 2 lines
Changed paths:
   M /trunk/rtl/objpas/sysutils/sysutils.inc

 * fix for mantis 16052 RFC4122 compliance of own random GUID creation.

------------------------------------------------------------------------
------------------------------------------------------------------------
r15024 | marco | 2010-03-20 15:08:10 +0100 (Sat, 20 Mar 2010) | 2 lines
Changed paths:
   M /trunk/rtl/objpas/sysutils/sysutils.inc

 * fix for mantis 16052 RFC4122 compliance of own random GUID creation. Part II

------------------------------------------------------------------------
------------------------------------------------------------------------
r15025 | marco | 2010-03-21 11:28:29 +0100 (Sun, 21 Mar 2010) | 2 lines
Changed paths:
   M /trunk/packages/paszlib/examples/extractodt.pas
   M /trunk/packages/paszlib/src/zipper.pp

 * Disable parts of commit 13378 for windows, since it blocks extracting zips with Unix lineseparators (like Open Office files, even when generated on Windows)
 * Minor tweak to demo
------------------------------------------------------------------------
------------------------------------------------------------------------
r15026 | marco | 2010-03-21 12:34:05 +0100 (Sun, 21 Mar 2010) | 5 lines
Changed paths:
   A /trunk/packages/fcl-base/examples/crittest.pp
   M /trunk/packages/fcl-base/src/syncobjs.pp
   M /trunk/rtl/freebsd/pthread.inc
   M /trunk/rtl/haiku/pthread.inc
   M /trunk/rtl/inc/thread.inc
   M /trunk/rtl/inc/threadh.inc
   M /trunk/rtl/unix/cthreads.pp
   M /trunk/rtl/win/systhrd.inc

 * TCriticalSection.Tryenter support (Mantis 15928) + short test/demo
    tested on FreeBSD (general Unix) and Windows. Note that Haiku seems 
    to have a native threadmgr rather than the Unix one. Will notify 
    maintainer (Olivier)

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@15045 -

.gitattributes

@@ -1032,6 +1032,7 @@ packages/fcl-base/examples/b64test2.pp svneol=native#text/plain
 packages/fcl-base/examples/base64decodingtestcase.pas svneol=native#text/plain
 packages/fcl-base/examples/cachetest.pp svneol=native#text/plain
 packages/fcl-base/examples/cfgtest.pp svneol=native#text/plain
+packages/fcl-base/examples/crittest.pp svneol=native#text/plain
 packages/fcl-base/examples/daemon.pp svneol=native#text/plain
 packages/fcl-base/examples/daemon.txt svneol=native#text/plain
 packages/fcl-base/examples/dbugsrv.pp svneol=native#text/plain
@@ -9450,6 +9451,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/tw15296.pp svneol=native#text/plain
 tests/webtbs/tw1532.pp svneol=native#text/plain

packages/fcl-base/examples/crittest.pp

@@ -0,0 +1,47 @@
+program crittest;
+// originally a test to test .tryenter.
+// A thread holds a lock for 5sec, while the main thread tries to lock
+// it.  
+
+{$mode Delphi}
+
+Uses {$ifdef unix}cthreads,{$endif} syncobjs,sysutils,classes;
+
+type TTestthread = class(tthread)
+	    	     procedure execute; override;
+                    end;
+
+var crit : TCriticalSection;
+
+procedure TTestThread.Execute;
+
+begin
+ crit.acquire;
+ sleep(5000);
+ crit.release;
+end;
+
+
+var thr : TTestthread;  
+    I : integer;
+
+begin
+ crit:=TCriticalsection.create;
+ thr :=TTestthread.Create(false);
+
+ sleep(500);  // give thread time to start.
+
+ writeln('tryenter');
+ 
+ i:=0;
+ while not(crit.tryenter) do
+  begin
+    writeln('tryenter attempt ',i);
+    inc(i);
+    sleep(100);
+  end;
+ writeln('lock acquired in mainthread!');
+ writeln('no payload, so releasing');
+ crit.release;
+ thr.waitfor;
+end.

packages/fcl-base/src/syncobjs.pp

@@ -42,6 +42,7 @@ type
       procedure Acquire;override;
       procedure Release;override;
       procedure Enter;
+      function  TryEnter:boolean;
       procedure Leave;
       constructor Create;
       destructor Destroy;override;
@@ -100,6 +101,10 @@ begin
   Release;
 end;
 
+function  TCriticalSection.TryEnter:boolean;
+begin
+  result:=TryEnterCriticalSection(CriticalSection)<>0;
+end;
 
 procedure TCriticalSection.Acquire;
 

packages/paszlib/examples/extractodt.pas

@@ -20,7 +20,7 @@ begin
   FileName:=paramstr(1);
   if not fileexists(FileName) then
     Usage;
-  edir:=extractfilename(filename)+'extractiondir';
+  edir:=extractfilename(filename)+'.extractiondir';
   mkdir(edir);
   unzipper:=TUnzipper.create;
   unzipper.FileName:=FileName;

packages/paszlib/src/zipper.pp

@@ -1561,9 +1561,15 @@ Begin
     for Windows compatibility: it allows both '/' and '\'
     as directory separator. We don't want that behaviour
     here, since 'abc\' is a valid file name under Unix.
+	
+	(mantis 15836) On the other hand, many archives on 
+	 windows have '/' as pathseparator, even Windows 
+	 generated .odt files. So we disable this for windows.
   }
   OldDirectorySeparators:=AllowDirectorySeparators;
+  {$ifndef Windows}
   AllowDirectorySeparators:=[DirectorySeparator];
+  {$endif}
   Path:=ExtractFilePath(OutFileName);
   OutStream:=Nil;
   If Assigned(FOnCreateStream) then
@@ -1576,10 +1582,12 @@ Begin
     AllowDirectorySeparators:=OldDirectorySeparators;
     OutStream:=TFileStream.Create(OutFileName,fmCreate);
     end;
-
+	
+  AllowDirectorySeparators:=OldDirectorySeparators;
   Result:=True;
   If Assigned(FOnStartFile) then
     FOnStartFile(Self,OutFileName);
+	
 End;
 
 

rtl/freebsd/pthread.inc

@@ -55,6 +55,7 @@ function  pthread_self:pthread_t; cdecl;external;
 function  pthread_mutex_init (p:ppthread_mutex_t;o:ppthread_mutex_attr_t):cint; cdecl;external;
 function  pthread_mutex_destroy (p:ppthread_mutex_attr_t):cint; cdecl;external;
 function  pthread_mutex_lock    (p:ppthread_mutex_attr_t):cint; cdecl;external;
+function  pthread_mutex_trylock    (p:ppthread_mutex_attr_t):cint; cdecl;external;
 function  pthread_mutex_unlock  (p:ppthread_mutex_attr_t):cint; cdecl;external;
 function  pthread_cancel(_para1:pthread_t):cint;cdecl;external;
 function  pthread_detach(_para1:pthread_t):cint;cdecl;external;

rtl/haiku/pthread.inc

@@ -55,6 +55,7 @@ function  pthread_self:pthread_t; cdecl;external;
 function  pthread_mutex_init (p:ppthread_mutex_t;o:ppthread_mutex_attr_t):cint; cdecl;external;
 function  pthread_mutex_destroy (p:ppthread_mutex_attr_t):cint; cdecl;external;
 function  pthread_mutex_lock    (p:ppthread_mutex_attr_t):cint; cdecl;external;
+function  pthread_mutex_trylock    (p:ppthread_mutex_attr_t):cint; cdecl;external;
 function  pthread_mutex_unlock  (p:ppthread_mutex_attr_t):cint; cdecl;external;
 function  pthread_cancel(_para1:pthread_t):cint;cdecl;external;
 function  pthread_detach(_para1:pthread_t):cint;cdecl;external;

rtl/inc/heaptrc.pp

@@ -1352,6 +1352,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;

rtl/inc/thread.inc

@@ -196,6 +196,12 @@ begin
   CurrentTM.EnterCriticalSection(cs);
 end;
 
+function TryEnterCriticalsection(var cs : TRTLCriticalSection):longint;
+
+begin
+  result:=CurrentTM.TryEnterCriticalSection(cs);
+end;
+
 procedure LeaveCriticalsection(var cs : TRTLCriticalSection);
 
 begin
@@ -384,6 +390,15 @@ begin
     ThreadingAlreadyUsed:=true;
 end;
 
+function NoTryEnterCriticalSection(var CS):longint;
+
+begin
+  if IsMultiThread then
+    NoThreadError
+  else
+    ThreadingAlreadyUsed:=true;
+end;
+
 procedure NoInitThreadvar(var offset : dword;size : dword);
 
 begin
@@ -523,6 +538,7 @@ begin
     InitCriticalSection    :=@NoCriticalSection;
     DoneCriticalSection    :=@NoCriticalSection;
     EnterCriticalSection   :=@NoCriticalSection;
+    TryEnterCriticalSection:=@NoTryEnterCriticalSection;
     LeaveCriticalSection   :=@NoCriticalSection;
     InitThreadVar          :=@NoInitThreadVar;
     RelocateThreadVar      :=@NoRelocateThreadVar;

rtl/inc/threadh.inc

@@ -35,6 +35,7 @@ type
   TThreadGetPriorityHandler = Function (threadHandle : TThreadID): longint;
   TGetCurrentThreadIdHandler = Function : TThreadID;
   TCriticalSectionHandler = Procedure (var cs);
+  TCriticalSectionHandlerTryEnter = function (var cs):longint;
   TInitThreadVarHandler = Procedure(var offset : dword;size : dword);
   TRelocateThreadVarHandler = Function(offset : dword) : pointer;
   TAllocateThreadVarsHandler = Procedure;
@@ -69,6 +70,7 @@ type
     InitCriticalSection    : TCriticalSectionHandler;
     DoneCriticalSection    : TCriticalSectionHandler;
     EnterCriticalSection   : TCriticalSectionHandler;
+    TryEnterCriticalSection: TCriticalSectionHandlerTryEnter;
     LeaveCriticalSection   : TCriticalSectionHandler;
     InitThreadVar          : TInitThreadVarHandler;
     RelocateThreadVar      : TRelocateThreadVarHandler;
@@ -146,7 +148,7 @@ procedure InitCriticalSection(var cs : TRTLCriticalSection);
 procedure DoneCriticalsection(var cs : TRTLCriticalSection);
 procedure EnterCriticalsection(var cs : TRTLCriticalSection);
 procedure LeaveCriticalsection(var cs : TRTLCriticalSection);
-
+function  TryEnterCriticalsection(var cs : TRTLCriticalSection):longint;
 function  BasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
 procedure basiceventdestroy(state:peventstate);
 procedure basiceventResetEvent(state:peventstate);

rtl/objpas/sysutils/sysutils.inc

@@ -628,6 +628,8 @@ begin
     Result:=SysCreateGUID(GUID);
     {$ELSE}
     GetRandomBytes(GUID,SizeOf(Guid));
+    guid.clock_seq_hi_and_reserved:=(guid.clock_seq_hi_and_reserved and $3F) + 64;
+    guid.time_hi_and_version      :=(guid.time_hi_and_version and $0FFF)+ $4000;
     Result:=0;
     {$ENDIF}
     end;

rtl/unix/cthreads.pp

@@ -424,6 +424,14 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
            fpc_threaderror
       end;
 
+    function CTryEnterCriticalSection(var CS):longint;
+      begin
+         if pthread_mutex_Trylock(@CS)=0 then
+           result:=1  // succes
+         else
+           result:=0; // failure
+      end;
+
     procedure CLeaveCriticalSection(var CS);
       begin
          if pthread_mutex_unlock(@CS) <> 0 then
@@ -936,6 +944,7 @@ begin
     InitCriticalSection    :=@CInitCriticalSection;
     DoneCriticalSection    :=@CDoneCriticalSection;
     EnterCriticalSection   :=@CEnterCriticalSection;
+    TryEnterCriticalSection:=@CTryEnterCriticalSection;
     LeaveCriticalSection   :=@CLeaveCriticalSection;
     InitThreadVar          :=@CInitThreadVar;
     RelocateThreadVar      :=@CRelocateThreadVar;

rtl/win/systhrd.inc

@@ -56,6 +56,21 @@ function  ResetEvent(hEvent:THandle):LONGBOOL; stdcall; external KernelDLL name
 function  SetEvent(hEvent:THandle):LONGBOOL; stdcall; external KernelDLL name 'SetEvent';
 {$endif WINCE}
 
+procedure WinInitCriticalSection(var cs : TRTLCriticalSection);
+  {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'InitializeCriticalSection';
+
+procedure WinDoneCriticalSection(var cs : TRTLCriticalSection);
+  {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'DeleteCriticalSection';
+
+procedure WinEnterCriticalSection(var cs : TRTLCriticalSection);
+  {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'EnterCriticalSection';
+
+function  WinTryEnterCriticalSection(var cs : TRTLCriticalSection):longint;
+  {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'TryEnterCriticalSection';
+
+procedure WinLeaveCriticalSection(var cs : TRTLCriticalSection);
+  {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'LeaveCriticalSection';
+
 CONST
    WAIT_OBJECT_0 = 0;
    WAIT_ABANDONED_0 = $80;
@@ -74,6 +89,9 @@ CONST
 
     const
       TLSKey : DWord = $ffffffff;
+    var
+      MainThreadIdWin32 : DWORD;
+      AttachingThread : TRTLCriticalSection;
 
     procedure SysInitThreadvar(var offset : dword;size : dword);
       begin
@@ -99,6 +117,32 @@ CONST
         TlsSetValue(tlskey,dataindex);
       end;
 
+    function SysRelocateThreadvar(offset : dword) : pointer; forward;
+
+    procedure SysInitMultithreading;
+      begin
+        { do not check IsMultiThread, as program could have altered it, out of Delphi habit }
+
+        { the thread attach/detach code uses locks to avoid multiple calls of this }
+        if TLSKey=$ffffffff then
+         begin
+           { We're still running in single thread mode, setup the TLS }
+           TLSKey:=TlsAlloc;
+           InitThreadVars(@SysRelocateThreadvar);
+
+           IsMultiThread:=true;
+         end;
+      end;
+
+
+    procedure SysFiniMultithreading;
+      begin
+        if IsMultiThread then
+          begin
+            TlsFree(TLSKey);
+            TLSKey:=$ffffffff;
+          end;
+      end;
 
     function SysRelocateThreadvar(offset : dword) : pointer;
       var
@@ -114,7 +158,7 @@ CONST
           movl %fs:(0x2c),%eax
           orl  %eax,%eax
           jnz  .LAddressInEAX
-		  { this works on Windows 7, but I don't know if it works on other OSes (FK) }
+          { this works on Windows 7, but I don't know if it works on other OSes (FK) }
           movl %fs:(0x18),%eax
           movl 0xe10(%eax,%edx,4),%eax
           jmp  .LToDataIndex
@@ -185,29 +229,6 @@ CONST
         ThreadMain:=ti.f(ti.p);
       end;
 
-    procedure SysInitMultithreading;
-      begin
-        { do not check IsMultiThread, as program could have altered it, out of Delphi habit }
-        
-        { the thread attach/detach code uses locks to avoid multiple calls of this }
-        if TLSKey=$ffffffff then
-         begin
-           { We're still running in single thread mode, setup the TLS }
-           TLSKey:=TlsAlloc;
-           InitThreadVars(@SysRelocateThreadvar);
-		   { allocate the thread vars for the main thread }
-           IsMultiThread:=true;
-         end;
-      end;
-
-    procedure SysFiniMultithreading;
-      begin
-        if IsMultiThread then
-          begin
-            TlsFree(TLSKey);
-            TLSKey:=$ffffffff;
-          end;
-      end;
 
     function SysBeginThread(sa : Pointer;stacksize : ptruint;
                          ThreadFunction : tthreadfunc;p : pointer;
@@ -308,18 +329,6 @@ CONST
                           Delphi/Win32 compatibility
 *****************************************************************************}
 
-procedure WinInitCriticalSection(var cs : TRTLCriticalSection);
-  {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'InitializeCriticalSection';
-
-procedure WinDoneCriticalSection(var cs : TRTLCriticalSection);
-  {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'DeleteCriticalSection';
-
-procedure WinEnterCriticalSection(var cs : TRTLCriticalSection);
-  {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'EnterCriticalSection';
-
-procedure WinLeaveCriticalSection(var cs : TRTLCriticalSection);
-  {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'LeaveCriticalSection';
-
 procedure SySInitCriticalSection(var cs);
 begin
   WinInitCriticalSection(PRTLCriticalSection(@cs)^);
@@ -337,6 +346,10 @@ begin
   WinEnterCriticalSection(PRTLCriticalSection(@cs)^);
 end;
 
+function SysTryEnterCriticalSection(var cs):longint;
+begin
+  result:=WinTryEnterCriticalSection(PRTLCriticalSection(@cs)^);
+end;
 
 procedure SySLeaveCriticalSection(var cs);
 begin
@@ -455,6 +468,7 @@ begin
     InitCriticalSection    :=@SysInitCriticalSection;
     DoneCriticalSection    :=@SysDoneCriticalSection;
     EnterCriticalSection   :=@SysEnterCriticalSection;
+    TryEnterCriticalSection:=@SysTryEnterCriticalSection;
     LeaveCriticalSection   :=@SysLeaveCriticalSection;
     InitThreadVar          :=@SysInitThreadVar;
     RelocateThreadVar      :=@SysRelocateThreadVar;
@@ -474,4 +488,7 @@ begin
     end;
   SetThreadManager(WinThreadManager);
   ThreadID := GetCurrentThreadID;
+  if IsLibrary then
+    SysInitMultithreading;
 end;
+

rtl/win/syswin.inc

@@ -23,9 +23,6 @@ Const
    DLLExitOK : boolean = true;
 Var
   DLLBuf : Jmp_buf;
-  MainThreadIdWin32 : DWORD;
-  AttachingThread : TRTLCriticalSection;
-
 
 function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntryInformation){$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} : longbool; [public,alias:'_FPC_DLL_Entry'];
   begin
@@ -39,6 +36,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
          begin
            WinInitCriticalSection(AttachingThread);
            MainThreadIdWin32 := Win32GetCurrentThreadId;
+
            If SetJmp(DLLBuf) = 0 then
              begin
 {$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}
@@ -56,13 +54,13 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
            inclocked(Thread_count);
 
            WinEnterCriticalSection(AttachingThread);
-           if (Win32GetCurrentThreadId <> MainThreadIdWin32) then
+           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) }
+             { 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... }
            end;
 
@@ -77,7 +75,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
            if assigned(Dll_Thread_Detach_Hook) then
              Dll_Thread_Detach_Hook(DllParam);
            { Release Threadvars }
-           if (Win32GetCurrentThreadId<>MainThreadIdWin32) then
+           if Win32GetCurrentThreadId<>MainThreadIdWin32 then
              DoneThread; { Assume everything is idempotent there }
            Dll_entry:=true; { return value is ignored }
          end;
@@ -276,3 +274,4 @@ procedure InitWin32Widestrings;
     widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower;
 {$endif VER2_2}
   end;
+

tests/webtbs/tw14992a.pp

@@ -0,0 +1,7 @@
+{ %target=win32,wince,win64 }
+{ %opt=-gh }
+{ %norun }
+library dll1;
+begin
+  IsMultiThread:=True;
+end.

tests/webtbs/tw14992b.pp

@@ -0,0 +1,7 @@
+{ %target=win32,wince,win64 }
+{ %opt=-gh }
+{ %norun }
+library dll2;
+begin
+  IsMultiThread:=True;
+end.

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.