2008-05-07 04:28:45 -04:00
|
|
|
USING: tools.test concurrency.flags concurrency.combinators
|
2008-11-19 02:50:05 -05:00
|
|
|
kernel threads locals accessors calendar ;
|
2009-08-13 20:21:44 -04:00
|
|
|
IN: concurrency.flags.tests
|
2008-02-29 20:10:30 -05:00
|
|
|
|
2008-11-30 19:28:15 -05:00
|
|
|
:: flag-test-1 ( -- val )
|
2009-10-27 22:50:31 -04:00
|
|
|
<flag> :> f
|
|
|
|
[ f raise-flag ] "Flag test" spawn drop
|
|
|
|
f lower-flag
|
|
|
|
f value>> ;
|
2008-02-29 20:10:30 -05:00
|
|
|
|
|
|
|
[ f ] [ flag-test-1 ] unit-test
|
|
|
|
|
2009-04-17 15:44:08 -04:00
|
|
|
:: flag-test-2 ( -- ? )
|
2009-10-27 22:50:31 -04:00
|
|
|
<flag> :> f
|
|
|
|
[ 1 seconds sleep f raise-flag ] "Flag test" spawn drop
|
|
|
|
f lower-flag
|
|
|
|
f value>> ;
|
2008-02-29 20:10:30 -05:00
|
|
|
|
|
|
|
[ f ] [ flag-test-2 ] unit-test
|
|
|
|
|
2008-11-30 19:28:15 -05:00
|
|
|
:: flag-test-3 ( -- val )
|
2009-10-27 22:50:31 -04:00
|
|
|
<flag> :> f
|
|
|
|
f raise-flag
|
|
|
|
f value>> ;
|
2008-02-29 20:10:30 -05:00
|
|
|
|
|
|
|
[ t ] [ flag-test-3 ] unit-test
|
|
|
|
|
2008-11-30 19:28:15 -05:00
|
|
|
:: flag-test-4 ( -- val )
|
2009-10-27 22:50:31 -04:00
|
|
|
<flag> :> f
|
|
|
|
[ f raise-flag ] "Flag test" spawn drop
|
|
|
|
f wait-for-flag
|
|
|
|
f value>> ;
|
2008-02-29 20:10:30 -05:00
|
|
|
|
|
|
|
[ t ] [ flag-test-4 ] unit-test
|
|
|
|
|
2008-11-30 19:28:15 -05:00
|
|
|
:: flag-test-5 ( -- val )
|
2009-10-27 22:50:31 -04:00
|
|
|
<flag> :> f
|
|
|
|
[ 1 seconds sleep f raise-flag ] "Flag test" spawn drop
|
|
|
|
f wait-for-flag
|
|
|
|
f value>> ;
|
2008-02-29 20:10:30 -05:00
|
|
|
|
|
|
|
[ t ] [ flag-test-5 ] unit-test
|
2008-05-07 04:28:45 -04:00
|
|
|
|
|
|
|
[ ] [
|
|
|
|
{ 1 2 } <flag>
|
2008-11-19 02:50:05 -05:00
|
|
|
[ [ 1 seconds sleep raise-flag ] curry "Flag test" spawn drop ]
|
2008-05-07 04:28:45 -04:00
|
|
|
[ [ wait-for-flag drop ] curry parallel-each ] bi
|
|
|
|
] unit-test
|