1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
|
#!/usr/local/bin/perl -w
my @custom_inc;
BEGIN {
if ($ENV{PERL_CORE}) {
chdir 't' if -d 't';
@custom_inc = @INC = '../lib';
} elsif (!grep /blib/, @INC) {
chdir 't' if -d 't';
unshift @INC, (@custom_inc = ('../blib/lib', '../blib/arch'));
}
}
BEGIN {delete $ENV{THREADS_DEBUG}} # no debugging during testing!
use forks; # must be done _before_ Test::More which loads real threads.pm
use forks::shared;
diag( <<EOD );
These tests validate overloaded sleep behavior.
EOD
# "Unpatch" Test::More, who internally tries to disable threads
BEGIN {
no warnings 'redefine';
if ($] < 5.008001) {
require forks::shared::global_filter;
import forks::shared::global_filter 'Test::Builder';
require Test::Builder;
*Test::Builder::share = \&threads::shared::share;
*Test::Builder::lock = \&threads::shared::lock;
Test::Builder->new->reset;
}
}
# Patch Test::Builder to add fork-thread awareness
{
no warnings 'redefine';
my $_sanity_check_old = \&Test::Builder::_sanity_check;
*Test::Builder::_sanity_check = sub {
my $self = $_[0];
# Don't bother with an ending if this is a forked copy. Only the parent
# should do the ending.
if( $self->{Original_Pid} != $$ ) {
return;
}
$_sanity_check_old->(@_);
};
}
use Test::More tests => 11;
use strict;
use warnings;
use Time::HiRes;
# Check that main thread waits full 5 seconds after CHLD signal
my $t1 = threads->new(sub { sleep 1; });
my $time = sleep 5;
$t1->join();
my $time_int = sprintf("%.0f", $time);
cmp_ok($time_int, '>=', 5,'check that main thread sleeps full 5 seconds after CHLD signal');
cmp_ok($time_int, '<=', 7,'check that main thread did not sleep too long after CHLD signal'); #clock drift / signal delay tolerance
# Check that main thread waits full 5 seconds after CHLD signal
$t1 = threads->new(sub { sleep 1; });
$time = Time::HiRes::sleep 5;
$t1->join();
$time_int = sprintf("%.0f", $time);
cmp_ok($time_int, '>=', 5,'check that main thread sleeps full 5 seconds after CHLD signal');
cmp_ok($time_int, '<=', 7,'check that main thread did not sleep too long after CHLD signal'); #clock drift / signal delay tolerance
# Check that main thread waits full 5 seconds after CHLD signal
SKIP: {
skip('usleep not supported on this platform',2) unless &Time::HiRes::d_usleep && defined(my $t = eval { &Time::HiRes::usleep(0) }) && !$@;
$t1 = threads->new(sub { sleep 1; });
$time = &Time::HiRes::usleep(5000000);
$t1->join();
$time_int = sprintf("%.0f", $time / 10**6);
cmp_ok($time_int, '>=', 5,'check that main thread sleeps full 5 seconds after CHLD signal');
cmp_ok($time_int, '<=', 7,'check that main thread did not sleep too long after CHLD signal'); #clock drift / signal delay tolerance
}
# Check that main thread waits full 5 seconds after CHLD signal
SKIP: {
skip('Time::HiRes::nanosleep function not supported on this platform',2)
unless &Time::HiRes::d_nanosleep && defined(my $t = eval { &Time::HiRes::nanosleep(0) }) && !$@;
$t1 = threads->new(sub { sleep 1; });
$time = &Time::HiRes::nanosleep(5000000000);
$t1->join();
$time_int = sprintf("%.0f", ($time / 10**9));
cmp_ok($time_int, '>=', 5,'check that main thread sleeps full 5 seconds after CHLD signal');
cmp_ok($time_int, '<=', 7,'check that main thread did not sleep too long after CHLD signal'); #clock drift / signal delay tolerance
}
# Check that main thread waits full 5 seconds after CHLD signal
my $cnt = 0;
$SIG{CHLD} = sub { $cnt++ };
$t1 = threads->new(sub { sleep 1; });
$time = sleep 5;
$t1->join();
$time_int = sprintf("%.0f", $time);
cmp_ok($time_int, '>=', 5,'check that main thread sleeps full 5 seconds after custom CHLD signal');
cmp_ok($time_int, '<=', 7,'check that main thread did not sleep too long after CHLD signal'); #clock drift / signal delay tolerance
cmp_ok($cnt, '>=', 1,'check that custom CHLD signal was called');
1;
|