dist/Net-Ping/t/190_alarm.t

   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
   6 BEGIN {
   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
  27 use strict;
  28 use Test::More tests => 6;
  29 BEGIN {use_ok 'Net::Ping'};
  30
  31 eval {
  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 };
  49 pass('Got out of "infinite loop" okay');
  50
  51 like($@, qr/alarm works/, 'Make sure it died for a good excuse');
  52
  53 alarm 0; # Reset alarm