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 USING: accessors arrays concurrency.flags fry io io.encodings.ascii
io.encodings.ascii io.encodings.utf8 io.servers io.encodings.utf8 io.servers.private io.sockets kernel namespaces
io.servers.private io.sockets kernel namespaces scratchpad sequences sets threads tools.test ;
sequences threads tools.test ;
IN: io.servers IN: io.servers
{ t } [ ascii <threaded-server> listen-on empty? ] unit-test { t } [ ascii <threaded-server> listen-on empty? ] unit-test
@ -69,4 +68,16 @@ TUPLE: my-threaded-server < threaded-server ;
2array >>secure 2array >>secure
start-server stop-server 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 <PRIVATE
: must-be-running ( threaded-server -- threaded-server ) : add-running-server ( threaded-server running-servers -- )
dup running-servers get in? [ server-not-running ] unless ; 2dup in? [ server-already-running ] [ adjoin ] if ;
: must-not-be-running ( threaded-server -- threaded-server ) : remove-running-server ( threaded-server running-servers -- )
dup running-servers get in? [ server-already-running ] when ; 2dup in? [ delete ] [ drop server-not-running ] if ;
: 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 ;
PRIVATE> PRIVATE>
@ -181,7 +173,7 @@ PRIVATE>
[ ] [ name>> ] bi [ ] [ name>> ] bi
[ [
set-servers set-servers
dup add-running-server dup running-servers get add-running-server
dup servers>> dup servers>>
[ [
[ '[ _ _ [ start-accept-loop ] with-disposal ] ] [ '[ _ _ [ start-accept-loop ] with-disposal ] ]
@ -196,7 +188,7 @@ PRIVATE>
: stop-server ( threaded-server -- ) : stop-server ( threaded-server -- )
dup server-running? [ dup server-running? [
[ remove-running-server ] [ running-servers get remove-running-server ]
[ [
[ [
[ secure-context>> [ &dispose drop ] when* ] [ secure-context>> [ &dispose drop ] when* ]