1Stream subclass: DummyStream [ 2 <category: 'Sockets-Tests'> 3 4 | n | 5 DummyStream class >> new [ ^super new initialize ] 6 initialize [ n := 0 ] 7 nextPut: anObject [ n := n + 1 ] 8 next: anInteger putAll: aCollection startingAt: pos [ n := n + anInteger ] 9 size [ ^n ] 10] 11 12Socket class extend [ 13 14 microTest [ 15 "Extremely small test (try to receive SMTP header)" 16 17 <category: 'tests'> 18 | s | 19 s := Socket remote: IPAddress anyLocalAddress port: 25. 20 (s upTo: Character cr) printNl. 21 s close 22 ] 23 24 testPort2For: anAddressClass [ 25 <category: 'tests'> 26 anAddressClass == UnixAddress ifTrue: [ ^'/tmp/gst.test2' ]. 27 ^54322 28 ] 29 30 testPortFor: anAddressClass [ 31 <category: 'tests'> 32 anAddressClass == UnixAddress ifTrue: [ ^'/tmp/gst.test' ]. 33 ^54321 34 ] 35 36 tweakedLoopbackTest [ 37 "Send data from one socket to another on the local machine, trying to avoid 38 buffering overhead. Tests most of the socket primitives. Comparison of 39 the results of loopbackTest and tweakedLoopbackTest should give a measure 40 of the overhead of buffering when sending/receiving large quantities of 41 data." 42 43 <category: 'tests'> 44 ^self loopbackTest: #(5000 4000) 45 ] 46 47 loopbackTest [ 48 "Send data from one socket to another on the local machine. Tests most of 49 the socket primitives." 50 51 <category: 'tests'> 52 ^self loopbackTest: nil 53 ] 54 55 loopbackTest: bufferSizes [ 56 "Send data from one socket to another on the local machine. Tests most of 57 the socket primitives. The parameter is the size of the input and 58 output buffer sizes." 59 60 <category: 'tests'> 61 ^self loopbackTest: bufferSizes addressClass: Socket defaultAddressClass 62 ] 63 64 loopbackTestOn: addressClass [ 65 "Send data from one socket to another on the local machine. Tests most of 66 the socket primitives. The parameter is the address class (family) 67 to use." 68 69 <category: 'tests'> 70 ^self loopbackTest: nil addressClass: addressClass 71 ] 72 73 loopbackTest: bufferSizes addressClass: addressClass [ 74 "Send data from one socket to another on the local machine. Tests most of 75 the socket primitives. The parameters are the size of the input and 76 output buffer sizes, and the address class (family) to use." 77 78 <category: 'tests'> 79 | queue server client bytesToSend sendBuf bytesSent bytesReceived 80 t extraBytes timeout process recvBuf | 81 Transcript 82 cr; 83 show: 'starting loopback test'; 84 cr. 85 queue := ServerSocket 86 port: (self testPortFor: addressClass) 87 queueSize: 5 88 bindTo: addressClass loopbackHost. 89 client := Socket remote: queue localAddress port: (self testPortFor: addressClass). 90 bufferSizes isNil 91 ifFalse: 92 [client 93 readBufferSize: (bufferSizes at: 1); 94 writeBufferSize: (bufferSizes at: 2)]. 95 timeout := false. 96 process := 97 [(Delay forMilliseconds: Socket timeout) wait. 98 timeout := true] fork. 99 100 [timeout ifTrue: [self error: 'could not establish connection']. 101 (server := queue accept: StreamSocket) isNil] 102 whileTrue: [Processor yield]. 103 process terminate. 104 Transcript 105 show: 'connection established'; 106 cr. 107 bytesToSend := 5000000. 108 sendBuf := String new: 4000 withAll: $x. 109 recvBuf := DummyStream new. 110 bytesSent := bytesReceived := 0. 111 t := Time millisecondsToRun: 112 [ 113 [server nextPutAll: sendBuf. 114 bytesSent := bytesSent + sendBuf size. 115 [client canRead] whileTrue: 116 [client nextAvailablePutAllOn: recvBuf. 117 bytesReceived := recvBuf size]. 118 bytesSent >= bytesToSend and: [bytesReceived = bytesSent]] 119 whileFalse]. 120 Transcript 121 show: 'closing connection'; 122 cr. 123 extraBytes := client bufferContents size. 124 server close. 125 extraBytes > 0 126 ifTrue: 127 [Transcript 128 show: ' *** received ' , extraBytes size printString , ' extra bytes ***'; 129 cr]. 130 client close. 131 queue close. 132 Transcript 133 show: 'loopback test done; ' , (t / 1000.0) printString , ' seconds'; 134 cr; 135 show: (bytesToSend asFloat / t roundTo: 0.01) printString; 136 showCr: ' kBytes/sec' 137 ] 138 139 producerConsumerTest [ 140 "Send data from one datagram socket to another on the local machine. Tests most of the 141 socket primitives and works with different processes." 142 143 <category: 'tests'> 144 ^self producerConsumerTestOn: Socket defaultAddressClass 145 ] 146 147 producerConsumerTestOn: addressClass [ 148 "Send data from one socket to another on the local machine. Tests most of the 149 socket primitives and works with different processes." 150 151 <category: 'tests'> 152 | bytesToSend bytesSent bytesReceived t server client queue sema producer consumer queueReady | 153 Transcript 154 cr; 155 show: 'starting loopback test'; 156 cr. 157 sema := Semaphore new. 158 queueReady := Semaphore new. 159 bytesToSend := 5000000. 160 bytesSent := bytesReceived := 0. 161 t := Time millisecondsToRun: 162 [producer := 163 [| timeout process sendBuf | 164 queue := ServerSocket 165 port: (self testPortFor: addressClass) 166 queueSize: 5 167 bindTo: addressClass loopbackHost. 168 queueReady signal. 169 timeout := false. 170 process := 171 [(Delay forMilliseconds: Socket timeout) wait. 172 timeout := true] fork. 173 174 [timeout ifTrue: [self error: 'could not establish connection']. 175 (server := queue accept ": StreamSocket") isNil] 176 whileTrue: [Processor yield]. 177 process terminate. 178 Transcript 179 show: 'connection established'; 180 cr. 181 sendBuf := String new: 4000 withAll: $x. 182 183 [server nextPutAll: sendBuf. 184 bytesSent := bytesSent + sendBuf size. 185 bytesSent >= bytesToSend] 186 whileFalse: [Processor yield]. 187 sema signal] 188 fork. 189 consumer := 190 [| recvBuf | 191 recvBuf := DummyStream new. 192 queueReady wait. 193 client := Socket remote: queue localAddress port: (self testPortFor: addressClass). 194 195 [[client canRead] whileTrue: 196 [client nextAvailablePutAllOn: recvBuf. 197 bytesReceived := recvBuf size]. 198 bytesSent >= bytesToSend and: [bytesReceived = bytesSent]] 199 whileFalse: [Processor yield]. 200 sema signal] 201 fork. 202 sema wait. 203 sema wait]. 204 Transcript 205 show: 'closing connection'; 206 cr. 207 server close. 208 client close. 209 queue close. 210 Transcript 211 show: 'loopback test done; ' , (t / 1000.0) printString , ' seconds'; 212 cr; 213 show: (bytesToSend asFloat / t roundTo: 0.01) printString; 214 showCr: ' kBytes/sec' 215 ] 216 217 datagramLoopbackTest [ 218 "Send data from one datagram socket to another on the local machine. Tests most of the 219 socket primitives and works with different processes." 220 221 <category: 'tests'> 222 ^self datagramLoopbackTestOn: Socket defaultAddressClass 223 ] 224 225 datagramLoopbackTestOn: addressClass [ 226 "Send data from one datagram socket to another on the local machine. Tests most of the 227 socket primitives and works with different processes." 228 229 <category: 'tests'> 230 | bytesToSend bytesSent bytesReceived t | 231 Transcript 232 cr; 233 show: 'starting datagram loopback test'; 234 cr. 235 bytesToSend := 5000000. 236 bytesSent := bytesReceived := 0. 237 t := Time millisecondsToRun: 238 [| server client datagram | 239 client := DatagramSocket 240 local: addressClass loopbackHost 241 port: (self testPort2For: addressClass). 242 server := DatagramSocket 243 remote: addressClass loopbackHost 244 port: (self testPort2For: addressClass) 245 local: nil 246 port: (self testPortFor: addressClass). 247 datagram := Datagram data: (String new: 128 withAll: $x) asByteArray. 248 249 [server 250 nextPut: datagram; 251 flush. 252 bytesSent := bytesSent + datagram data size. 253 [client canRead] 254 whileTrue: [bytesReceived := bytesReceived + client next data size]. 255 bytesReceived < bytesToSend] 256 whileTrue. 257 Transcript 258 show: 'closing connection'; 259 cr. 260 server close. 261 client close]. 262 Transcript 263 show: 'udp loopback test done; ' , (t / 1000.0) printString , ' seconds'; 264 cr; 265 show: '% packets lost ' 266 , (100 - (bytesReceived / bytesSent * 100)) asFloat printString; 267 cr; 268 show: (bytesToSend asFloat / t roundTo: 0.01) printString; 269 showCr: ' kBytes/sec' 270 ] 271 272 sendTest [ 273 "Send data to the 'discard' socket of localhost." 274 275 <category: 'tests'> 276 ^self sendTest: '127.0.0.1' 277 ] 278 279 sendTest: host [ 280 "Send data to the 'discard' socket of the given host. Tests the speed of 281 one-way data transfers across the network to the given host. Note that 282 many hosts do not run a discard server." 283 284 "Socket sendTest: 'localhost'" 285 286 <category: 'tests'> 287 | sock bytesToSend sendBuf bytesSent t | 288 Transcript 289 cr; 290 show: 'starting send test'; 291 cr. 292 sock := Socket remote: host port: Socket portDiscard. 293 Transcript 294 show: 'connection established'; 295 cr. 296 bytesToSend := 5000000. 297 sendBuf := String new: 4000 withAll: $x. 298 bytesSent := 0. 299 t := Time millisecondsToRun: 300 [[bytesSent < bytesToSend] whileTrue: 301 [sock 302 nextPutAll: sendBuf; 303 flush. 304 bytesSent := bytesSent + sendBuf size]]. 305 Transcript 306 show: 'closing connection'; 307 cr. 308 sock close. 309 Transcript 310 show: 'send test done; time = ' , (t / 1000.0) printString, ' seconds'; 311 cr; 312 show: (bytesToSend asFloat / t) printString; 313 showCr: ' kBytes/sec' 314 ] 315 316] 317 318