basis/concurrency/flags/flags-tests.factor

   1 IN: concurrency.flags.tests\r
   2 USING: tools.test concurrency.flags concurrency.combinators\r
   3 kernel threads locals accessors calendar ;\r
   4 \r
   5 :: flag-test-1 ( -- val )\r
   6     [let | f [ <flag> ] |\r
   7         [ f raise-flag ] "Flag test" spawn drop\r
   8         f lower-flag\r
   9         f value>>\r
  10     ] ;\r
  11 \r
  12 [ f ] [ flag-test-1 ] unit-test\r
  13 \r
  14 :: flag-test-2 ( -- )\r
  15     [let | f [ <flag> ] |\r
  16         [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop\r
  17         f lower-flag\r
  18         f value>>\r
  19     ] ;\r
  20 \r
  21 [ f ] [ flag-test-2 ] unit-test\r
  22 \r
  23 :: flag-test-3 ( -- val )\r
  24     [let | f [ <flag> ] |\r
  25         f raise-flag\r
  26         f value>>\r
  27     ] ;\r
  28 \r
  29 [ t ] [ flag-test-3 ] unit-test\r
  30 \r
  31 :: flag-test-4 ( -- val )\r
  32     [let | f [ <flag> ] |\r
  33         [ f raise-flag ] "Flag test" spawn drop\r
  34         f wait-for-flag\r
  35         f value>>\r
  36     ] ;\r
  37 \r
  38 [ t ] [ flag-test-4 ] unit-test\r
  39 \r
  40 :: flag-test-5 ( -- val )\r
  41     [let | f [ <flag> ] |\r
  42         [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop\r
  43         f wait-for-flag\r
  44         f value>>\r
  45     ] ;\r
  46 \r
  47 [ t ] [ flag-test-5 ] unit-test\r
  48 \r
  49 [ ] [\r
  50     { 1 2 } <flag>\r
  51     [ [ 1 seconds sleep raise-flag ] curry "Flag test" spawn drop ]\r
  52     [ [ wait-for-flag drop ] curry parallel-each ] bi\r
  53 ] unit-test\r