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