Files
harbour-core/tests/mt/mttest02.prg
Viktor Szakats 58faf91453 2016-01-14 19:17 UTC+0100 Viktor Szakats (vszakats users.noreply.github.com)
* *
    % remove brandings and homepage [1] from copyright header. Pass 1 - using script.
      [1] nobody has access to it anymore AFAIK - and it's also just
          a redirect since long
    ! update url in copyright header
    ; this should make the diff between 3.4 and 3.2 easier to manage
2016-01-14 19:18:17 +01:00

64 lines
1.3 KiB
Plaintext

/*
* demonstration/test code for using QUIT commands and ALWAYS statements
* execution. Child thread uses QUIT before main one.
*
* Copyright 2008 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
*/
#ifdef __XHARBOUR__
#xtranslate hb_threadStart( <x,...> ) => StartThread( <x> )
#xtranslate hb_threadJoin( <x,...> ) => JoinThread( <x> )
#command begin sequence => try
#command always => finally
#endif
proc main()
local thID, i
? Version()
? "Main start"
thID := hb_threadStart( @thFunc(), "A", "B", "C" )
? "Thread ID:", thID
? "==================="
?
begin sequence
for i := 1 to 10
?? "M"
hb_idleSleep( 0.050 )
next
? "==================="
? "Main QUIT"
quit
always
? "Main ALWAYS section"
?
endsequence
? "End of main"
return
proc thFunc( ... )
local i
? "Thread begin"
? "Parameters:"
aeval( hb_aParams(), {| x | qqout( "", x ) } )
?
begin sequence
for i := 1 to 10
?? "t"
hb_idleSleep( 0.030 )
if i == 5
? "Thread QUIT"
quit
endif
next
always
? "Thread ALWAYS section"
?
endsequence
? "Thread end"
?
return
exit proc p
? "I'm EXIT procedure"