Add more debug output to the test.
[p5sagit/p5-mst-13.2.git] / t / lib / time-hires.t
CommitLineData
dcf686c9 1BEGIN {
2 chdir 't' if -d 't';
3 @INC = '../lib';
4}
5
6BEGIN { $| = 1; print "1..17\n"; }
7
8END {print "not ok 1\n" unless $loaded;}
9
10use Time::HiRes qw(tv_interval);
11
12$loaded = 1;
13
14print "ok 1\n";
15
16use strict;
17
18my $have_gettimeofday = defined &Time::HiRes::gettimeofday;
19my $have_usleep = defined &Time::HiRes::usleep;
20my $have_ualarm = defined &Time::HiRes::ualarm;
21
22import Time::HiRes 'gettimeofday' if $have_gettimeofday;
23import Time::HiRes 'usleep' if $have_usleep;
24import Time::HiRes 'ualarm' if $have_ualarm;
25
26sub skip {
27 map { print "ok $_ (skipped)\n" } @_;
28}
29
30sub ok {
31 my ($n, $result, @info) = @_;
32 if ($result) {
33 print "ok $n\n";
34 }
35 else {
36 print "not ok $n\n";
37 print "# @info\n" if @info;
38 }
39}
40
41if (!$have_gettimeofday) {
42 skip 2..6;
43}
44else {
45 my @one = gettimeofday();
46 ok 2, @one == 2, 'gettimeofday returned ', 0+@one, ' args';
47 ok 3, $one[0] > 850_000_000, "@one too small";
48
49 sleep 1;
50
51 my @two = gettimeofday();
52 ok 4, ($two[0] > $one[0] || ($two[0] == $one[0] && $two[1] > $one[1])),
53 "@two is not greater than @one";
54
55 my $f = Time::HiRes::time;
56 ok 5, $f > 850_000_000, "$f too small";
57 ok 6, $f - $two[0] < 2, "$f - @two >= 2";
58}
59
60if (!$have_usleep) {
61 skip 7..8;
62}
63else {
64 my $one = time;
65 usleep(10_000);
66 my $two = time;
67 usleep(10_000);
68 my $three = time;
69 ok 7, $one == $two || $two == $three, "slept too long, $one $two $three";
70
71 if (!$have_gettimeofday) {
72 skip 8;
73 }
74 else {
75 my $f = Time::HiRes::time;
76 usleep(500_000);
77 my $f2 = Time::HiRes::time;
78 my $d = $f2 - $f;
79 ok 8, $d > 0.4 && $d < 0.8, "slept $d secs $f to $f2";
80 }
81}
82
83# Two-arg tv_interval() is always available.
84{
85 my $f = tv_interval [5, 100_000], [10, 500_000];
86 ok 9, $f == 5.4, $f;
87}
88
89if (!$have_gettimeofday) {
90 skip 10;
91}
92else {
93 my $r = [gettimeofday()];
94 my $f = tv_interval $r;
95 ok 10, $f < 2, $f;
96}
97
98if (!$have_usleep) {
99 skip 11;
100}
101else {
102 my $r = [gettimeofday()];
103 #jTime::HiRes::sleep 0.5;
104 Time::HiRes::sleep( 0.5 );
105 my $f = tv_interval $r;
106 ok 11, $f > 0.4 && $f < 0.8, "slept $f secs";
107}
108
109if (!$have_ualarm) {
110 skip 12..13;
111}
112else {
113 my $tick = 0;
114 local $SIG{ALRM} = sub { $tick++ };
115
116 my $one = time; $tick = 0; ualarm(10_000); sleep until $tick;
117 my $two = time; $tick = 0; ualarm(10_000); sleep until $tick;
118 my $three = time;
119 ok 12, $one == $two || $two == $three, "slept too long, $one $two $three";
120
121 $tick = 0;
122 ualarm(10_000, 10_000);
123 sleep until $tick >= 3;
124 ok 13, 1;
125 ualarm(0);
126}
127
128# new test: did we even get close?
129
130{
131 my $t = time();
132 my $tf = Time::HiRes::time();
133 ok 14, ($tf >= $t) && (($tf - $t) <= 1),
134 "time $t differs from Time::HiRes::time $tf";
135}
136
137unless (defined &Time::HiRes::gettimeofday
138 && defined &Time::HiRes::ualarm
139 && defined &Time::HiRes::usleep) {
140 for (15..17) {
141 print "ok $_ # skipped\n";
142 }
143} else {
144 use Time::HiRes qw (time alarm sleep);
145
146 my ($f, $r, $i);
147
148 print "# time...";
149 $f = time;
150 print "$f\nok 15\n";
151
152 print "# sleep...";
153 $r = [Time::HiRes::gettimeofday];
154 sleep (0.5);
155 print Time::HiRes::tv_interval($r), "\nok 16\n";
156
157 $r = [Time::HiRes::gettimeofday];
158 $i = 5;
159 $SIG{ALRM} = "tick";
160 while ($i)
161 {
162 alarm(2.5);
163 select (undef, undef, undef, 10);
164 print "# Select returned! ", Time::HiRes::tv_interval ($r), "\n";
165 }
166
167 sub tick
168 {
169 print "# Tick! ", Time::HiRes::tv_interval ($r), "\n";
170 $i--;
171 }
172 $SIG{ALRM} = 'DEFAULT';
173
174 print "ok 17\n";
175}
176