1# Test to make sure hires feature works. 2 3use strict; 4 5BEGIN { 6 if ($ENV{PERL_CORE}) { 7 unless ($ENV{PERL_TEST_Net_Ping}) { 8 print "1..0 # Skip: network dependent test\n"; 9 exit; 10 } 11 } 12 unless (eval "require Socket") { 13 print "1..0 \# Skip: no Socket\n"; 14 exit; 15 } 16 unless (eval "require Time::HiRes") { 17 print "1..0 \# Skip: no Time::HiRes\n"; 18 exit; 19 } 20 unless (getservbyname('echo', 'tcp')) { 21 print "1..0 \# Skip: no echo port\n"; 22 exit; 23 } 24 unless (Socket::getaddrinfo('localhost', &Socket::AF_INET())) { 25 print "1..0 \# Skip: no localhost resolver on $^O\n"; 26 exit; 27 } 28} 29 30use Test::More tests => 8; 31BEGIN {use_ok('Net::Ping');} 32 33my $p = new Net::Ping "tcp"; 34 35isa_ok($p, 'Net::Ping', 'new() worked'); 36 37is($Net::Ping::hires, 1, 'Default is to use Time::HiRes'); 38 39$p -> hires(); 40isnt($Net::Ping::hires, 0, 'Enabled hires'); 41 42$p -> hires(0); 43is($Net::Ping::hires, 0, 'Make sure disable works'); 44 45$p -> hires(1); 46isnt($Net::Ping::hires, 0, 'Enable hires again'); 47 48SKIP: { 49 skip "unreliable ping localhost on $^O", 2 50 if $^O =~ /^(?:hpux|os390|irix|freebsd)$/; 51 52 # Test on the default port 53 my ($ret, $duration) = $p -> ping("localhost"); 54 55 isnt($ret, 0, 'localhost should always be reachable'); 56 57 # It is extremely likely that the duration contains a decimal 58 # point if Time::HiRes is functioning properly, except when it 59 # is fast enough to be "0", or slow enough to be exactly "1". 60 like($duration, qr/\.|^[01]$/, 'returned duration is valid'); 61} 62