basis/io/servers/servers-tests.factor

   1 USING: accessors arrays concurrency.flags fry io io.encodings.ascii
   2 io.encodings.utf8 io.servers.private io.sockets kernel namespaces
   3 sequences sets threads tools.test ;
   4 IN: io.servers
   5
   6 { t } [ ascii <threaded-server> listen-on empty? ] unit-test
   7
   8 { f } [
   9     ascii <threaded-server>
  10         25 internet-server >>insecure
  11     listen-on
  12     empty?
  13 ] unit-test
  14
  15 { t } [
  16     T{ inet4 f "1.2.3.4" 1234 } T{ inet4 f "1.2.3.5" 1235 }
  17     [ log-connection ] 2keep
  18     [ remote-address get = ] [ local-address get = ] bi*
  19     and
  20 ] unit-test
  21
  22 { } [ ascii <threaded-server> init-server drop ] unit-test
  23
  24 { 10 } [
  25     ascii <threaded-server>
  26         10 >>max-connections
  27     init-server semaphore>> count>>
  28 ] unit-test
  29
  30 { "Hello world." } [
  31     ascii <threaded-server>
  32         5 >>max-connections
  33         0 >>insecure
  34         [ "Hello world." write stop-this-server ] >>handler
  35     [
  36         insecure-addr ascii <client> drop stream-contents
  37     ] with-threaded-server
  38 ] unit-test
  39
  40 { } [
  41     ascii <threaded-server>
  42         5 >>max-connections
  43         0 >>insecure
  44     start-server [ '[ _ wait-for-server ] in-thread ] [ stop-server ] bi
  45 ] unit-test
  46
  47 ipv6-supported? [
  48     { f } [
  49         ascii <threaded-server>
  50             "localhost" 1234 inet boa >>insecure
  51         listen-on
  52         [ inet6? ] any?
  53     ] unit-test
  54 ] unless
  55
  56
  57 ! Test that we can listen on several ports at once.
  58 TUPLE: my-threaded-server < threaded-server ;
  59
  60 { } [
  61     utf8 my-threaded-server new-threaded-server
  62         "127.0.0.1" 0 <inet4>
  63         "127.0.0.1" 0 <inet4>
  64         2array >>insecure
  65
  66         "127.0.0.1" 0 <inet4>
  67         "127.0.0.1" 0 <inet4>
  68         2array >>secure
  69
  70         start-server stop-server
  71 ] unit-test
  72
  73 ! add-running-server
  74 [
  75     ascii <threaded-server> HS{ } clone 2dup adjoin
  76     add-running-server
  77 ] [ server-already-running? ] must-fail-with
  78
  79 ! stop-server
  80 [
  81     ascii <threaded-server> <flag> >>server-stopped
  82     stop-server
  83 ] [ server-not-running? ] must-fail-with