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