Files
harbour-core/tests/mt/mttest10.prg
Przemysław Czerpak 8aba0aa64b 2013-06-04 15:14 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)
* tests/mt/mttest10.prg
    + allow to chose GT passing it's name as command line argument
    + initialize GT in main thread if GT needs it
      (currently QTC needs initialization in main thread)
2013-06-04 15:14:28 +02:00

65 lines
1.3 KiB
Plaintext

/*
* Harbour Project source code:
* demonstration/test code for using independent console window in
* different thread. It needs GT driver which supports such functionality.
*
* Copyright 2008 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://harbour-project.org
*
*/
#include "inkey.ch"
#ifdef __PLATFORM__WINDOWS
REQUEST HB_GT_WVT_DEFAULT
#define THREAD_GT hb_gtVersion()
#else
REQUEST HB_GT_STD_DEFAULT
#define THREAD_GT "XWC"
#endif
proc main( cGT )
local i, aThreads
if ! hb_mtvm()
? "This program needs HVM with MT support"
quit
endif
if empty( cGT )
cGT := THREAD_GT
endif
if cGT == "QTC" .and. ! cGT == hb_gtVersion()
/* QTC have to be initialized in main thread */
hb_gtReload( cGT )
endif
? "Starting threads..."
aThreads := {}
for i := 1 to 3
aadd( aThreads, hb_threadStart( @thFunc(), cGT ) )
? i, "=>", atail( aThreads )
next
? "Waiting for threads"
while inkey() != K_ESC
if hb_threadWait( aThreads, 0.1, .T. ) == len( aThreads )
wait
exit
endif
?? "."
enddo
return
proc thFunc( cGT )
/* allocate own GT driver */
hb_gtReload( cGT )
if ! dbExists( "test" ) .and. dbExists( "../test" )
use ../test shared
else
use test shared
endif
browse()
return