diff --git a/extra/concurrency/distributed/distributed-tests.factor b/extra/concurrency/distributed/distributed-tests.factor index dc20e7ad5c..528e1956b8 100755 --- a/extra/concurrency/distributed/distributed-tests.factor +++ b/extra/concurrency/distributed/distributed-tests.factor @@ -13,8 +13,6 @@ concurrency.messaging continuations accessors prettyprint ; [ ] [ test-node dup (start-node) ] unit-test -[ ] [ 1000 sleep ] unit-test - [ ] [ [ receive first2 >r 3 + r> send @@ -30,6 +28,4 @@ concurrency.messaging continuations accessors prettyprint ; receive ] unit-test -[ ] [ 1000 sleep ] unit-test - [ ] [ test-node stop-node ] unit-test diff --git a/extra/concurrency/distributed/distributed.factor b/extra/concurrency/distributed/distributed.factor index 9ae2627505..4da079e812 100755 --- a/extra/concurrency/distributed/distributed.factor +++ b/extra/concurrency/distributed/distributed.factor @@ -12,16 +12,15 @@ SYMBOL: local-node deserialize [ first2 get-process send ] [ stop-server ] if* ; +: ( addrspec -- threaded-server ) + + swap >>insecure + binary >>encoding + "concurrency.distributed" >>name + [ handle-node-client ] >>handler ; + : (start-node) ( addrspec addrspec -- ) - local-node set-global - [ - - swap >>insecure - binary >>encoding - "concurrency.distributed" >>name - [ handle-node-client ] >>handler - start-server - ] curry "Distributed concurrency server" spawn drop ; + local-node set-global start-server* ; : start-node ( port -- ) host-name over (start-node) ; diff --git a/extra/http/http-tests.factor b/extra/http/http-tests.factor index 2a02d2cc20..9b95dc1408 100755 --- a/extra/http/http-tests.factor +++ b/extra/http/http-tests.factor @@ -190,6 +190,13 @@ test-db [ init-furnace-tables ] with-db +: test-httpd ( -- ) + #! Return as soon as server is running. + + 1237 >>insecure + f >>secure + start-server* ; + [ ] [ [ @@ -202,12 +209,10 @@ test-db [ "redirect-loop" add-responder main-responder set - [ 1237 httpd ] "HTTPD test" spawn drop + test-httpd ] with-scope ] unit-test -[ ] [ 100 sleep ] unit-test - [ t ] [ "resource:extra/http/test/foo.html" ascii file-contents "http://localhost:1237/nested/foo.html" http-get nip ascii decode = @@ -235,12 +240,10 @@ test-db [ test-db main-responder set - [ 1237 httpd ] "HTTPD test" spawn drop + test-httpd ] with-scope ] unit-test -[ ] [ 100 sleep ] unit-test - : 404? [ download-failed? ] [ response>> code>> 404 = ] bi and ; ! This should give a 404 not an infinite redirect loop @@ -262,12 +265,10 @@ test-db [ test-db main-responder set - [ 1237 httpd ] "HTTPD test" spawn drop + test-httpd ] with-scope ] unit-test -[ ] [ 100 sleep ] unit-test - [ "Hi" ] [ "http://localhost:1237/" http-get nip ] unit-test [ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test @@ -293,12 +294,10 @@ SYMBOL: a test-db main-responder set - [ 1237 httpd ] "HTTPD test" spawn drop + test-httpd ] with-scope ] unit-test -[ ] [ 100 sleep ] unit-test - 3 a set-global : test-a string>xml "input" tag-named "value" swap at ; diff --git a/extra/io/servers/connection/connection-tests.factor b/extra/io/servers/connection/connection-tests.factor index bb87d67917..84e0d684ac 100755 --- a/extra/io/servers/connection/connection-tests.factor +++ b/extra/io/servers/connection/connection-tests.factor @@ -29,18 +29,22 @@ concurrency.promises io.encodings.ascii io threads calendar ; [ ] [ "p" set ] unit-test +[ ] [ + + 5 >>max-connections + 1237 >>insecure + [ "Hello world." write stop-server ] >>handler + "server" set +] unit-test + [ ] [ [ - - 5 >>max-connections - 1237 >>insecure - [ "Hello world." write stop-server ] >>handler - start-server + "server" get start-server t "p" get fulfill ] in-thread ] unit-test -[ ] [ 100 sleep ] unit-test +[ ] [ "server" get wait-for-server ] unit-test [ "Hello world." ] [ "localhost" 1237 ascii drop contents ] unit-test diff --git a/extra/io/servers/connection/connection.factor b/extra/io/servers/connection/connection.factor index cb26ed5722..fa0e2f515d 100755 --- a/extra/io/servers/connection/connection.factor +++ b/extra/io/servers/connection/connection.factor @@ -6,7 +6,8 @@ quotations combinators logging calendar assocs fry accessors arrays io io.sockets io.encodings.ascii io.sockets.secure io.files io.streams.duplex io.timeouts io.encodings threads concurrency.combinators -concurrency.semaphores combinators.short-circuit ; +concurrency.semaphores concurrency.flags +combinators.short-circuit ; IN: io.servers.connection TUPLE: threaded-server @@ -18,7 +19,8 @@ max-connections semaphore timeout encoding -handler ; +handler +ready ; : local-server ( port -- addrspec ) "localhost" swap ; @@ -31,7 +33,8 @@ handler ; 1 minutes >>timeout V{ } clone >>sockets >>secure-config - [ "No handler quotation" throw ] >>handler ; inline + [ "No handler quotation" throw ] >>handler + >>ready ; inline : ( -- threaded-server ) threaded-server new-threaded-server ; @@ -86,11 +89,13 @@ M: threaded-server handle-client* handler>> call ; if* ] [ accept-loop ] bi ; inline -: start-accept-loop ( server -- ) +: started-accept-loop ( server -- ) + threaded-server get + [ sockets>> push ] [ ready>> raise-flag ] bi ; + +: start-accept-loop ( addrspec -- ) threaded-server get encoding>> - [ threaded-server get sockets>> push ] - [ [ accept-loop ] with-disposal ] - bi ; + [ started-accept-loop ] [ [ accept-loop ] with-disposal ] bi ; \ start-accept-loop ERROR add-error-logging @@ -115,6 +120,14 @@ PRIVATE> ] with-variable ] with-secure-context ; +: wait-for-server ( threaded-server -- ) + ready>> wait-for-flag ; + +: start-server* ( threaded-server -- ) + [ [ start-server ] curry "Threaded server" spawn drop ] + [ wait-for-server ] + bi ; + : stop-server ( -- ) threaded-server get [ f ] change-sockets drop dispose-each ;