2008-03-01 17:00:45 -05:00
|
|
|
IN: concurrency.flags.tests
|
2008-02-29 20:10:30 -05:00
|
|
|
USING: tools.test concurrency.flags kernel threads locals ;
|
|
|
|
|
|
|
|
|
|
:: flag-test-1 ( -- )
|
|
|
|
|
[let | f [ <flag> ] |
|
|
|
|
|
[ f raise-flag ] "Flag test" spawn drop
|
|
|
|
|
f lower-flag
|
|
|
|
|
f flag-value?
|
|
|
|
|
] ;
|
|
|
|
|
|
|
|
|
|
[ f ] [ flag-test-1 ] unit-test
|
|
|
|
|
|
|
|
|
|
:: flag-test-2 ( -- )
|
|
|
|
|
[let | f [ <flag> ] |
|
|
|
|
|
[ 1000 sleep f raise-flag ] "Flag test" spawn drop
|
|
|
|
|
f lower-flag
|
|
|
|
|
f flag-value?
|
|
|
|
|
] ;
|
|
|
|
|
|
|
|
|
|
[ f ] [ flag-test-2 ] unit-test
|
|
|
|
|
|
|
|
|
|
:: flag-test-3 ( -- )
|
|
|
|
|
[let | f [ <flag> ] |
|
|
|
|
|
f raise-flag
|
|
|
|
|
f flag-value?
|
|
|
|
|
] ;
|
|
|
|
|
|
|
|
|
|
[ t ] [ flag-test-3 ] unit-test
|
|
|
|
|
|
|
|
|
|
:: flag-test-4 ( -- )
|
|
|
|
|
[let | f [ <flag> ] |
|
|
|
|
|
[ f raise-flag ] "Flag test" spawn drop
|
|
|
|
|
f wait-for-flag
|
|
|
|
|
f flag-value?
|
|
|
|
|
] ;
|
|
|
|
|
|
|
|
|
|
[ t ] [ flag-test-4 ] unit-test
|
|
|
|
|
|
|
|
|
|
:: flag-test-5 ( -- )
|
|
|
|
|
[let | f [ <flag> ] |
|
|
|
|
|
[ 1000 sleep f raise-flag ] "Flag test" spawn drop
|
|
|
|
|
f wait-for-flag
|
|
|
|
|
f flag-value?
|
|
|
|
|
] ;
|
|
|
|
|
|
|
|
|
|
[ t ] [ flag-test-5 ] unit-test
|
