io.servers: refactored words for adding & removing servers

char-rename
Björn Lindqvist 2017-01-07 13:32:59 +01:00
parent 20656f0db8
commit 7874f5a547
2 changed files with 22 additions and 19 deletions

View File

@ -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

View File

@ -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* ]