basis/concurrency/mailboxes/mailboxes-tests.factor

   1 USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions\r
   2 vectors sequences threads tools.test math kernel strings namespaces\r
   3 continuations calendar destructors ;\r
   4 IN: concurrency.mailboxes.tests\r
   5 \r
   6 { 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as\r
   7 \r
   8 [ V{ 1 2 3 } ] [\r
   9     0 <vector>\r
  10     <mailbox>\r
  11     [ mailbox-get swap push ] in-thread\r
  12     [ mailbox-get swap push ] in-thread\r
  13     [ mailbox-get swap push ] in-thread\r
  14     1 over mailbox-put\r
  15     2 over mailbox-put\r
  16     3 swap mailbox-put\r
  17 ] unit-test\r
  18 \r
  19 [ V{ 1 2 3 } ] [\r
  20     0 <vector>\r
  21     <mailbox>\r
  22     [ [ integer? ] mailbox-get? swap push ] in-thread\r
  23     [ [ integer? ] mailbox-get? swap push ] in-thread\r
  24     [ [ integer? ] mailbox-get? swap push ] in-thread\r
  25     1 over mailbox-put\r
  26     2 over mailbox-put\r
  27     3 swap mailbox-put\r
  28 ] unit-test\r
  29 \r
  30 [ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [\r
  31     0 <vector>\r
  32     <mailbox>\r
  33     [ [ integer? ] mailbox-get? swap push ] in-thread\r
  34     [ [ integer? ] mailbox-get? swap push ] in-thread\r
  35     [ [ string? ] mailbox-get? swap push ] in-thread\r
  36     [ [ string? ] mailbox-get? swap push ] in-thread\r
  37     1 over mailbox-put\r
  38     "junk" over mailbox-put\r
  39     [ 456 ] over mailbox-put\r
  40     3 over mailbox-put\r
  41     "junk2" over mailbox-put\r
  42     mailbox-get\r
  43 ] unit-test\r
  44 \r
  45 <mailbox> "m" set\r
  46 \r
  47 1 <count-down> "c" set\r
  48 1 <count-down> "d" set\r
  49 \r
  50 [\r
  51     "c" get await\r
  52     [ "m" get mailbox-get drop ]\r
  53     [ drop "d" get count-down ] recover\r
  54 ] "Mailbox close test" spawn drop\r
  55 \r
  56 [ ] [ "c" get count-down ] unit-test\r
  57 [ ] [ "m" get dispose ] unit-test\r
  58 [ ] [ "d" get 5 seconds await-timeout ] unit-test\r
  59 \r
  60 [ ] [ "m" get dispose ] unit-test\r
  61 \r
  62 <mailbox> "m" set\r
  63 \r
  64 1 <count-down> "c" set\r
  65 1 <count-down> "d" set\r
  66 \r
  67 [\r
  68     "c" get await\r
  69     "m" get wait-for-close\r
  70     "d" get count-down\r
  71 ] "Mailbox close test" spawn drop\r
  72 \r
  73 [ ] [ "c" get count-down ] unit-test\r
  74 [ ] [ "m" get dispose ] unit-test\r
  75 [ ] [ "d" get 5 seconds await-timeout ] unit-test\r
  76 \r
  77 [ ] [ "m" get dispose ] unit-test\r
  78 \r
  79 [ { "foo" "bar" } ] [\r
  80     <mailbox>\r
  81     "foo" over mailbox-put\r
  82     "bar" over mailbox-put\r
  83     mailbox-get-all\r
  84 ] unit-test\r
  85 \r
  86 [\r
  87     <mailbox> 1 seconds mailbox-get-timeout\r
  88 ] [ wait-timeout? ] must-fail-with\r
  89     \r