io.servers: refactored words for adding & removing servers
parent
20656f0db8
commit
7874f5a547
|
@ -1,7 +1,6 @@
|
|||
USING: accessors arrays calendar concurrency.promises fry io
|
||||
io.encodings.ascii io.encodings.utf8 io.servers
|
||||
io.servers.private io.sockets kernel namespaces scratchpad
|
||||
sequences threads tools.test ;
|
||||
USING: accessors arrays concurrency.flags fry io io.encodings.ascii
|
||||
io.encodings.utf8 io.servers.private io.sockets kernel namespaces
|
||||
sequences sets threads tools.test ;
|
||||
IN: io.servers
|
||||
|
||||
{ t } [ ascii <threaded-server> listen-on empty? ] unit-test
|
||||
|
@ -69,4 +68,16 @@ TUPLE: my-threaded-server < threaded-server ;
|
|||
2array >>secure
|
||||
|
||||
start-server stop-server
|
||||
] unit-test
|
||||
] unit-test
|
||||
|
||||
! add-running-server
|
||||
[
|
||||
ascii <threaded-server> HS{ } clone 2dup adjoin
|
||||
add-running-server
|
||||
] [ server-already-running? ] must-fail-with
|
||||
|
||||
! stop-server
|
||||
[
|
||||
ascii <threaded-server> <flag> >>server-stopped
|
||||
stop-server
|
||||
] [ server-not-running? ] must-fail-with
|
||||
|
|
|
@ -33,19 +33,11 @@ ERROR: server-already-running threaded-server ;
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: must-be-running ( threaded-server -- threaded-server )
|
||||
dup running-servers get in? [ server-not-running ] unless ;
|
||||
: add-running-server ( threaded-server running-servers -- )
|
||||
2dup in? [ server-already-running ] [ adjoin ] if ;
|
||||
|
||||
: must-not-be-running ( threaded-server -- threaded-server )
|
||||
dup running-servers get in? [ server-already-running ] when ;
|
||||
|
||||
: add-running-server ( threaded-server -- )
|
||||
must-not-be-running
|
||||
running-servers get adjoin ;
|
||||
|
||||
: remove-running-server ( threaded-server -- )
|
||||
must-be-running
|
||||
running-servers get delete ;
|
||||
: remove-running-server ( threaded-server running-servers -- )
|
||||
2dup in? [ delete ] [ drop server-not-running ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
@ -181,7 +173,7 @@ PRIVATE>
|
|||
[ ] [ name>> ] bi
|
||||
[
|
||||
set-servers
|
||||
dup add-running-server
|
||||
dup running-servers get add-running-server
|
||||
dup servers>>
|
||||
[
|
||||
[ '[ _ _ [ start-accept-loop ] with-disposal ] ]
|
||||
|
@ -196,7 +188,7 @@ PRIVATE>
|
|||
|
||||
: stop-server ( threaded-server -- )
|
||||
dup server-running? [
|
||||
[ remove-running-server ]
|
||||
[ running-servers get remove-running-server ]
|
||||
[
|
||||
[
|
||||
[ secure-context>> [ &dispose drop ] when* ]
|
||||
|
|
Loading…
Reference in New Issue