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} 25 26use Test::More tests => 8; 27BEGIN {use_ok('Net::Ping');} 28 29my $p = new Net::Ping "tcp"; 30 31isa_ok($p, 'Net::Ping', 'new() worked'); 32 33is($Net::Ping::hires, 1, 'Default is to use Time::HiRes'); 34 35$p -> hires(); 36isnt($Net::Ping::hires, 0, 'Enabled hires'); 37 38$p -> hires(0); 39is($Net::Ping::hires, 0, 'Make sure disable works'); 40 41$p -> hires(1); 42isnt($Net::Ping::hires, 0, 'Enable hires again'); 43 44# Test on the default port 45my ($ret, $duration) = $p -> ping("localhost"); 46 47isnt($ret, 0, 'localhost should always be reachable'); 48 49# It is extremely likely that the duration contains a decimal 50# point if Time::HiRes is functioning properly, except when it 51# is fast enough to be "0", or slow enough to be exactly "1". 52like($duration, qr/\.|^[01]$/, 'returned duration is valid'); 53