More robust server tests
parent
bc5c784016
commit
45bc2a0a02
|
@ -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
|
||||
|
|
|
@ -12,16 +12,15 @@ SYMBOL: local-node
|
|||
deserialize
|
||||
[ first2 get-process send ] [ stop-server ] if* ;
|
||||
|
||||
: <node-server> ( addrspec -- threaded-server )
|
||||
<threaded-server>
|
||||
swap >>insecure
|
||||
binary >>encoding
|
||||
"concurrency.distributed" >>name
|
||||
[ handle-node-client ] >>handler ;
|
||||
|
||||
: (start-node) ( addrspec addrspec -- )
|
||||
local-node set-global
|
||||
[
|
||||
<threaded-server>
|
||||
swap >>insecure
|
||||
binary >>encoding
|
||||
"concurrency.distributed" >>name
|
||||
[ handle-node-client ] >>handler
|
||||
start-server
|
||||
] curry "Distributed concurrency server" spawn drop ;
|
||||
local-node set-global <node-server> start-server* ;
|
||||
|
||||
: start-node ( port -- )
|
||||
host-name over <inet> (start-node) ;
|
||||
|
|
|
@ -190,6 +190,13 @@ test-db [
|
|||
init-furnace-tables
|
||||
] with-db
|
||||
|
||||
: test-httpd ( -- )
|
||||
#! Return as soon as server is running.
|
||||
<http-server>
|
||||
1237 >>insecure
|
||||
f >>secure
|
||||
start-server* ;
|
||||
|
||||
[ ] [
|
||||
[
|
||||
<dispatcher>
|
||||
|
@ -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 <db-persistence>
|
||||
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 <db-persistence>
|
||||
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 <db-persistence>
|
||||
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 ;
|
||||
|
|
|
@ -29,18 +29,22 @@ concurrency.promises io.encodings.ascii io threads calendar ;
|
|||
|
||||
[ ] [ <promise> "p" set ] unit-test
|
||||
|
||||
[ ] [
|
||||
<threaded-server>
|
||||
5 >>max-connections
|
||||
1237 >>insecure
|
||||
[ "Hello world." write stop-server ] >>handler
|
||||
"server" set
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
<threaded-server>
|
||||
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 <inet> ascii <client> drop contents ] unit-test
|
||||
|
||||
|
|
|
@ -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 <inet> ;
|
||||
|
||||
|
@ -31,7 +33,8 @@ handler ;
|
|||
1 minutes >>timeout
|
||||
V{ } clone >>sockets
|
||||
<secure-config> >>secure-config
|
||||
[ "No handler quotation" throw ] >>handler ; inline
|
||||
[ "No handler quotation" throw ] >>handler
|
||||
<flag> >>ready ; inline
|
||||
|
||||
: <threaded-server> ( -- 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>> <server>
|
||||
[ 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 ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue