File: forks08.t

package info (click to toggle)
libforks-perl 0.36-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid, trixie
  • size: 752 kB
  • sloc: perl: 4,705; ansic: 3,086; makefile: 2
file content (107 lines) | stat: -rwxr-xr-x 4,023 bytes parent folder | download | duplicates (3)
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;