f553c6342458c86e8d6d0b3ad1f2b3b0b5f678a9
[perl.git] / dist / Net-Ping / t / 520_icmp_ttl.t
1 # Test to perform icmp protocol testing.
2 # Root access is required.
3
4 BEGIN {
5   unless (eval "require Socket") {
6     print "1..0 \# Skip: no Socket\n";
7     exit;
8   }
9 }
10
11 use Test::More qw(no_plan);
12 BEGIN {use_ok('Net::Ping')};
13
14 SKIP: {
15   skip "icmp ping requires root privileges.", 1
16     if ($> and $^O ne 'VMS' and $^O ne 'cygwin')
17       or (($^O eq 'MSWin32' or $^O eq 'cygwin')
18     and !IsAdminUser())
19   or ($^O eq 'VMS'
20       and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/));
21   my $p = new Net::Ping ("icmp",undef,undef,undef,undef,undef);
22   isa_ok($p, 'Net::Ping');
23   ok $p->ping("127.0.0.1");
24   $p->close();
25   $p = new Net::Ping ("icmp",undef,undef,undef,undef,0);
26   ok $p->ping("127.0.0.1");
27   $p->close();
28   $p = undef();
29   $p = new Net::Ping ("icmp",undef,undef,undef,undef,1);
30   isa_ok($p, 'Net::Ping');
31   $p = undef();
32   $p = eval 'new Net::Ping ("icmp",undef,undef,undef,undef,-1)';
33   ok(!defined($p));
34   $p = undef();
35   $p = eval 'new Net::Ping ("icmp",undef,undef,undef,undef,256)';
36   ok(!defined($p));
37   $p = new Net::Ping ("icmp",undef,undef,undef,undef,10);
38   ok $p->ping("127.0.0.1");
39   $p->close();
40 }
41
42 sub IsAdminUser {
43   return unless $^O eq 'MSWin32' or $^O eq "cygwin";
44   return unless eval { require Win32 };
45   return unless defined &Win32::IsAdminUser;
46   return Win32::IsAdminUser();
47 }