basis/concurrency/messaging/messaging-tests.factor

   1 ! Copyright (C) 2005 Chris Double. All Rights Reserved.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel threads vectors arrays sequences namespaces make
   4 tools.test continuations deques strings math words match
   5 quotations concurrency.messaging concurrency.mailboxes
   6 concurrency.count-downs accessors ;
   7 IN: concurrency.messaging.tests
   8
   9 [ ] [ my-mailbox data>> clear-deque ] unit-test
  10
  11 [ "received" ] [
  12     [
  13         receive "received" swap reply-synchronous
  14     ] "Synchronous test" spawn
  15     "sent" swap send-synchronous
  16 ] unit-test
  17
  18 [ 1 3 2 ] [
  19     1 self send
  20     2 self send
  21     3 self send
  22     receive
  23     [ 2 mod 0 = not ] receive-if
  24     receive
  25 ] unit-test
  26
  27 [
  28     [
  29         "crash" throw
  30     ] "Linked test" spawn-linked drop
  31     receive
  32 ] [ error>> "crash" = ] must-fail-with
  33
  34 MATCH-VARS: ?from ?to ?value ;
  35 SYMBOL: increment
  36 SYMBOL: decrement
  37 SYMBOL: value
  38 SYMBOL: exit
  39
  40 : counter ( value -- value ? )
  41     receive {
  42         { { increment ?value } [ ?value + t ] }
  43         { { decrement ?value } [ ?value - t ] }
  44         { { value ?from }      [ dup ?from send t ] }
  45         { exit                 [ f ] }
  46     } match-cond ;
  47
  48 [ -5 ] [
  49     [ 0 [ counter ] loop ] "Counter" spawn "counter" set
  50     { increment 10 } "counter" get send
  51     { decrement 15 } "counter" get send
  52     [ value , self , ] { } make "counter" get send
  53     receive
  54     exit "counter" get send
  55 ] unit-test
  56
  57 ! Not yet
  58
  59 ! 1 <count-down> "c" set
  60
  61 ! [
  62 !     "c" get count-down
  63 !     receive drop
  64 ! ] "Bad synchronous send" spawn "t" set
  65
  66 ! [ 3 "t" get send-synchronous ] must-fail