xref: /openbsd-src/gnu/usr.bin/perl/dist/Net-Ping/t/001_new.t (revision de8cc8edbc71bd3e3bc7fbffa27ba0e564c37d8b)

use warnings;
use strict;
use Config;

BEGIN {
  unless (my $port = getservbyname('echo', 'tcp')) {
    print "1..0 \# Skip: no echo port\n";
    exit;
  }
  unless ($Config{d_getpbyname}) {
    print "1..0 \# Skip: no getprotobyname\n";
    exit;
  }
}

use Test::More qw(no_plan);
BEGIN {use_ok('Net::Ping')};

# plain ol' constuctor call
my $p = Net::Ping->new();
isa_ok($p, "Net::Ping");

# call new from an instantiated object
my $p2 = $p->new();
isa_ok($p2, "Net::Ping");

# named args
my $p3 = Net::Ping->new({proto => 'tcp', ttl => 5});
isa_ok($p3, "Net::Ping");

# check for invalid proto
eval {
    $p = Net::Ping->new("thwackkk");
};
like($@, qr/Protocol for ping must be "icmp", "icmpv6", "udp", "tcp", "syn", "stream" or "external"/, "new() errors for invalid protocol");

# check for invalid timeout
eval {
    $p = Net::Ping->new("tcp", -1);
};
like($@, qr/Default timeout for ping must be greater than 0 seconds/, "new() errors for invalid timeout");

# check for invalid data sizes
eval {
    $p = Net::Ping->new("udp", 10, -1);
};
like($@, qr/Data for ping must be from/, "new() errors for invalid data size");

eval {
    $p = Net::Ping->new("udp", 10, 70000);
};
like($@, qr/Data for ping must be from/, "new() errors for invalid data size");

# force failures for udp


# force failures for tcp
SKIP: {
    # diag "Checking icmp";
    eval { $p = Net::Ping->new('icmp'); };
    skip "icmp ping requires root privileges.", 3
      if !Net::Ping::_isroot() or $^O eq 'MSWin32';
    if($> and $^O ne 'VMS' and $^O ne 'cygwin') {
        like($@, qr/icmp ping requires root privilege/, "Need root for icmp");
        skip "icmp tests require root", 2;
    } else {
        isa_ok($p, "Net::Ping");
    }

    # set IP TOS to "Minimum Delay"
    $p = Net::Ping->new("icmp", undef, undef, undef, 8);
    isa_ok($p, "Net::Ping");

    # This really shouldn't work.  Not sure who to blame.
    $p = Net::Ping->new("icmp", undef, undef, undef, "does this fail");
    isa_ok($p, "Net::Ping");
}