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