io.servers: refactored words for adding & removing servers

diff --git a/basis/io/servers/servers-tests.factor b/basis/io/servers/servers-tests.factor
index bea66ad07a515e57efac462a29c44e7079e9e9a0..316d1e09e3bcd8f7d1408191dafc83430ac553f4 100644 (file)
--- a/basis/io/servers/servers-tests.factor
+++ b/basis/io/servers/servers-tests.factor
@@ -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
\ No newline at end of file
+] 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

diff --git a/basis/io/servers/servers.factor b/basis/io/servers/servers.factor
index 0a264824f6040032c96a8c4f9adaf2833de81c78..55b364b18cf4521b1f8de702b11290a9a392f109 100755 (executable)
--- a/basis/io/servers/servers.factor
+++ b/basis/io/servers/servers.factor
@@ -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* ]