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{NO_NETWORK_TESTING} || 8 ($ENV{PERL_CORE}) && !$ENV{PERL_TEST_Net_Ping}) { 9 print "1..0 \# Skip: network dependent test\n"; 10 exit; 11 } 12 unless (eval "require Socket") { 13 print "1..0 \# Skip: no Socket\n"; 14 exit; 15 } 16 unless (eval {alarm 0; 1;}) { 17 print "1..0 \# Skip: alarm borks on $^O $^X $] ?\n"; 18 exit; 19 } 20 unless (getservbyname('echo', 'tcp')) { 21 print "1..0 \# Skip: no echo port\n"; 22 exit; 23 } 24} 25 26use strict; 27use Test::More tests => 6; 28BEGIN {use_ok 'Net::Ping'}; 29 30# Hopefully this is never a routeable host 31my $fail_ip = $ENV{NET_PING_FAIL_IP} || "192.0.2.0"; 32 33eval { 34 my $timeout = 11; 35 36 pass('In eval'); 37 local $SIG{ALRM} = sub { die "alarm works" }; 38 pass('SIGALRM can be set on this platform'); 39 alarm $timeout; 40 pass('alarm() can be set on this platform'); 41 42 my $start = time; 43 while (1) { 44 my $ping = Net::Ping->new("tcp", 2); 45 # It does not matter if alive or not 46 $ping->ping("127.0.0.1"); 47 $ping->ping($fail_ip); 48 die "alarm failed" if time > $start + $timeout + 1; 49 } 50}; 51pass('Got out of "infinite loop" okay'); 52 53like($@, qr/alarm works/, 'Make sure it died for a good excuse'); 54 55alarm 0; # Reset alarm 56