xref: /openbsd-src/gnu/usr.bin/perl/t/io/socket.t (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
16fb12b70Safresh1#!perl
26fb12b70Safresh1
36fb12b70Safresh1# sanity tests for socket functions
46fb12b70Safresh1
56fb12b70Safresh1BEGIN {
66fb12b70Safresh1    chdir 't' if -d 't';
76fb12b70Safresh1
86fb12b70Safresh1    require "./test.pl";
99f11ffb7Safresh1    set_up_inc( '../lib' ) if -d '../lib' && -d '../ext';
10*3d61058aSafresh1    require Config; Config->import;
116fb12b70Safresh1
126fb12b70Safresh1    skip_all_if_miniperl();
136fb12b70Safresh1    for my $needed (qw(d_socket d_getpbyname)) {
146fb12b70Safresh1	if ($Config{$needed} ne 'define') {
156fb12b70Safresh1	    skip_all("-- \$Config{$needed} undefined");
166fb12b70Safresh1	}
176fb12b70Safresh1    }
186fb12b70Safresh1    unless ($Config{extensions} =~ /\bSocket\b/) {
196fb12b70Safresh1	skip_all('-- Socket not available');
206fb12b70Safresh1    }
216fb12b70Safresh1}
226fb12b70Safresh1
236fb12b70Safresh1use strict;
246fb12b70Safresh1use Socket;
256fb12b70Safresh1
269f11ffb7Safresh1our $TODO;
279f11ffb7Safresh1
286fb12b70Safresh1$| = 1; # ensure test output is synchronous so processes don't conflict
296fb12b70Safresh1
306fb12b70Safresh1my $tcp = getprotobyname('tcp')
316fb12b70Safresh1    or skip_all("no tcp protocol available ($!)");
326fb12b70Safresh1my $udp = getprotobyname('udp')
336fb12b70Safresh1    or note "getprotobyname('udp') failed: $!";
346fb12b70Safresh1
356fb12b70Safresh1my $local = gethostbyname('localhost')
366fb12b70Safresh1    or note "gethostbyname('localhost') failed: $!";
376fb12b70Safresh1
386fb12b70Safresh1my $fork = $Config{d_fork} || $Config{d_pseudofork};
396fb12b70Safresh1
406fb12b70Safresh1{
416fb12b70Safresh1    # basic socket creation
426fb12b70Safresh1    socket(my $sock, PF_INET, SOCK_STREAM, $tcp)
436fb12b70Safresh1	or skip_all('socket() for tcp failed ($!), nothing else will work');
446fb12b70Safresh1    ok(close($sock), "close the socket");
456fb12b70Safresh1}
466fb12b70Safresh1
47b46d8ef2Safresh1SKIP:
48b46d8ef2Safresh1{
49b46d8ef2Safresh1    $udp
50b46d8ef2Safresh1        or skip "No udp", 1;
51b46d8ef2Safresh1    # [perl #133853] failed socket creation didn't set error
52b46d8ef2Safresh1    # for bad parameters on Win32
53b46d8ef2Safresh1    $! = 0;
54b46d8ef2Safresh1    socket(my $sock, PF_INET, SOCK_STREAM, $udp)
55b46d8ef2Safresh1        and skip "managed to make a UDP stream socket", 1;
56b46d8ef2Safresh1    ok(0+$!, "error set on failed socket()");
57b46d8ef2Safresh1}
58b46d8ef2Safresh1
596fb12b70Safresh1SKIP: {
606fb12b70Safresh1    # test it all in TCP
619f11ffb7Safresh1    $local or skip("No localhost", 3);
626fb12b70Safresh1
636fb12b70Safresh1    ok(socket(my $serv, PF_INET, SOCK_STREAM, $tcp), "make a tcp socket");
646fb12b70Safresh1    my $bind_at = pack_sockaddr_in(0, $local);
656fb12b70Safresh1    ok(bind($serv, $bind_at), "bind works")
669f11ffb7Safresh1	or skip("Couldn't bind to localhost", 4);
676fb12b70Safresh1    my $bind_name = getsockname($serv);
686fb12b70Safresh1    ok($bind_name, "getsockname() on bound socket");
696fb12b70Safresh1    my ($bind_port) = unpack_sockaddr_in($bind_name);
706fb12b70Safresh1
716fb12b70Safresh1    print "# port $bind_port\n";
726fb12b70Safresh1
736fb12b70Safresh1  SKIP:
746fb12b70Safresh1    {
756fb12b70Safresh1	ok(listen($serv, 5), "listen() works")
766fb12b70Safresh1	  or diag "listen error: $!";
776fb12b70Safresh1
789f11ffb7Safresh1	$fork or skip("No fork", 2);
796fb12b70Safresh1	my $pid = fork;
806fb12b70Safresh1	my $send_data = "test" x 50_000;
816fb12b70Safresh1	if ($pid) {
826fb12b70Safresh1	    # parent
836fb12b70Safresh1	    ok(socket(my $accept, PF_INET, SOCK_STREAM, $tcp),
846fb12b70Safresh1	       "make accept tcp socket");
856fb12b70Safresh1	    ok(my $addr = accept($accept, $serv), "accept() works")
866fb12b70Safresh1		or diag "accept error: $!";
879f11ffb7Safresh1            binmode $accept;
889f11ffb7Safresh1	    SKIP: {
899f11ffb7Safresh1		skip "no fcntl", 1 unless $Config{d_fcntl};
909f11ffb7Safresh1		my $acceptfd = fileno($accept);
919f11ffb7Safresh1		fresh_perl_is(qq(
929f11ffb7Safresh1		    print open(F, "+<&=$acceptfd") ? 1 : 0, "\\n";
939f11ffb7Safresh1		), "0\n", {}, "accepted socket not inherited across exec");
949f11ffb7Safresh1	    }
956fb12b70Safresh1	    my $sent_total = 0;
966fb12b70Safresh1	    while ($sent_total < length $send_data) {
976fb12b70Safresh1		my $sent = send($accept, substr($send_data, $sent_total), 0);
986fb12b70Safresh1		defined $sent or last;
996fb12b70Safresh1		$sent_total += $sent;
1006fb12b70Safresh1	    }
1016fb12b70Safresh1	    my $shutdown = shutdown($accept, 1);
1026fb12b70Safresh1
1036fb12b70Safresh1	    # wait for the remote to close so data isn't lost in
1046fb12b70Safresh1	    # transit on a certain broken implementation
1056fb12b70Safresh1	    <$accept>;
1066fb12b70Safresh1	    # child tests are printed once we hit eof
1076fb12b70Safresh1	    curr_test(curr_test()+5);
1086fb12b70Safresh1	    waitpid($pid, 0);
1096fb12b70Safresh1
1106fb12b70Safresh1	    ok($shutdown, "shutdown() works");
1116fb12b70Safresh1	}
1126fb12b70Safresh1	elsif (defined $pid) {
1139f11ffb7Safresh1	    curr_test(curr_test()+3);
1146fb12b70Safresh1	    #sleep 1;
1156fb12b70Safresh1	    # child
1166fb12b70Safresh1	    ok_child(close($serv), "close server socket in child");
1176fb12b70Safresh1	    ok_child(socket(my $child, PF_INET, SOCK_STREAM, $tcp),
1186fb12b70Safresh1	       "make child tcp socket");
1196fb12b70Safresh1
1206fb12b70Safresh1	    ok_child(connect($child, $bind_name), "connect() works")
1216fb12b70Safresh1		or diag "connect error: $!";
1229f11ffb7Safresh1            binmode $child;
1236fb12b70Safresh1	    my $buf;
1246fb12b70Safresh1	    my $recv_peer = recv($child, $buf, 1000, 0);
125b8851fccSafresh1	    {
1269f11ffb7Safresh1        local $TODO = "[perl #122657] Hurd doesn't populate sin_len correctly"
127b8851fccSafresh1		    if $^O eq "gnu";
1286fb12b70Safresh1		# [perl #118843]
129b8851fccSafresh1		ok_child($recv_peer eq '' || $recv_peer eq getpeername $child,
1306fb12b70Safresh1			 "peer from recv() should be empty or the remote name");
131b8851fccSafresh1	    }
1326fb12b70Safresh1	    while(defined recv($child, my $tmp, 1000, 0)) {
1336fb12b70Safresh1		last if length $tmp == 0;
1346fb12b70Safresh1		$buf .= $tmp;
1356fb12b70Safresh1	    }
1366fb12b70Safresh1	    is_child($buf, $send_data, "check we received the data");
1376fb12b70Safresh1	    close($child);
1386fb12b70Safresh1	    end_child();
1396fb12b70Safresh1
1406fb12b70Safresh1	    exit(0);
1416fb12b70Safresh1	}
1426fb12b70Safresh1	else {
1436fb12b70Safresh1	    # failed to fork
1446fb12b70Safresh1	    diag "fork() failed $!";
1459f11ffb7Safresh1	    skip("fork() failed", 2);
1466fb12b70Safresh1	}
1476fb12b70Safresh1    }
1486fb12b70Safresh1}
1496fb12b70Safresh1
150b46d8ef2Safresh1SKIP: {
151b46d8ef2Safresh1    # test recv/send handling with :utf8
152b46d8ef2Safresh1    # this doesn't appear to have been tested previously, this is
153b46d8ef2Safresh1    # separate to avoid interfering with the data expected above
154b46d8ef2Safresh1    $local or skip("No localhost", 1);
155b46d8ef2Safresh1    $fork or skip("No fork", 1);
156b46d8ef2Safresh1
157b46d8ef2Safresh1    note "recv/send :utf8 tests";
158b46d8ef2Safresh1    ok(socket(my $serv, PF_INET, SOCK_STREAM, $tcp), "make a tcp socket (recv/send :utf8 handling)");
159b46d8ef2Safresh1    my $bind_at = pack_sockaddr_in(0, $local);
160b46d8ef2Safresh1    ok(bind($serv, $bind_at), "bind works")
161b46d8ef2Safresh1	or skip("Couldn't bind to localhost", 1);
162b46d8ef2Safresh1    my $bind_name = getsockname($serv);
163b46d8ef2Safresh1    ok($bind_name, "getsockname() on bound socket");
164b46d8ef2Safresh1    my ($bind_port) = unpack_sockaddr_in($bind_name);
165b46d8ef2Safresh1
166b46d8ef2Safresh1    print "# port $bind_port\n";
167b46d8ef2Safresh1
168b46d8ef2Safresh1  SKIP:
169b46d8ef2Safresh1    {
170b46d8ef2Safresh1	ok(listen($serv, 5), "listen() works")
171b46d8ef2Safresh1	  or diag "listen error: $!";
172b46d8ef2Safresh1
173b46d8ef2Safresh1	my $pid = fork;
174b46d8ef2Safresh1	my $send_data = "test\x80\xFF" x 50_000;
175b46d8ef2Safresh1	if ($pid) {
176b46d8ef2Safresh1	    # parent
177b46d8ef2Safresh1	    ok(socket(my $accept, PF_INET, SOCK_STREAM, $tcp),
178b46d8ef2Safresh1	       "make accept tcp socket");
179b46d8ef2Safresh1	    ok(my $addr = accept($accept, $serv), "accept() works")
180b46d8ef2Safresh1		or diag "accept error: $!";
181b46d8ef2Safresh1            binmode $accept, ':raw:utf8';
182b46d8ef2Safresh1            ok(!eval { send($accept, "ABC", 0); 1 },
183b46d8ef2Safresh1               "should die on send to :utf8 socket");
184b46d8ef2Safresh1            binmode $accept;
185b46d8ef2Safresh1            # check bytes will be sent
186b46d8ef2Safresh1            utf8::upgrade($send_data);
187b46d8ef2Safresh1	    my $sent_total = 0;
188b46d8ef2Safresh1	    while ($sent_total < length $send_data) {
189b46d8ef2Safresh1		my $sent = send($accept, substr($send_data, $sent_total), 0);
190b46d8ef2Safresh1		defined $sent or last;
191b46d8ef2Safresh1		$sent_total += $sent;
192b46d8ef2Safresh1	    }
193b46d8ef2Safresh1	    my $shutdown = shutdown($accept, 1);
194b46d8ef2Safresh1
195b46d8ef2Safresh1	    # wait for the remote to close so data isn't lost in
196b46d8ef2Safresh1	    # transit on a certain broken implementation
197b46d8ef2Safresh1	    <$accept>;
198b46d8ef2Safresh1	    # child tests are printed once we hit eof
199b46d8ef2Safresh1	    curr_test(curr_test()+6);
200b46d8ef2Safresh1	    waitpid($pid, 0);
201b46d8ef2Safresh1
202b46d8ef2Safresh1	    ok($shutdown, "shutdown() works");
203b46d8ef2Safresh1	}
204b46d8ef2Safresh1	elsif (defined $pid) {
205b46d8ef2Safresh1	    curr_test(curr_test()+3);
206b46d8ef2Safresh1	    #sleep 1;
207b46d8ef2Safresh1	    # child
208b46d8ef2Safresh1	    ok_child(close($serv), "close server socket in child");
209b46d8ef2Safresh1	    ok_child(socket(my $child, PF_INET, SOCK_STREAM, $tcp),
210b46d8ef2Safresh1	       "make child tcp socket");
211b46d8ef2Safresh1
212b46d8ef2Safresh1	    ok_child(connect($child, $bind_name), "connect() works")
213b46d8ef2Safresh1		or diag "connect error: $!";
214b46d8ef2Safresh1            binmode $child, ':raw:utf8';
215b46d8ef2Safresh1	    my $buf;
216b46d8ef2Safresh1
217b46d8ef2Safresh1            ok_child(!eval { recv($child, $buf, 1000, 0); 1 },
218b46d8ef2Safresh1                     "recv on :utf8 should die");
219b46d8ef2Safresh1            is_child($buf, "", "buf shouldn't contain anything");
220b46d8ef2Safresh1            binmode $child;
221b46d8ef2Safresh1	    my $recv_peer = recv($child, $buf, 1000, 0);
222b46d8ef2Safresh1	    while(defined recv($child, my $tmp, 1000, 0)) {
223b46d8ef2Safresh1		last if length $tmp == 0;
224b46d8ef2Safresh1		$buf .= $tmp;
225b46d8ef2Safresh1	    }
226b46d8ef2Safresh1	    is_child($buf, $send_data, "check we received the data");
227b46d8ef2Safresh1	    close($child);
228b46d8ef2Safresh1	    end_child();
229b46d8ef2Safresh1
230b46d8ef2Safresh1	    exit(0);
231b46d8ef2Safresh1	}
232b46d8ef2Safresh1	else {
233b46d8ef2Safresh1	    # failed to fork
234b46d8ef2Safresh1	    diag "fork() failed $!";
235b46d8ef2Safresh1	    skip("fork() failed", 2);
236b46d8ef2Safresh1	}
237b46d8ef2Safresh1    }
238b46d8ef2Safresh1}
239b46d8ef2Safresh1
240c0dd97bfSafresh1SKIP:
241c0dd97bfSafresh1{
242c0dd97bfSafresh1    eval { require Errno; defined &Errno::EMFILE }
243c0dd97bfSafresh1      or skip "Can't load Errno or EMFILE not defined", 1;
2449f11ffb7Safresh1    # stdio might return strange values in errno if it runs
2459f11ffb7Safresh1    # out of FILE entries, and does on darwin
2469f11ffb7Safresh1    $^O eq "darwin" && exists $ENV{PERLIO} && $ENV{PERLIO} =~ /stdio/
2479f11ffb7Safresh1      and skip "errno values from stdio are unspecified", 1;
248c0dd97bfSafresh1    my @socks;
249c0dd97bfSafresh1    my $sock_limit = 1000; # don't consume every file in the system
250c0dd97bfSafresh1    # Default limits on various systems I have:
251c0dd97bfSafresh1    #  65536 - Linux
252c0dd97bfSafresh1    #    256 - Solaris
253c0dd97bfSafresh1    #    128 - NetBSD
254c0dd97bfSafresh1    #    256 - Cygwin
255c0dd97bfSafresh1    #    256 - darwin
256c0dd97bfSafresh1    while (@socks < $sock_limit) {
257c0dd97bfSafresh1        socket my $work, PF_INET, SOCK_STREAM, $tcp
258c0dd97bfSafresh1          or last;
259c0dd97bfSafresh1        push @socks, $work;
260c0dd97bfSafresh1    }
261c0dd97bfSafresh1    @socks == $sock_limit
262c0dd97bfSafresh1      and skip "Didn't run out of open handles", 1;
263c0dd97bfSafresh1    is(0+$!, Errno::EMFILE(), "check correct errno for too many files");
264c0dd97bfSafresh1}
265c0dd97bfSafresh1
2669f11ffb7Safresh1{
2679f11ffb7Safresh1    my $sock;
2689f11ffb7Safresh1    my $proto = getprotobyname('tcp');
2699f11ffb7Safresh1    socket($sock, PF_INET, SOCK_STREAM, $proto);
2709f11ffb7Safresh1    accept($sock, $sock);
2719f11ffb7Safresh1    ok('RT #7614: still alive after accept($sock, $sock)');
2729f11ffb7Safresh1}
2739f11ffb7Safresh1
2749f11ffb7Safresh1SKIP: {
2759f11ffb7Safresh1    skip "no fcntl", 1 unless $Config{d_fcntl};
2769f11ffb7Safresh1    my $sock;
2779f11ffb7Safresh1    socket($sock, PF_INET, SOCK_STREAM, $tcp) or die "socket: $!";
2789f11ffb7Safresh1    my $sockfd = fileno($sock);
2799f11ffb7Safresh1    fresh_perl_is(qq(
2809f11ffb7Safresh1	print open(F, "+<&=$sockfd") ? 1 : 0, "\\n";
2819f11ffb7Safresh1    ), "0\n", {}, "fresh socket not inherited across exec");
2829f11ffb7Safresh1}
2839f11ffb7Safresh1
284eac174f2Safresh1SKIP:
285eac174f2Safresh1{
286eac174f2Safresh1    my $val;
287eac174f2Safresh1    {
288eac174f2Safresh1        package SetsockoptMagic;
289eac174f2Safresh1        sub TIESCALAR { bless {}, shift }
290eac174f2Safresh1        sub FETCH { $val }
291eac174f2Safresh1    }
292eac174f2Safresh1    # setsockopt() magic
293eac174f2Safresh1    socket(my $sock, PF_INET, SOCK_STREAM, $tcp);
294eac174f2Safresh1    $val = 0;
295eac174f2Safresh1    # set a known value
296eac174f2Safresh1    ok(setsockopt($sock, SOL_SOCKET, SO_REUSEADDR, 1),
297eac174f2Safresh1       "set known SO_REUSEADDR");
298eac174f2Safresh1    isnt(getsockopt($sock, SOL_SOCKET, SO_REUSEADDR), pack("i", 0),
299eac174f2Safresh1       "check that worked");
300eac174f2Safresh1    tie my $m, "SetsockoptMagic";
301eac174f2Safresh1    # trigger the magic with the value 0
302eac174f2Safresh1    $val = pack("i", 0);
303eac174f2Safresh1    my $temp = $m;
304eac174f2Safresh1
305eac174f2Safresh1    $val = 1;
306eac174f2Safresh1    ok(setsockopt($sock, SOL_SOCKET, SO_REUSEADDR, $m),
307eac174f2Safresh1       "set SO_REUSEADDR from magic");
308eac174f2Safresh1    isnt(getsockopt($sock, SOL_SOCKET, SO_REUSEADDR), pack("i", 0),
309eac174f2Safresh1       "check SO_REUSEADDR set correctly");
310e0680481Safresh1
311e0680481Safresh1    # test whether boolean value treated as a number
312e0680481Safresh1    ok(setsockopt($sock, SOL_SOCKET, SO_REUSEADDR, !1),
313e0680481Safresh1       "clear SO_REUSEADDR by a boolean false");
314e0680481Safresh1    is(getsockopt($sock, SOL_SOCKET, SO_REUSEADDR), pack("i", 0),
315e0680481Safresh1       "check SO_REUSEADDR cleared correctly");
316e0680481Safresh1    ok(setsockopt($sock, SOL_SOCKET, SO_REUSEADDR, !0),
317e0680481Safresh1       "set SO_REUSEADDR by a boolean true");
318e0680481Safresh1    isnt(getsockopt($sock, SOL_SOCKET, SO_REUSEADDR), pack("i", 0),
319e0680481Safresh1         "check SO_REUSEADDR set correctly");
320e0680481Safresh1}
321e0680481Safresh1
322e0680481Safresh1# GH #18642 - test whether setsockopt works with a numeric OPTVAL which also
323e0680481Safresh1# has a cached stringified value
324e0680481Safresh1SKIP: {
325e0680481Safresh1    defined(my $IPPROTO_IP = eval { Socket::IPPROTO_IP() })
326e0680481Safresh1        or skip 'no IPPROTO_IP', 4;
327e0680481Safresh1    defined(my $IP_TTL = eval { Socket::IP_TTL() })
328e0680481Safresh1        or skip 'no IP_TTL', 4;
329e0680481Safresh1
330e0680481Safresh1    my $sock;
331e0680481Safresh1    socket($sock, PF_INET, SOCK_STREAM, $tcp) or BAIL_OUT "socket: $!";
332e0680481Safresh1
333e0680481Safresh1    my $ttl = 7;
334e0680481Safresh1    my $integer_only_ttl = 0 + $ttl;
335e0680481Safresh1    ok(setsockopt($sock, $IPPROTO_IP, $IP_TTL, $integer_only_ttl),
336e0680481Safresh1       'setsockopt with an integer-only OPTVAL');
337e0680481Safresh1    my $set_ttl = getsockopt($sock, $IPPROTO_IP, $IP_TTL);
338e0680481Safresh1    is(unpack('i', $set_ttl // ''), $ttl, 'TTL set to desired value');
339e0680481Safresh1
340e0680481Safresh1    my $also_string_ttl = $ttl;
341e0680481Safresh1    my $string = "$also_string_ttl";
342e0680481Safresh1    ok(setsockopt($sock, $IPPROTO_IP, $IP_TTL, $also_string_ttl),
343e0680481Safresh1       'setsockopt with an integer OPTVAL with stringified value');
344e0680481Safresh1    $set_ttl = getsockopt($sock, $IPPROTO_IP, $IP_TTL);
345e0680481Safresh1    is(unpack('i', $set_ttl // ''), $ttl, 'TTL set to desired value');
346e0680481Safresh1}
347e0680481Safresh1
348e0680481Safresh1# GH #19892
349e0680481Safresh1SKIP: {
350e0680481Safresh1    eval { Socket::IPPROTO_TCP(); 1 } or skip 'no IPPROTO_TCP', 1;
351e0680481Safresh1    eval { Socket::SOL_SOCKET(); 1 } or skip 'no SOL_SOCKET', 1;
352e0680481Safresh1    eval { Socket::SO_SNDBUF(); 1 } or skip 'no SO_SNDBUF', 1;
353e0680481Safresh1    skip 'setting socket buffer size requires elevated privileges', 1 if $^O eq 'VMS';
354e0680481Safresh1
355e0680481Safresh1    # The value of SNDBUF_SIZE constant below is changed from #19892 testcase;
356e0680481Safresh1    # original "262144" may be clamped on low-memory systems.
357e0680481Safresh1    fresh_perl_is(<<'EOP', "Ok.\n", {}, 'setsockopt works for a constant that is once stringified');
358e0680481Safresh1use warnings;
359e0680481Safresh1use strict;
360e0680481Safresh1
361e0680481Safresh1use Socket qw'PF_INET SOCK_STREAM IPPROTO_TCP SOL_SOCKET SO_SNDBUF';
362e0680481Safresh1
363e0680481Safresh1use constant { SNDBUF_SIZE => 32768 };
364e0680481Safresh1
365e0680481Safresh1socket(my $sock, PF_INET, SOCK_STREAM, IPPROTO_TCP)
366e0680481Safresh1  or die "Could not create socket - $!\n";
367e0680481Safresh1
368e0680481Safresh1setsockopt($sock,SOL_SOCKET,SO_SNDBUF,SNDBUF_SIZE)
369e0680481Safresh1  or die "Could not set SO_SNDBUF on socket - $!\n";
370e0680481Safresh1
371e0680481Safresh1my $sndBuf=getsockopt($sock,SOL_SOCKET,SO_SNDBUF)
372e0680481Safresh1  or die "Could not get SO_SNDBUF on socket - $!\n";
373e0680481Safresh1
374e0680481Safresh1$sndBuf=unpack('i',$sndBuf);
375e0680481Safresh1
376e0680481Safresh1die "Unexpected SO_SNDBUF value: $sndBuf\n"
377e0680481Safresh1  unless($sndBuf == SNDBUF_SIZE || $sndBuf == 2*SNDBUF_SIZE);
378e0680481Safresh1
379e0680481Safresh1print "Ok.\n";
380e0680481Safresh1exit;
381e0680481Safresh1
382e0680481Safresh1sub bug {SNDBUF_SIZE.''}
383e0680481Safresh1EOP
384eac174f2Safresh1}
385eac174f2Safresh1
3866fb12b70Safresh1done_testing();
3876fb12b70Safresh1
3886fb12b70Safresh1my @child_tests;
3896fb12b70Safresh1sub ok_child {
3906fb12b70Safresh1    my ($ok, $note) = @_;
391b8851fccSafresh1    push @child_tests, ( $ok ? "ok " : "not ok ") . curr_test() . " - $note "
392b8851fccSafresh1	. ( $TODO ? "# TODO $TODO" : "" ) . "\n";
3936fb12b70Safresh1    curr_test(curr_test()+1);
3946fb12b70Safresh1}
3956fb12b70Safresh1
3966fb12b70Safresh1sub is_child {
3976fb12b70Safresh1    my ($got, $want, $note) = @_;
3986fb12b70Safresh1    ok_child($got eq $want, $note);
3996fb12b70Safresh1}
4006fb12b70Safresh1
4016fb12b70Safresh1sub end_child {
4026fb12b70Safresh1    print @child_tests;
4036fb12b70Safresh1}
4049f11ffb7Safresh1
405