basis/io/sockets/sockets-tests.factor

   1 USING: io.sockets io.sockets.private sequences math tools.test
   2 namespaces accessors kernel destructors calendar io.timeouts
   3 io.encodings.utf8 io concurrency.promises threads
   4 io.streams.string present system ;
   5 IN: io.sockets.tests
   6
   7 os unix? [
   8     [ T{ local f "/tmp/foo" } ] [ "/tmp/foo" <local> ] unit-test
   9 ] when
  10
  11 [ T{ inet4 f f 0 } ] [ f 0 <inet4> ] unit-test
  12 [ T{ inet6 f f 0 1 } ] [ f 1 <inet6> ] unit-test
  13
  14 [ T{ inet f "google.com" f } ] [ "google.com" f <inet> ] unit-test
  15
  16 [ T{ inet f "google.com" 0 } ] [ "google.com" 0 <inet> ] unit-test
  17 [ T{ inet f "google.com" 80 } ] [ "google.com" 0 <inet> 80 with-port ] unit-test
  18 [ T{ inet4 f "8.8.8.8" 0 } ] [ "8.8.8.8" 0 <inet4> ] unit-test
  19 [ T{ inet4 f "8.8.8.8" 53 } ] [ "8.8.8.8" 0 <inet4> 53 with-port ] unit-test
  20 [ T{ inet6 f "5:5:5:5:6:6:6:6" 0 12 } ] [ "5:5:5:5:6:6:6:6" 0 <inet6> 12 with-port ] unit-test
  21 [ T{ inet6 f "fe80::1" 1 80 } ] [ T{ ipv6 f "fe80::1" 1 } 80 with-port ] unit-test
  22
  23 : test-sockaddr ( addrspec -- )
  24     [ dup make-sockaddr ] keep parse-sockaddr assert= ;
  25
  26 [ ] [ T{ inet4 f "8.8.8.8" 53 } test-sockaddr ] unit-test
  27 [ ] [ T{ inet6 f "5:5:5:5:6:6:6:6" 0 12 } test-sockaddr ] unit-test
  28 [ ] [ T{ inet6 f "fe80:0:0:0:0:0:0:1" 1 80 } test-sockaddr ] unit-test
  29
  30 [ T{ inet f "google.com" 80 } ] [ "google.com" 80 with-port ] unit-test
  31
  32 ! Test present on addrspecs
  33 [ "4.4.4.4:12" ] [ "4.4.4.4" 12 <inet4> present ] unit-test
  34 [ "::1:12" ] [ "::1" 12 <inet6> present ] unit-test
  35 [ "fe80::1%1:12" ] [ "fe80::1" 1 12 inet6 boa present ] unit-test
  36
  37 [ B{ 1 2 3 4 } ]
  38 [ "1.2.3.4" T{ inet4 } inet-pton ] unit-test
  39
  40 [ "1.2.3.4" ]
  41 [ B{ 1 2 3 4 } T{ inet4 } inet-ntop ] unit-test
  42
  43 [ "255.255.255.255" ]
  44 [ B{ 255 255 255 255 } T{ inet4 } inet-ntop ] unit-test
  45
  46 [ B{ 255 255 255 255 } ]
  47 [ "255.255.255.255" T{ inet4 } inet-pton ] unit-test
  48
  49 [ B{ 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 } ]
  50 [ "1:2:3:4:5:6:7:8" T{ inet6 } inet-pton ] unit-test
  51
  52 [ "1:2:3:4:5:6:7:8" ]
  53 [ B{ 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 } T{ inet6 } inet-ntop ] unit-test
  54
  55 [ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } ]
  56 [ "::" T{ inet6 } inet-pton ] unit-test
  57
  58 [ "0:0:0:0:0:0:0:0" ]
  59 [ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } T{ inet6 } inet-ntop ] unit-test
  60
  61 [ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } ]
  62 [ "1::" T{ inet6 } inet-pton ] unit-test
  63
  64 [ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } ]
  65 [ "::1" T{ inet6 } inet-pton ] unit-test
  66
  67 [ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 } ]
  68 [ "::100" T{ inet6 } inet-pton ] unit-test
  69
  70 [ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 2 } ]
  71 [ "1::2" T{ inet6 } inet-pton ] unit-test
  72
  73 [ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 2 0 3 } ]
  74 [ "1::2:3" T{ inet6 } inet-pton ] unit-test
  75
  76 [ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } ]
  77 [ "1:2::3:4" T{ inet6 } inet-pton ] unit-test
  78
  79 [ "1:2:0:0:0:0:3:4" ]
  80 [ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } T{ inet6 } inet-ntop ] unit-test
  81
  82 [ B{ 0 0 0 0 0 0 0 0 0 127 0 0 0 0 0 1 } ]
  83 [ "::127.0.0.1" T{ inet6 } inet-pton ] unit-test
  84
  85 [ B{ 0 2 0 0 0 0 0 9 0 127 0 0 0 0 0 1 } ]
  86 [ "2::9:127.0.0.1" T{ inet6 } inet-pton ] unit-test
  87
  88 [ "2001:6f8:37a:5:0:0:0:1" ]
  89 [ "2001:6f8:37a:5::1" T{ inet6 } [ inet-pton ] [ inet-ntop ] bi ] unit-test
  90
  91 [ t t ] [
  92     "localhost" 80 <inet> resolve-host
  93     [ length 1 >= ]
  94     [ [ [ inet4? ] [ inet6? ] bi or ] all? ] bi
  95 ] unit-test
  96
  97 [ t t ] [
  98     "localhost" resolve-host
  99     [ length 1 >= ]
 100     [ [ [ ipv4? ] [ ipv6? ] bi or ] all? ] bi
 101 ] unit-test
 102
 103 [ t t ] [
 104     f resolve-host
 105     [ length 1 >= ]
 106     [ [ [ ipv4? ] [ ipv6? ] bi or ] all? ] bi
 107 ] unit-test
 108
 109 [ t t ] [
 110     f 0 <inet> resolve-host
 111     [ length 1 >= ]
 112     [ [ [ ipv4? ] [ ipv6? ] bi or ] all? ] bi
 113 ] unit-test
 114
 115 ! Smoke-test UDP
 116 [ ] [ "127.0.0.1" 0 <inet4> <datagram> "datagram1" set ] unit-test
 117 [ ] [ "datagram1" get addr>> "addr1" set ] unit-test
 118 [ f ] [ "addr1" get port>> 0 = ] unit-test
 119
 120 [ ] [ "127.0.0.1" 0 <inet4> <datagram> "datagram2" set ] unit-test
 121 [ ] [ "datagram2" get addr>> "addr2" set ] unit-test
 122 [ f ] [ "addr2" get port>> 0 = ] unit-test
 123
 124 [ ] [ B{ 1 2 3 4 } "addr2" get "datagram1" get send ] unit-test
 125 [ B{ 1 2 3 4 } ] [ "datagram2" get receive "from" set ] unit-test
 126 [ ] [ B{ 4 3 2 1 } "from" get "datagram2" get send ] unit-test
 127 [ B{ 4 3 2 1 } t ] [ "datagram1" get receive "addr2" get = ] unit-test
 128
 129 [ ] [ "datagram1" get dispose ] unit-test
 130 [ ] [ "datagram2" get dispose ] unit-test
 131
 132 ! Test timeouts
 133 [ ] [ "127.0.0.1" 0 <inet4> <datagram> "datagram3" set ] unit-test
 134
 135 [ ] [ 1 seconds "datagram3" get set-timeout ] unit-test
 136 [ "datagram3" get receive ] must-fail
 137
 138 ! See what happens if other end is closed
 139 [ ] [ <promise> "port" set ] unit-test
 140
 141 [ ] [ "datagram3" get dispose ] unit-test
 142
 143 [ ] [
 144     [
 145         "127.0.0.1" 0 <inet4> utf8 <server>
 146         dup addr>> "port" get fulfill
 147         [
 148             accept drop
 149             dup stream-readln drop
 150             "hello" <string-reader> swap stream-copy
 151         ] with-disposal
 152     ] "Socket close test" spawn drop
 153 ] unit-test
 154
 155 [ "hello" f ] [
 156     "port" get ?promise utf8 [
 157         1 seconds input-stream get set-timeout
 158         1 seconds output-stream get set-timeout
 159         "hi\n" write flush readln readln
 160     ] with-client
 161 ] unit-test
 162
 163 ! Binding to all interfaces should work
 164 [ ] [ f 0 <inet4> <datagram> dispose ] unit-test
 165 [ ] [ f 0 <inet6> <datagram> dispose ] unit-test