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
108
109
110
111
112
113
|
use strict;
BEGIN {
require Time::HiRes;
unless(&Time::HiRes::d_ualarm) {
require Test::More;
Test::More::plan(skip_all => "no ualarm()");
}
}
use Test::More tests => 12;
BEGIN { push @INC, '.' }
use t::Watchdog;
use Config;
SKIP: {
skip "no alarm", 2 unless $Config{d_alarm};
my $tick = 0;
local $SIG{ ALRM } = sub { $tick++ };
my $one = CORE::time;
$tick = 0; Time::HiRes::ualarm(10_000); while ($tick == 0) { }
my $two = CORE::time;
$tick = 0; Time::HiRes::ualarm(10_000); while ($tick == 0) { }
my $three = CORE::time;
ok $one == $two || $two == $three
or print("# slept too long, $one $two $three\n");
print("# tick = $tick, one = $one, two = $two, three = $three\n");
$tick = 0; Time::HiRes::ualarm(10_000, 10_000); while ($tick < 3) { }
ok 1;
Time::HiRes::ualarm(0);
print("# tick = $tick, one = $one, two = $two, three = $three\n");
}
eval { Time::HiRes::ualarm(-4) };
like $@, qr/::ualarm\(-4, 0\): negative time not invented yet/,
"negative time error";
# Find the loop size N (a for() loop 0..N-1)
# that will take more than T seconds.
sub bellish { # Cheap emulation of a bell curve.
my ($min, $max) = @_;
my $rand = ($max - $min) / 5;
my $sum = 0;
for my $i (0..4) {
$sum += rand($rand);
}
return $min + $sum;
}
# 1_100_000 slightly over 1_000_000,
# 2_200_000 slightly over 2**31/1000,
# 4_300_000 slightly over 2**32/1000.
for my $n (100_000, 1_100_000, 2_200_000, 4_300_000) {
my $ok;
for my $retry (1..10) {
my $alarmed = 0;
local $SIG{ ALRM } = sub { $alarmed++ };
my $t0 = Time::HiRes::time();
print("# t0 = $t0\n");
print("# ualarm($n)\n");
Time::HiRes::ualarm($n); 1 while $alarmed == 0;
my $t1 = Time::HiRes::time();
print("# t1 = $t1\n");
my $dt = $t1 - $t0;
print("# dt = $dt\n");
my $r = $dt / ($n/1e6);
print("# r = $r\n");
$ok =
($n < 1_000_000 || # Too much noise.
($r >= 0.8 && $r <= 1.6));
last if $ok;
my $nap = bellish(3, 15);
printf("# Retrying in %.1f seconds...\n", $nap);
Time::HiRes::sleep($nap);
}
ok $ok or print("# ualarm($n) close enough\n");
}
{
my $alrm0 = 0;
$SIG{ALRM} = sub { $alrm0++ };
my $t0 = Time::HiRes::time();
my $got0 = Time::HiRes::ualarm(500_000);
my($alrm, $t1);
do {
$alrm = $alrm0;
$t1 = Time::HiRes::time();
} while $t1 - $t0 <= 0.3;
my $got1 = Time::HiRes::ualarm(0);
print("# t0 = $t0\n");
print("# got0 = $got0\n");
print("# t1 = $t1\n");
printf("# t1 - t0 = %s\n", ($t1 - $t0));
print("# got1 = $got1\n");
ok $got0 == 0 or print("# $got0\n");
SKIP: {
skip "alarm interval exceeded", 2 if $t1 - $t0 >= 0.5;
ok $got1 > 0;
ok $alrm == 0;
}
ok $got1 < 300_000;
my $got2 = Time::HiRes::ualarm(0);
ok $got2 == 0 or print("# $got2\n");
}
1;
|
