steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix concurrency.distributed tests

char-rename
Chris Double 2016-11-10 23:32:08 +13:00 committed by John Benediktsson
parent 4c3714ac56
commit 5f1400bd0c
1 changed files with 14 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
basis/concurrency/distributed/distributed-tests.factor
View File

@ -1,40 +1,26 @@
USING: tools.test concurrency.distributed kernel io.files USING: arrays calendar concurrency.distributed
io.files.temp io.directories arrays io.sockets system calendar concurrency.messaging io.sockets kernel math namespaces
combinators threads math sequences concurrency.messaging sequences threads tools.test ;
continuations accessors prettyprint io.servers ;
FROM: concurrency.messaging => receive send ; FROM: concurrency.messaging => receive send ;
IN: concurrency.distributed.tests IN: concurrency.distributed.tests
CONSTANT: test-ip "127.0.0.1" CONSTANT: test-ip "127.0.0.1"
CONSTANT: test-port 57234
: test-node-server ( -- threaded-server ) [ 8 ] [
{ local-node get
{ [ os unix? ] [ "distributed-concurrency-test" temp-file <local> ] } test-ip test-port <inet4> start-node
{ [ os windows? ] [ test-ip 0 <inet4> ] } local-node get swap local-node set-global
} cond <node-server> ; local-node [
: test-node-client ( -- addrspec )
{
{ [ os unix? ] [ "distributed-concurrency-test" temp-file <local> ] }
{ [ os windows? ] [ insecure-addr ] }
} cond ;
os unix? [
"distributed-concurrency-test" temp-file ?delete-file
] when
test-node-server [
[ ] [
[ [
receive first2 [ 3 + ] dip send receive first2 [ 3 + ] dip send
"thread-a" unregister-remote-thread "thread-a" unregister-remote-thread
] "Thread A" spawn ] "Thread A" spawn
"thread-a" register-remote-thread "thread-a" register-remote-thread
5 self 2array
test-ip test-port <inet4> "thread-a" <remote-thread> send
100 seconds receive-timeout
stop-node
] with-variable
] unit-test ] unit-test
[ 8 ] [
5 self 2array
test-node-client "thread-a" <remote-thread> send
100 seconds receive-timeout
] unit-test
] with-threaded-server