1# Test to make sure alarm / SIGALM does not interfere 2# with Net::Ping. (This test was derived to ensure 3# compatibility with the "spamassassin" utility.) 4# Based on code written by radu@netsoft.ro (Radu Greab). 5 6BEGIN { 7 if ($ENV{PERL_CORE}) { 8 unless ($ENV{PERL_TEST_Net_Ping}) { 9 print "1..0 \# Skip: network dependent test\n"; 10 exit; 11 } 12 } 13 unless (eval "require Socket") { 14 print "1..0 \# Skip: no Socket\n"; 15 exit; 16 } 17 unless (eval {alarm 0; 1;}) { 18 print "1..0 \# Skip: alarm borks on $^O $^X $] ?\n"; 19 exit; 20 } 21 unless (getservbyname('echo', 'tcp')) { 22 print "1..0 \# Skip: no echo port\n"; 23 exit; 24 } 25} 26 27use strict; 28use Test::More tests => 6; 29BEGIN {use_ok 'Net::Ping'}; 30 31eval { 32 my $timeout = 11; 33 34 pass('In eval'); 35 local $SIG{ALRM} = sub { die "alarm works" }; 36 pass('SIGALRM can be set on this platform'); 37 alarm $timeout; 38 pass('alarm() can be set on this platform'); 39 40 my $start = time; 41 while (1) { 42 my $ping = Net::Ping->new("tcp", 2); 43 # It does not matter if alive or not 44 $ping->ping("127.0.0.1"); 45 $ping->ping("172.29.249.249"); 46 die "alarm failed" if time > $start + $timeout + 1; 47 } 48}; 49pass('Got out of "infinite loop" okay'); 50 51like($@, qr/alarm works/, 'Make sure it died for a good excuse'); 52 53alarm 0; # Reset alarm 54