2008-03-01 17:00:45 -05:00
|
|
|
IN: concurrency.mailboxes.tests
|
2008-04-11 08:15:26 -04:00
|
|
|
USING: concurrency.mailboxes concurrency.count-downs vectors
|
|
|
|
|
sequences threads tools.test math kernel strings namespaces
|
2008-05-15 01:03:21 -04:00
|
|
|
continuations calendar destructors ;
|
2008-02-22 00:47:06 -05:00
|
|
|
|
2008-08-24 04:59:37 -04:00
|
|
|
{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as
|
|
|
|
|
|
2008-02-22 00:47:06 -05:00
|
|
|
[ V{ 1 2 3 } ] [
|
|
|
|
|
0 <vector>
|
|
|
|
|
<mailbox>
|
|
|
|
|
[ mailbox-get swap push ] in-thread
|
|
|
|
|
[ mailbox-get swap push ] in-thread
|
|
|
|
|
[ mailbox-get swap push ] in-thread
|
|
|
|
|
1 over mailbox-put
|
|
|
|
|
2 over mailbox-put
|
|
|
|
|
3 swap mailbox-put
|
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
|
|
[ V{ 1 2 3 } ] [
|
|
|
|
|
0 <vector>
|
|
|
|
|
<mailbox>
|
2008-03-20 21:14:07 -04:00
|
|
|
[ [ integer? ] mailbox-get? swap push ] in-thread
|
|
|
|
|
[ [ integer? ] mailbox-get? swap push ] in-thread
|
|
|
|
|
[ [ integer? ] mailbox-get? swap push ] in-thread
|
2008-02-22 00:47:06 -05:00
|
|
|
1 over mailbox-put
|
|
|
|
|
2 over mailbox-put
|
|
|
|
|
3 swap mailbox-put
|
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
|
|
[ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [
|
|
|
|
|
0 <vector>
|
|
|
|
|
<mailbox>
|
2008-03-20 21:14:07 -04:00
|
|
|
[ [ integer? ] mailbox-get? swap push ] in-thread
|
|
|
|
|
[ [ integer? ] mailbox-get? swap push ] in-thread
|
|
|
|
|
[ [ string? ] mailbox-get? swap push ] in-thread
|
|
|
|
|
[ [ string? ] mailbox-get? swap push ] in-thread
|
2008-02-22 00:47:06 -05:00
|
|
|
1 over mailbox-put
|
|
|
|
|
"junk" over mailbox-put
|
|
|
|
|
[ 456 ] over mailbox-put
|
|
|
|
|
3 over mailbox-put
|
|
|
|
|
"junk2" over mailbox-put
|
|
|
|
|
mailbox-get
|
|
|
|
|
] unit-test
|
2008-04-11 08:15:26 -04:00
|
|
|
|
|
|
|
|
<mailbox> "m" set
|
|
|
|
|
|
|
|
|
|
1 <count-down> "c" set
|
|
|
|
|
1 <count-down> "d" set
|
|
|
|
|
|
|
|
|
|
[
|
|
|
|
|
"c" get await
|
|
|
|
|
[ "m" get mailbox-get drop ]
|
|
|
|
|
[ drop "d" get count-down ] recover
|
|
|
|
|
] "Mailbox close test" spawn drop
|
|
|
|
|
|
|
|
|
|
[ ] [ "c" get count-down ] unit-test
|
|
|
|
|
[ ] [ "m" get dispose ] unit-test
|
|
|
|
|
[ ] [ "d" get 5 seconds await-timeout ] unit-test
|
|
|
|
|
|
|
|
|
|
[ ] [ "m" get dispose ] unit-test
|
|
|
|
|
|
|
|
|
|
<mailbox> "m" set
|
|
|
|
|
|
|
|
|
|
1 <count-down> "c" set
|
|
|
|
|
1 <count-down> "d" set
|
|
|
|
|
|
|
|
|
|
[
|
|
|
|
|
"c" get await
|
|
|
|
|
"m" get wait-for-close
|
|
|
|
|
"d" get count-down
|
|
|
|
|
] "Mailbox close test" spawn drop
|
|
|
|
|
|
|
|
|
|
[ ] [ "c" get count-down ] unit-test
|
|
|
|
|
[ ] [ "m" get dispose ] unit-test
|
|
|
|
|
[ ] [ "d" get 5 seconds await-timeout ] unit-test
|
|
|
|
|
|
|
|
|
|
[ ] [ "m" get dispose ] unit-test
|
