Setting $^E wipes out $!
[p5sagit/p5-mst-13.2.git] / t / lib / io_udp.t
CommitLineData
61f2b451 1#!./perl
2
3BEGIN {
7a4c00b4 4 unless(grep /blib/, @INC) {
5 chdir 't' if -d 't';
93430cb4 6 unshift @INC, '../lib' if -d '../lib';
7a4c00b4 7 }
8}
9
10use Config;
11
12BEGIN {
13 if(-d "lib" && -f "TEST") {
45c0de28 14 my $reason;
15
16 if ($Config{'extensions'} !~ /\bSocket\b/) {
17 $reason = 'Socket was not built';
18 }
19 elsif ($Config{'extensions'} !~ /\bIO\b/) {
20 $reason = 'IO was not built';
21 }
22 elsif ($^O eq 'os2') {
23 $reason = "blocks on OS/2, not debugged yet";
24 }
25 elsif ($^O eq 'apollo') {
26 $reason = "unknown *FIXME*";
27 }
28 undef $reason if $^O eq 'VMS' and $Config{d_socket};
29 if ($reason) {
30 print "1..0 # Skip: $reason\n";
7a4c00b4 31 exit 0;
45c0de28 32 }
61f2b451 33 }
34}
35
cf7fe8a2 36sub compare_addr {
37 my $a = shift;
38 my $b = shift;
39 my @a = unpack_sockaddr_in($a);
40 my @b = unpack_sockaddr_in($b);
41 "$a[0]$a[1]" eq "$b[0]$b[1]";
42}
43
61f2b451 44$| = 1;
cf7fe8a2 45print "1..7\n";
61f2b451 46
47use Socket;
48use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
49
68820cec 50 # This can fail if localhost is undefined or the
51 # special 'loopback' address 127.0.0.1 is not configured
52 # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
9b599b2a 53 # As a shortcut (not recommended) you could change 'localhost'
54 # here to be the name of this machine eg 'myhost.mycompany.com'.
68820cec 55
9b599b2a 56$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
57 or die "$! (maybe your system does not have the 'localhost' address defined)";
cf7fe8a2 58
59print "ok 1\n";
60
9b599b2a 61$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
62 or die "$! (maybe your system does not have the 'localhost' address defined)";
61f2b451 63
cf7fe8a2 64print "ok 2\n";
65
66$udpa->send("ok 4\n",0,$udpb->sockname);
61f2b451 67
cf7fe8a2 68print "not " unless compare_addr($udpa->peername,$udpb->sockname);
69print "ok 3\n";
70
71my $where = $udpb->recv($buf="",5);
61f2b451 72print $buf;
cf7fe8a2 73
74my @xtra = ();
75
76unless(compare_addr($where,$udpa->sockname)) {
77 print "not ";
78 @xtra = (0,$udpa->sockname);
79}
80print "ok 5\n";
81
82$udpb->send("ok 6\n",@xtra);
61f2b451 83$udpa->recv($buf="",5);
84print $buf;
cf7fe8a2 85
86print "not " if $udpa->connected;
87print "ok 7\n";