xref: /openbsd/gnu/usr.bin/perl/dist/Time-HiRes/t/ualarm.t (revision 097a140d) 
1use strict;
2
3BEGIN {
4    require Time::HiRes;
5    unless(&Time::HiRes::d_ualarm) {
6        require Test::More;
7        Test::More::plan(skip_all => "no ualarm()");
8    }
9}
10
11use Test::More tests => 12;
12BEGIN { push @INC, '.' }
13use t::Watchdog;
14
15use Config;
16
17SKIP: {
18    skip "no alarm", 2 unless $Config{d_alarm};
19    my $tick = 0;
20    local $SIG{ ALRM } = sub { $tick++ };
21
22    my $one = CORE::time;
23    $tick = 0; Time::HiRes::ualarm(10_000); while ($tick == 0) { }
24    my $two = CORE::time;
25    $tick = 0; Time::HiRes::ualarm(10_000); while ($tick == 0) { }
26    my $three = CORE::time;
27    ok $one == $two || $two == $three
28        or print("# slept too long, $one $two $three\n");
29    print("# tick = $tick, one = $one, two = $two, three = $three\n");
30
31    $tick = 0; Time::HiRes::ualarm(10_000, 10_000); while ($tick < 3) { }
32    ok 1;
33    Time::HiRes::ualarm(0);
34    print("# tick = $tick, one = $one, two = $two, three = $three\n");
35}
36
37eval { Time::HiRes::ualarm(-4) };
38like $@, qr/::ualarm\(-4, 0\): negative time not invented yet/,
39        "negative time error";
40
41# Find the loop size N (a for() loop 0..N-1)
42# that will take more than T seconds.
43
44sub bellish {  # Cheap emulation of a bell curve.
45    my ($min, $max) = @_;
46    my $rand = ($max - $min) / 5;
47    my $sum = 0;
48    for my $i (0..4) {
49        $sum += rand($rand);
50    }
51    return $min + $sum;
52}
53
54# 1_100_000 slightly over 1_000_000,
55# 2_200_000 slightly over 2**31/1000,
56# 4_300_000 slightly over 2**32/1000.
57for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) {
58    my $ok;
59    for my $retry (1..10) {
60        my $alarmed = 0;
61        local $SIG{ ALRM } = sub { $alarmed++ };
62        my $t0 = Time::HiRes::time();
63        print("# t0 = $t0\n");
64        print("# ualarm($n)\n");
65        Time::HiRes::ualarm($n); 1 while $alarmed == 0;
66        my $t1 = Time::HiRes::time();
67        print("# t1 = $t1\n");
68        my $dt = $t1 - $t0;
69        print("# dt = $dt\n");
70        my $r = $dt / ($n/1e6);
71        print("# r = $r\n");
72        $ok =
73            ($n < 1_000_000 || # Too much noise.
74             ($r >= 0.8 && $r <= 1.6));
75        last if $ok;
76        my $nap = bellish(3, 15);
77        printf("# Retrying in %.1f seconds...\n", $nap);
78        Time::HiRes::sleep($nap);
79    }
80    ok $ok or print("# ualarm($n) close enough\n");
81}
82
83{
84    my $alrm0 = 0;
85
86    $SIG{ALRM} = sub { $alrm0++ };
87    my $t0 = Time::HiRes::time();
88    my $got0 = Time::HiRes::ualarm(500_000);
89
90    my($alrm, $t1);
91    do {
92        $alrm = $alrm0;
93        $t1 = Time::HiRes::time();
94    } while $t1 - $t0 <= 0.3;
95    my $got1 = Time::HiRes::ualarm(0);
96
97    print("# t0 = $t0\n");
98    print("# got0 = $got0\n");
99    print("# t1 = $t1\n");
100    printf("# t1 - t0 = %s\n", ($t1 - $t0));
101    print("# got1 = $got1\n");
102    ok $got0 == 0 or print("# $got0\n");
103    SKIP: {
104        skip "alarm interval exceeded", 2 if $t1 - $t0 >= 0.5;
105        ok $got1 > 0;
106        ok $alrm == 0;
107    }
108    ok $got1 < 300_000;
109    my $got2 = Time::HiRes::ualarm(0);
110    ok $got2 == 0 or print("# $got2\n");
111}
112
1131;
114