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