diff options
author | Nicholas Clark <nick@ccl4.org> | 2011-01-22 16:21:35 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2011-01-22 16:21:35 +0000 |
commit | 2f794ae103681c68e0b714686c925821a1d928b5 (patch) | |
tree | d0462519236ab0c133663eb6b791759404b68603 /dist | |
parent | 345669238efde70138b5f0087fb5a23040be3d8d (diff) | |
download | perl-2f794ae103681c68e0b714686c925821a1d928b5.tar.gz |
Convert Net::Ping's tests to use Test::More from Test.
Diffstat (limited to 'dist')
-rw-r--r-- | dist/Net-Ping/t/100_load.t | 20 | ||||
-rw-r--r-- | dist/Net-Ping/t/110_icmp_inst.t | 28 | ||||
-rw-r--r-- | dist/Net-Ping/t/120_udp_inst.t | 12 | ||||
-rw-r--r-- | dist/Net-Ping/t/130_tcp_inst.t | 12 | ||||
-rw-r--r-- | dist/Net-Ping/t/140_stream_inst.t | 12 | ||||
-rw-r--r-- | dist/Net-Ping/t/150_syn_inst.t | 11 | ||||
-rw-r--r-- | dist/Net-Ping/t/190_alarm.t | 21 | ||||
-rw-r--r-- | dist/Net-Ping/t/200_ping_tcp.t | 37 | ||||
-rw-r--r-- | dist/Net-Ping/t/250_ping_hires.t | 32 | ||||
-rw-r--r-- | dist/Net-Ping/t/300_ping_stream.t | 12 | ||||
-rw-r--r-- | dist/Net-Ping/t/400_ping_syn.t | 42 | ||||
-rw-r--r-- | dist/Net-Ping/t/410_syn_host.t | 44 | ||||
-rw-r--r-- | dist/Net-Ping/t/450_service.t | 97 | ||||
-rw-r--r-- | dist/Net-Ping/t/500_ping_icmp.t | 28 | ||||
-rw-r--r-- | dist/Net-Ping/t/510_ping_udp.t | 12 |
15 files changed, 164 insertions, 256 deletions
diff --git a/dist/Net-Ping/t/100_load.t b/dist/Net-Ping/t/100_load.t index de84247632..fa04a0c587 100644 --- a/dist/Net-Ping/t/100_load.t +++ b/dist/Net-Ping/t/100_load.t @@ -1,7 +1,4 @@ -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.t' - -######################### We start with some black magic to print on failure. +use strict; BEGIN { unless (eval "require Socket") { @@ -10,17 +7,6 @@ BEGIN { } } -use Test; -BEGIN { plan tests => 1; $loaded = 0} -END { ok $loaded;} - +use Test::More tests => 1; # Just make sure everything compiles -use Net::Ping; - -$loaded = 1; - -######################### End of black magic. - -# Insert your test code below (better if it prints "ok 13" -# (correspondingly "not ok 13") depending on the success of chunk 13 -# of the test code): +BEGIN {use_ok 'Net::Ping'}; diff --git a/dist/Net-Ping/t/110_icmp_inst.t b/dist/Net-Ping/t/110_icmp_inst.t index 14a7f12c75..7840657d5e 100644 --- a/dist/Net-Ping/t/110_icmp_inst.t +++ b/dist/Net-Ping/t/110_icmp_inst.t @@ -1,6 +1,8 @@ # Test to make sure object can be instantiated for icmp protocol. # Root access is required to actually perform icmp testing. +use strict; + BEGIN { unless (eval "require Socket") { print "1..0 \# Skip: no Socket\n"; @@ -8,24 +10,18 @@ BEGIN { } } -use Test; -use Net::Ping; -plan tests => 2; - -# Everything loaded fine -ok 1; +use Test::More tests => 2; +BEGIN {use_ok('Net::Ping')}; -if (($> and $^O ne 'VMS' and $^O ne 'cygwin') - or ($^O eq 'MSWin32' - and !IsAdminUser()) - or ($^O eq 'VMS' - and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/))) { - skip "icmp ping requires root privileges.", 1; -} elsif ($^O eq 'MacOS') { - skip "icmp protocol not supported.", 1; -} else { +SKIP: { + skip "icmp ping requires root privileges.", 1 + if ($> and $^O ne 'VMS' and $^O ne 'cygwin') + or ($^O eq 'MSWin32' + and !IsAdminUser()) + or ($^O eq 'VMS' + and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/)); my $p = new Net::Ping "icmp"; - ok !!$p; + isa_ok($p, 'Net::Ping', 'object can be instantiated for icmp protocol'); } sub IsAdminUser { diff --git a/dist/Net-Ping/t/120_udp_inst.t b/dist/Net-Ping/t/120_udp_inst.t index f7b77b1a39..ca10543a69 100644 --- a/dist/Net-Ping/t/120_udp_inst.t +++ b/dist/Net-Ping/t/120_udp_inst.t @@ -1,6 +1,8 @@ # Test to make sure object can be instantiated for udp protocol. # I do not know of any servers that support udp echo anymore. +use strict; + BEGIN { unless (eval "require Socket") { print "1..0 \# Skip: no Socket\n"; @@ -12,12 +14,8 @@ BEGIN { } } -use Test; -use Net::Ping; -plan tests => 2; - -# Everything loaded fine -ok 1; +use Test::More tests => 2; +BEGIN {use_ok 'Net::Ping'}; my $p = new Net::Ping "udp"; -ok !!$p; +isa_ok($p, 'Net::Ping', 'object can be instantiated for udp protocol'); diff --git a/dist/Net-Ping/t/130_tcp_inst.t b/dist/Net-Ping/t/130_tcp_inst.t index e2efb8c4f6..2810c8f1d4 100644 --- a/dist/Net-Ping/t/130_tcp_inst.t +++ b/dist/Net-Ping/t/130_tcp_inst.t @@ -1,5 +1,7 @@ # Test to make sure object can be instantiated for tcp protocol. +use strict; + BEGIN { unless (eval "require Socket") { print "1..0 \# Skip: no Socket\n"; @@ -11,12 +13,8 @@ BEGIN { } } -use Test; -use Net::Ping; -plan tests => 2; - -# Everything loaded fine -ok 1; +use Test::More tests => 2; +BEGIN {use_ok 'Net::Ping'}; my $p = new Net::Ping "tcp"; -ok !!$p; +isa_ok($p, 'Net::Ping', 'object can be instantiated for tcp protocol'); diff --git a/dist/Net-Ping/t/140_stream_inst.t b/dist/Net-Ping/t/140_stream_inst.t index 4492332429..cb1ba5f486 100644 --- a/dist/Net-Ping/t/140_stream_inst.t +++ b/dist/Net-Ping/t/140_stream_inst.t @@ -1,5 +1,7 @@ # Test to make sure object can be instantiated for stream protocol. +use strict; + BEGIN { unless (eval "require Socket") { print "1..0 \# Skip: no Socket\n"; @@ -11,12 +13,8 @@ BEGIN { } } -use Test; -use Net::Ping; -plan tests => 2; - -# Everything loaded fine -ok 1; +use Test::More tests => 2; +BEGIN {use_ok 'Net::Ping'}; my $p = new Net::Ping "stream"; -ok !!$p; +isa_ok($p, 'Net::Ping', 'object can be instantiated for stream protocol'); diff --git a/dist/Net-Ping/t/150_syn_inst.t b/dist/Net-Ping/t/150_syn_inst.t index df85d460fe..d32bc852df 100644 --- a/dist/Net-Ping/t/150_syn_inst.t +++ b/dist/Net-Ping/t/150_syn_inst.t @@ -1,5 +1,7 @@ # Test to make sure object can be instantiated for syn protocol. +use strict; + BEGIN { unless (eval "require Socket") { print "1..0 \# Skip: no Socket\n"; @@ -11,12 +13,9 @@ BEGIN { } } -use Test; -use Net::Ping; -plan tests => 2; -# Everything loaded fine -ok 1; +use Test::More tests => 2; +BEGIN {use_ok 'Net::Ping'}; my $p = new Net::Ping "syn"; -ok !!$p; +isa_ok($p, 'Net::Ping', 'object can be instantiated for syn protocol'); diff --git a/dist/Net-Ping/t/190_alarm.t b/dist/Net-Ping/t/190_alarm.t index 9ea5185e8d..addfa9e8b8 100644 --- a/dist/Net-Ping/t/190_alarm.t +++ b/dist/Net-Ping/t/190_alarm.t @@ -25,22 +25,17 @@ BEGIN { } use strict; -use Test; -use Net::Ping; - -plan tests => 6; - -# Everything compiled -ok 1; +use Test::More tests => 6; +BEGIN {use_ok 'Net::Ping'}; eval { my $timeout = 11; - ok 1; # In eval + pass('In eval'); local $SIG{ALRM} = sub { die "alarm works" }; - ok 1; # SIGALRM can be set on this platform + pass('SIGALRM can be set on this platform'); alarm $timeout; - ok 1; # alarm() can be set on this platform + pass('alarm() can be set on this platform'); my $start = time; while (1) { @@ -51,10 +46,8 @@ eval { die "alarm failed" if time > $start + $timeout + 1; } }; -# Got out of "infinite loop" okay -ok 1; +pass('Got out of "infinite loop" okay'); -# Make sure it died for a good excuse -ok $@ =~ /alarm works/ or die $@; +like($@, qr/alarm works/, 'Make sure it died for a good excuse'); alarm 0; # Reset alarm diff --git a/dist/Net-Ping/t/200_ping_tcp.t b/dist/Net-Ping/t/200_ping_tcp.t index 0f592341f9..2f8a40bd32 100644 --- a/dist/Net-Ping/t/200_ping_tcp.t +++ b/dist/Net-Ping/t/200_ping_tcp.t @@ -1,3 +1,5 @@ +use strict; + BEGIN { if ($ENV{PERL_CORE}) { unless ($ENV{PERL_TEST_Net_Ping}) { @@ -26,41 +28,30 @@ BEGIN { # # $ PERL_CORE=1 make test -use Test; -use Net::Ping; -plan tests => 13; - -# Everything loaded fine -ok 1; +use Test::More tests => 13; +BEGIN {use_ok('Net::Ping');} my $p = new Net::Ping "tcp",9; -# new() worked? -ok !!$p; +isa_ok($p, 'Net::Ping', 'new() worked'); -# Test on the default port -ok $p -> ping("localhost"); +isnt($p->ping("localhost"), 0, 'Test on the default port'); # Change to use the more common web port. # This will pull from /etc/services on UNIX. # (Make sure getservbyname works in scalar context.) -ok ($p -> {port_num} = (getservbyname("http", "tcp") || 80)); +isnt($p->{port_num} = (getservbyname("http", "tcp") || 80), undef); -# Test localhost on the web port -ok $p -> ping("localhost"); +isnt($p->ping("localhost"), 0, 'Test localhost on the web port'); # Hopefully this is never a routeable host -ok !$p -> ping("172.29.249.249"); +is($p->ping("172.29.249.249"), 0, "Can't reach 172.29.249.249"); # Test a few remote servers # Hopefully they are up when the tests are run. -ok $p -> ping("www.geocities.com"); -ok $p -> ping("ftp.geocities.com"); - -ok $p -> ping("www.freeservers.com"); -ok $p -> ping("ftp.freeservers.com"); - -ok $p -> ping("yahoo.com"); -ok $p -> ping("www.yahoo.com"); -ok $p -> ping("www.about.com"); +foreach (qw(www.geocities.com ftp.geocities.com + www.freeservers.com ftp.freeservers.com + yahoo.com www.yahoo.com www.about.com)) { + isnt($p->ping($_), 0, "Can ping $_"); +} diff --git a/dist/Net-Ping/t/250_ping_hires.t b/dist/Net-Ping/t/250_ping_hires.t index 1f4bcb3770..34e81a8be5 100644 --- a/dist/Net-Ping/t/250_ping_hires.t +++ b/dist/Net-Ping/t/250_ping_hires.t @@ -1,5 +1,7 @@ # Test to make sure hires feature works. +use strict; + BEGIN { if ($ENV{PERL_CORE}) { unless ($ENV{PERL_TEST_Net_Ping}) { @@ -21,42 +23,30 @@ BEGIN { } } -use Test qw(plan ok $TESTERR); -use Net::Ping; -plan tests => 8; - -# Everything loaded fine -ok 1; +use Test::More tests => 8; +BEGIN {use_ok('Net::Ping');} my $p = new Net::Ping "tcp"; -# new() worked? -ok !!$p; +isa_ok($p, 'Net::Ping', 'new() worked'); -# Default is to not use Time::HiRes -ok !$Net::Ping::hires; +is($Net::Ping::hires, 0, 'Default is to not use Time::HiRes'); -# Enable hires $p -> hires(); -ok $Net::Ping::hires; +isnt($Net::Ping::hires, 0, 'Enabled hires'); -# Make sure disable works $p -> hires(0); -ok !$Net::Ping::hires; +is($Net::Ping::hires, 0, 'Make sure disable works'); -# Enable again $p -> hires(1); -ok $Net::Ping::hires; +isnt($Net::Ping::hires, 0, 'Enable hires again'); # Test on the default port my ($ret, $duration) = $p -> ping("localhost"); -# localhost should always be reachable, right? -ok $ret; +isnt($ret, 0, 'localhost should always be reachable'); # It is extremely likely that the duration contains a decimal # point if Time::HiRes is functioning properly, except when it # is fast enough to be "0", or slow enough to be exactly "1". -if (! ok($duration =~ /\.|^[01]$/)) { - print($TESTERR "# duration=[$duration]\n"); -} +like($duration, qr/\.|^[01]$/, 'returned duration is valid'); diff --git a/dist/Net-Ping/t/300_ping_stream.t b/dist/Net-Ping/t/300_ping_stream.t index d5a3a3f18f..f3b4ee454d 100644 --- a/dist/Net-Ping/t/300_ping_stream.t +++ b/dist/Net-Ping/t/300_ping_stream.t @@ -1,3 +1,4 @@ +use strict; BEGIN { if ($ENV{PERL_CORE}) { unless ($ENV{PERL_TEST_Net_Ping}) { @@ -29,22 +30,19 @@ BEGIN { # to really test the stream protocol ping. See # the end of this document on how to enable it. -use Test; +use Test::More tests => 22; use Net::Ping; -plan tests => 22; my $p = new Net::Ping "stream"; # new() worked? -ok !!$p; +isa_ok($p, 'Net::Ping', 'new() worked'); -# Attempt to connect to the echo port -ok ($p -> ping("localhost")); +is($p->ping("localhost"), 1, 'Attempt to connect to the echo port'); -# Try several pings while it is connected for (1..20) { select (undef,undef,undef,0.1); - ok $p -> ping("localhost"); + is($p->ping("localhost"), 1, 'Try several pings while it is connected'); } __END__ diff --git a/dist/Net-Ping/t/400_ping_syn.t b/dist/Net-Ping/t/400_ping_syn.t index 915e0ffafb..025a0cd7fb 100644 --- a/dist/Net-Ping/t/400_ping_syn.t +++ b/dist/Net-Ping/t/400_ping_syn.t @@ -1,3 +1,5 @@ +use strict; + BEGIN { if ($ENV{PERL_CORE}) { unless ($ENV{PERL_TEST_Net_Ping}) { @@ -31,7 +33,9 @@ BEGIN { # $ PERL_CORE=1 make test # Try a few remote servers -my $webs = { +my %webs; +BEGIN { + %webs = ( # Hopefully this is never a routeable host "172.29.249.249" => 0, @@ -43,15 +47,12 @@ my $webs = { "www.about.com." => 1, "www.microsoft.com." => 1, "127.0.0.1" => 1, -}; +); +} -use strict; -use Test; -use Net::Ping; -plan tests => ((keys %{ $webs }) * 2 + 3); +use Test::More tests => 3 + 2 * keys %webs; -# Everything loaded fine -ok 1; +BEGIN {use_ok('Net::Ping')}; my $can_alarm = eval {alarm 0; 1;}; @@ -61,39 +62,32 @@ sub Alarm { Alarm(50); $SIG{ALRM} = sub { - ok 0; + fail('Alarm timed out'); die "TIMED OUT!"; }; my $p = new Net::Ping "syn", 10; -# new() worked? -ok !!$p; +isa_ok($p, 'Net::Ping', 'new() worked'); # Change to use the more common web port. # (Make sure getservbyname works in scalar context.) -ok ($p -> {port_num} = getservbyname("http", "tcp")); +cmp_ok(($p->{port_num} = getservbyname("http", "tcp")), '>', 0, 'valid port'); -foreach my $host (keys %{ $webs }) { +foreach my $host (keys %webs) { # ping() does dns resolution and # only sends the SYN at this point Alarm(50); # (Plenty for a DNS lookup) - if (!ok $p -> ping($host)) { - print STDERR "CANNOT RESOLVE $host $p->{bad}->{$host}\n"; - } + is($p->ping($host), 1, "Can reach $host $p->{bad}->{$host}"); } Alarm(20); while (my $host = $p->ack()) { - if (!ok $webs->{$host}) { - print STDERR "SUPPOSED TO BE DOWN: http://$host/\n"; - } - delete $webs->{$host}; + is($webs{$host}, 1, "supposed to be up: http://$host/"); + delete $webs{$host}; } Alarm(0); -foreach my $host (keys %{ $webs }) { - if (!ok !$webs->{$host}) { - print STDERR "DOWN: http://$host/ [",($p->{bad}->{$host} || ""),"]\n"; - } +foreach my $host (keys %webs) { + is($webs{$host}, 0, "supposed to be down: http://$host/ [" . ($p->{bad}->{$host} || "") . "]"); } diff --git a/dist/Net-Ping/t/410_syn_host.t b/dist/Net-Ping/t/410_syn_host.t index efadcb4b8c..a5b570a437 100644 --- a/dist/Net-Ping/t/410_syn_host.t +++ b/dist/Net-Ping/t/410_syn_host.t @@ -1,4 +1,5 @@ # Same as 400_ping_syn.t but testing ack( $host ) instead of ack( ). +use strict; BEGIN { if ($ENV{PERL_CORE}) { @@ -33,7 +34,9 @@ BEGIN { # $ PERL_CORE=1 make test # Try a few remote servers -my $webs = { +my %webs; +BEGIN { + %webs = ( # Hopefully this is never a routeable host "172.29.249.249" => 0, @@ -45,15 +48,12 @@ my $webs = { "www.about.com." => 1, "www.microsoft.com." => 1, "127.0.0.1" => 1, -}; +); +} -use strict; -use Test; -use Net::Ping; -plan tests => ((keys %{ $webs }) * 2 + 3); +use Test::More tests => 3 + 2 * keys %webs; -# Everything loaded fine -ok 1; +BEGIN {use_ok('Net::Ping')}; my $can_alarm = eval {alarm 0; 1;}; @@ -63,40 +63,34 @@ sub Alarm { Alarm(50); $SIG{ALRM} = sub { - ok 0; + fail('Alarm timed out'); die "TIMED OUT!"; }; my $p = new Net::Ping "syn", 10; -# new() worked? -ok !!$p; +isa_ok($p, 'Net::Ping', 'new() worked'); # Change to use the more common web port. # (Make sure getservbyname works in scalar context.) -ok ($p -> {port_num} = getservbyname("http", "tcp")); +cmp_ok(($p->{port_num} = getservbyname("http", "tcp")), '>', 0, 'vaid port'); -foreach my $host (keys %{ $webs }) { +foreach my $host (keys %webs) { # ping() does dns resolution and # only sends the SYN at this point Alarm(50); # (Plenty for a DNS lookup) - if (!ok($p -> ping($host))) { - print STDERR "CANNOT RESOLVE $host $p->{bad}->{$host}\n"; - } + is($p->ping($host), 1, "Can reach $host $p->{bad}->{$host}"); } Alarm(20); -foreach my $host (sort keys %{ $webs }) { +foreach my $host (sort keys %webs) { my $on = $p->ack($host); - if (!ok (($on && $webs->{$host}) || - (!$on && !$webs->{$host}))) { - if ($on) { - print STDERR "SUPPOSED TO BE DOWN: http://$host/\n"; - } else { - print STDERR "DOWN: http://$host/ [",($p->{bad}->{$host} || ""),"]\n"; - } + if ($on) { + is($webs{$host}, 1, "supposed to be up: http://$host/"); + } else { + is($webs{$host}, 0, "supposed to be down: http://$host/ [" . ($p->{bad}->{$host} || "") . "]"); } - delete $webs->{$host}; + delete $webs{$host}; Alarm(20); } diff --git a/dist/Net-Ping/t/450_service.t b/dist/Net-Ping/t/450_service.t index 21e99f2c44..6c1d938c2f 100644 --- a/dist/Net-Ping/t/450_service.t +++ b/dist/Net-Ping/t/450_service.t @@ -12,28 +12,21 @@ BEGIN { } use strict; -use Test; -use Net::Ping; +use Test::More tests => 26; +BEGIN {use_ok('Net::Ping')}; # I'm lazy so I'll just use IO::Socket # for the TCP Server stuff instead of doing # all that direct socket() junk manually. -plan tests => 26, ($^O eq 'MSWin32' ? (todo => [18]) : - $^O eq "hpux" ? (todo => [9, 18]) : ()); - -# Everything loaded fine -ok 1; - -# Start a tcp listen server on ephemeral port my $sock1 = new IO::Socket::INET LocalAddr => "127.0.0.1", Proto => "tcp", Listen => 8, or warn "bind: $!"; -# Make sure it worked. -ok !!$sock1; +isa_ok($sock1, 'IO::Socket::INET', + 'Start a TCP listen server on ephemeral port'); # Start listening on another ephemeral port my $sock2 = new IO::Socket::INET @@ -42,17 +35,17 @@ my $sock2 = new IO::Socket::INET Listen => 8, or warn "bind: $!"; -# Make sure it worked too. -ok !!$sock2; +isa_ok($sock2, 'IO::Socket::INET', + 'Start a second TCP listen server on ephemeral port'); my $port1 = $sock1->sockport; -ok $port1; +cmp_ok($port1, '>', 0); my $port2 = $sock2->sockport; -ok $port2; +cmp_ok($port2, '>', 0); -# Make sure the sockets are listening on different ports. -ok ($port1 != $port2); +# +isnt($port1, $port2, 'Make sure the servers are listening on different ports'); $sock2->close; @@ -65,8 +58,7 @@ $sock2->close; # (2 seconds should be long enough to connect to loopback.) my $p = new Net::Ping "tcp", 2; -# new() worked? -ok !!$p; +isa_ok($p, 'Net::Ping', 'new() worked'); # Disable service checking $p->service_check(0); @@ -74,16 +66,16 @@ $p->service_check(0); # Try on the first port $p->{port_num} = $port1; -# Make sure it is reachable -ok $p -> ping("127.0.0.1"); +is($p->ping("127.0.0.1"), 1, 'first port is reachable'); # Try on the other port $p->{port_num} = $port2; -# Make sure it is reachable -ok $p -> ping("127.0.0.1"); - - +{ + local $TODO; + $TODO = "Believed not to work on $^O" if $^O eq 'hpux'; + is($p->ping("127.0.0.1"), 1, 'second port is reachable'); +} # Enable service checking $p->service_check(1); @@ -91,14 +83,12 @@ $p->service_check(1); # Try on the first port $p->{port_num} = $port1; -# Make sure service is on -ok $p -> ping("127.0.0.1"); +is($p->ping("127.0.0.1"), 1, 'first service is on'); # Try on the other port $p->{port_num} = $port2; -# Make sure service is off -ok !$p -> ping("127.0.0.1"); +isnt($p->ping("127.0.0.1"), 2, 'second service is off'); # test 11 just finished. @@ -106,8 +96,7 @@ ok !$p -> ping("127.0.0.1"); # Lastly, we test using the "syn" protocol. $p = new Net::Ping "syn", 2; -# new() worked? -ok !!$p; +isa_ok($p, 'Net::Ping', 'new() worked'); # Disable service checking $p->service_check(0); @@ -115,20 +104,16 @@ $p->service_check(0); # Try on the first port $p->{port_num} = $port1; -# Send SYN -if (!ok $p -> ping("127.0.0.1")) {warn "ERRNO: $!";} +is($p->ping("127.0.0.1"), 1, "send SYN to first port") or diag ("ERRNO: $!"); -# IP should be reachable -ok $p -> ack(); -# No more sockets? -ok !$p -> ack(); +is($p->ack(), '127.0.0.1', 'IP should be reachable'); +is($p->ack(), undef, 'No more sockets'); ### # Get a fresh object $p = new Net::Ping "syn", 2; -# new() worked? -ok !!$p; +isa_ok($p, 'Net::Ping', 'new() worked'); # Disable service checking $p->service_check(0); @@ -136,21 +121,21 @@ $p->service_check(0); # Try on the other port $p->{port_num} = $port2; -# Send SYN -if (!ok $p -> ping("127.0.0.1")) {warn "ERRNO: $!";} +is($p->ping("127.0.0.1"), 1, "send SYN to second port") or diag ("ERRNO: $!"); -# IP should still be reachable -ok $p -> ack(); -# No more sockets? -ok !$p -> ack(); +{ + local $TODO; + $TODO = "Believed not to work on $^O" if $^O eq 'hpux' || $^O eq 'MSWin32'; + is($p->ack(), '127.0.0.1', 'IP should be reachable'); +} +is($p->ack(), undef, 'No more sockets'); ### # Get a fresh object $p = new Net::Ping "syn", 2; -# new() worked? -ok !!$p; +isa_ok($p, 'Net::Ping', 'new() worked'); # Enable service checking $p->service_check(1); @@ -158,21 +143,17 @@ $p->service_check(1); # Try on the first port $p->{port_num} = $port1; -# Send SYN -ok $p -> ping("127.0.0.1"); +is($p->ping("127.0.0.1"), 1, "send SYN to first port") or diag ("ERRNO: $!"); -# Should have service on -ok ($p -> ack(),"127.0.0.1"); -# No more good sockets? -ok !$p -> ack(); +is($p->ack(), '127.0.0.1', 'IP should be reachable'); +is($p->ack(), undef, 'No more sockets'); ### # Get a fresh object $p = new Net::Ping "syn", 2; -# new() worked? -ok !!$p; +isa_ok($p, 'Net::Ping', 'new() worked'); # Enable service checking $p->service_check(1); @@ -180,8 +161,6 @@ $p->service_check(1); # Try on the other port $p->{port_num} = $port2; -# Send SYN -if (!ok $p -> ping("127.0.0.1")) {warn "ERRNO: $!";} +is($p->ping("127.0.0.1"), 1, "send SYN to second port") or diag ("ERRNO: $!"); -# No sockets should have service on -ok !$p -> ack(); +is($p->ack(), undef, 'No sockets should have service on'); diff --git a/dist/Net-Ping/t/500_ping_icmp.t b/dist/Net-Ping/t/500_ping_icmp.t index db20ac98ce..9fe6877e14 100644 --- a/dist/Net-Ping/t/500_ping_icmp.t +++ b/dist/Net-Ping/t/500_ping_icmp.t @@ -1,6 +1,8 @@ # Test to perform icmp protocol testing. # Root access is required. +use strict; + BEGIN { unless (eval "require Socket") { print "1..0 \# Skip: no Socket\n"; @@ -8,24 +10,18 @@ BEGIN { } } -use Test; -use Net::Ping; -plan tests => 2; - -# Everything loaded fine -ok 1; +use Test::More tests => 2; +BEGIN {use_ok('Net::Ping')}; -if (($> and $^O ne 'VMS') - or (($^O eq 'MSWin32' or $^O eq 'cygwin') - and !IsAdminUser()) - or ($^O eq 'VMS' - and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/))) { - skip "icmp ping requires root privileges.", 1; -} elsif ($^O eq 'MacOS') { - skip "icmp protocol not supported.", 1; -} else { +SKIP: { + skip "icmp ping requires root privileges.", 1 + if ($> and $^O ne 'VMS' and $^O ne 'cygwin') + or ($^O eq 'MSWin32' + and !IsAdminUser()) + or ($^O eq 'VMS' + and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/)); my $p = new Net::Ping "icmp"; - ok $p->ping("127.0.0.1"); + is($p->ping("127.0.0.1"), 1); } sub IsAdminUser { diff --git a/dist/Net-Ping/t/510_ping_udp.t b/dist/Net-Ping/t/510_ping_udp.t index ce55a7d1fc..ca8e3b08ee 100644 --- a/dist/Net-Ping/t/510_ping_udp.t +++ b/dist/Net-Ping/t/510_ping_udp.t @@ -1,5 +1,7 @@ # Test to perform udp protocol testing. +use strict; + sub isWindowsVista { return unless $^O eq 'MSWin32' or $^O eq "cygwin"; return unless eval { require Win32 }; @@ -23,12 +25,8 @@ BEGIN { } } -use Test; -use Net::Ping; -plan tests => 2; - -# Everything loaded fine -ok 1; +use Test::More tests => 2; +BEGIN {use_ok('Net::Ping')}; my $p = new Net::Ping "udp"; -ok $p->ping("127.0.0.1"); +is($p->ping("127.0.0.1"), 1); |