ext/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;
  29 use Net::Ping;
  30
  31 plan tests => 6;
  32
  33 # Everything compiled
  34 ok 1;
  35
  36 eval {
  37   my $timeout = 11;
  38
  39   ok 1; # In eval
  40   local $SIG{ALRM} = sub { die "alarm works" };
  41   ok 1; # SIGALRM can be set on this platform
  42   alarm $timeout;
  43   ok 1; # alarm() can be set on this platform
  44
  45   my $start = time;
  46   while (1) {
  47     my $ping = Net::Ping->new("tcp", 2);
  48     # It does not matter if alive or not
  49     $ping->ping("127.0.0.1");
  50     $ping->ping("172.29.249.249");
  51     die "alarm failed" if time > $start + $timeout + 1;
  52   }
  53 };
  54 # Got out of "infinite loop" okay
  55 ok 1;
  56
  57 # Make sure it died for a good excuse
  58 ok $@ =~ /alarm works/ or die $@;
  59
  60 alarm 0; # Reset alarm