"Fossies" - the Fresh Open Source Software Archive

Member "perl-5.32.1/dist/Net-Ping/t/001_new.t" (18 Dec 2020, 2007 Bytes) of package /linux/misc/perl-5.32.1.tar.xz:

    1 use warnings;
    2 use strict;
    3 use Config;
    4 
    5 BEGIN {
    6   unless (my $port = getservbyname('echo', 'tcp')) {
    7     print "1..0 \# Skip: no echo port\n";
    8     exit;
    9   }
   10   unless ($Config{d_getpbyname}) {
   11     print "1..0 \# Skip: no getprotobyname\n";
   12     exit;
   13   }
   14 }
   15 
   16 use Test::More qw(no_plan);
   17 BEGIN {use_ok('Net::Ping')};
   18 
   19 # plain ol' constuctor call
   20 my $p = Net::Ping->new();
   21 isa_ok($p, "Net::Ping");
   22 
   23 # call new from an instantiated object
   24 my $p2 = $p->new();
   25 isa_ok($p2, "Net::Ping");
   26 
   27 # named args
   28 my $p3 = Net::Ping->new({proto => 'tcp', ttl => 5});
   29 isa_ok($p3, "Net::Ping");
   30 
   31 # check for invalid proto
   32 eval {
   33     $p = Net::Ping->new("thwackkk");
   34 };
   35 like($@, qr/Protocol for ping must be "icmp", "icmpv6", "udp", "tcp", "syn", "stream" or "external"/, "new() errors for invalid protocol");
   36 
   37 # check for invalid timeout
   38 eval {
   39     $p = Net::Ping->new("tcp", -1);
   40 };
   41 like($@, qr/Default timeout for ping must be greater than 0 seconds/, "new() errors for invalid timeout");
   42 
   43 # check for invalid data sizes
   44 eval {
   45     $p = Net::Ping->new("udp", 10, -1);
   46 };
   47 like($@, qr/Data for ping must be from/, "new() errors for invalid data size");
   48 
   49 eval {
   50     $p = Net::Ping->new("udp", 10, 70000);
   51 };
   52 like($@, qr/Data for ping must be from/, "new() errors for invalid data size");
   53 
   54 # force failures for udp
   55 
   56 
   57 # force failures for tcp
   58 SKIP: {
   59     # diag "Checking icmp";
   60     eval { $p = Net::Ping->new('icmp'); };
   61     skip "icmp ping requires root privileges.", 3
   62       if !Net::Ping::_isroot() or $^O eq 'MSWin32';
   63     if($> and $^O ne 'VMS' and $^O ne 'cygwin') {
   64         like($@, qr/icmp ping requires root privilege/, "Need root for icmp");
   65         skip "icmp tests require root", 2;
   66     } else {
   67         isa_ok($p, "Net::Ping");
   68     }
   69 
   70     # set IP TOS to "Minimum Delay"
   71     $p = Net::Ping->new("icmp", undef, undef, undef, 8);
   72     isa_ok($p, "Net::Ping");
   73 
   74     # This really shouldn't work.  Not sure who to blame.
   75     $p = Net::Ping->new("icmp", undef, undef, undef, "does this fail");
   76     isa_ok($p, "Net::Ping");
   77 }
   78