-# 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") {
}
}
-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'};
# 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";
}
}
-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 {
# 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";
}
}
-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');
# 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";
}
}
-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');
# 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";
}
}
-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');
# 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";
}
}
-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');
}
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) {
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
+use strict;
+
BEGIN {
if ($ENV{PERL_CORE}) {
unless ($ENV{PERL_TEST_Net_Ping}) {
#
# $ 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 $_");
+}
# Test to make sure hires feature works.
+use strict;
+
BEGIN {
if ($ENV{PERL_CORE}) {
unless ($ENV{PERL_TEST_Net_Ping}) {
}
}
-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');
+use strict;
BEGIN {
if ($ENV{PERL_CORE}) {
unless ($ENV{PERL_TEST_Net_Ping}) {
# 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__
+use strict;
+
BEGIN {
if ($ENV{PERL_CORE}) {
unless ($ENV{PERL_TEST_Net_Ping}) {
# $ 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,
"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;};
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} || "") . "]");
}
# Same as 400_ping_syn.t but testing ack( $host ) instead of ack( ).
+use strict;
BEGIN {
if ($ENV{PERL_CORE}) {
# $ 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,
"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;};
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);
}
}
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
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;
# (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);
# 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);
# 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.
# 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);
# 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);
# 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);
# 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);
# 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');
# Test to perform icmp protocol testing.
# Root access is required.
+use strict;
+
BEGIN {
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
}
}
-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 {
# Test to perform udp protocol testing.
+use strict;
+
sub isWindowsVista {
return unless $^O eq 'MSWin32' or $^O eq "cygwin";
return unless eval { require Win32 };
}
}
-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);
projects / platform / upstream / perl.git / commitdiff