use Test::More tests => 30; #use Test::More qw(no_plan); BEGIN { use_ok( 'pidfile' ); } require_ok( 'pidfile'); #ok( 1 == 1, 'trust no one'); print "# TEST_VERBOSE = $ENV{TEST_VERBOSE}$/"; print <<'_EOT_' if ($ENV{TEST_VERBOSE}); # use pidfile; # my $pf = pidfile->new( # Carp::croak's on f +ailure. # path => '/tmp', # default (may chang +e) # name => File::Basename::basename($0), # default # ); # # Methods: is_alive, is_self, activate, (pidfile, getpid, setpid) # DESTROY: unlink $self->pidfile if $self->is_self # _EOT_ my $pf = pidfile->new(); isa_ok( $pf, 'pidfile', 'object'); my $pidfile; is( $pidfile = $pf->pidfile, '/tmp/00_basic.t.pid', "object is the def +ault: $pid file"); ok( !-f $pidfile, "$pidfile does not exist"); ok( $pf->is_alive == 0, "is_alive == 0"); ok( $pf->activate == 1, "activate == 1"); ok( -f $pidfile, "$pidfile now exists"); my $p; { local @ARGV; unshift @ARGV, $pidfile; $p = <>; } ok( $pf->getpid == $p, "getpid matches contents of $pidfile"); ok( $pf->getpid == $$, 'getpid == $$'); ok( $pf->is_alive == 1, "is_alive == 1"); ok( $pf->is_self == 1, "is_self == 1"); eval { $pf->activate }; like( $@, qr/contains a living pid/, 'double activate fails'); $pf = undef; ok( !-f $pidfile, "object gone, $pidfile gone"); my $pf = pidfile->new(); ok( $pf->is_alive == 0, "is_alive == 0"); ok( $pf->is_self == 0, "is_self == 0"); $pf = undef; my $pid; if (defined($pid = fork)) { if ($pid) { ok( 1, "woot! you have a fork! testing a child."); sleep 2; my $pf = pidfile->new(name => '00_basic.t.child'); isa_ok( $pf, 'pidfile', 'parent'); ok($pf->is_alive == 1, 'parent is_alive == 1'); ok($pf->is_self == 0, 'parent is_self == 0'); ok($pf->getpid != $$, 'parent getpid != $$'); ok($pf->getpid == $pid, 'parent getpid == child_pid_fr +om_fork'); eval { $pf->activate }; like( $@, qr/contains a living pid/, 'parent double ac +tivate fai ls'); kill 'TERM', $pid; waitpid $pid, 0; ok($pf->is_alive == 0, 'child has been TERMinated'); ok(!-f '00_basic.t.child', "child's pidfile gone"); # } else { # child my $pf = pidfile->new(name => '00_basic.t.child'); $pf->activate; sleep 300; } } else { ok( 0, 'forking failure'); } eval { $pf = pidfile->new( path => '/etc' ) }; like( $@, qr/not writeable/, "/etc isn't writeable by me"); eval { $pf = pidfile->new( path => '/etc/passwd' ) }; like( $@, qr/not a directory/, "/etc/passwd isn't even a directory"); ok( 1, "if -w and -d work, -r had better!"); eval { $pf = pidfile->new( name => '' ) }; like( $@, qr/name must be set/, "blank name fails"); eval { $pf = pidfile->new( name => undef ) }; like( $@, qr/name must be set/, "undef name fails");
$ perl 00_basic.t 1..30 ok 1 - use pidfile; ok 2 - require pidfile; # TEST_VERBOSE = ok 3 - object isa pidfile ok 4 - object is the default: /tmp/00_basic.t.pid ok 5 - /tmp/00_basic.t.pid does not exist ok 6 - is_alive == 0 ok 7 - activate == 1 ok 8 - /tmp/00_basic.t.pid now exists ok 9 - getpid matches contents of /tmp/00_basic.t.pid ok 10 - getpid == $$ ok 11 - is_alive == 1 ok 12 - is_self == 1 ok 13 - double activate fails ok 14 - object gone, /tmp/00_basic.t.pid gone ok 15 - is_alive == 0 ok 16 - is_self == 0 ok 17 - woot! you have a fork! testing a child. ok 18 - parent isa pidfile ok 19 - parent is_alive == 1 ok 20 - parent is_self == 0 ok 21 - parent getpid != $$ ok 22 - parent getpid == child_pid_from_fork ok 23 - parent double activate fails ok 24 - child has been TERMinated ok 25 - child's pidfile gone ok 26 - /etc isn't writeable by me ok 27 - /etc/passwd isn't even a directory ok 28 - if -w and -d work, -r had better! ok 29 - blank name fails ok 30 - undef name fails
In reply to pidfiles test 00_basic.t
by zengargoyle
in thread do i grok pidfiles?
by zengargoyle
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |