This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
cc741e766943a9d270a7cc8ddd35699d16044db6
[perl5.git] / t / lib / time-hires.t
1 BEGIN {
2     chdir 't' if -d 't';
3     @INC = '../lib';
4 }
5
6 BEGIN { $| = 1; print "1..19\n"; }
7
8 END {print "not ok 1\n" unless $loaded;}
9
10 use Time::HiRes qw(tv_interval);
11
12 $loaded = 1;
13
14 print "ok 1\n";
15
16 use strict;
17
18 my $have_gettimeofday   = defined &Time::HiRes::gettimeofday;
19 my $have_usleep         = defined &Time::HiRes::usleep;
20 my $have_ualarm         = defined &Time::HiRes::ualarm;
21
22 import Time::HiRes 'gettimeofday'       if $have_gettimeofday;
23 import Time::HiRes 'usleep'             if $have_usleep;
24 import Time::HiRes 'ualarm'             if $have_ualarm;
25
26 use Config;
27
28 sub skip {
29     map { print "ok $_ (skipped)\n" } @_;
30 }
31
32 sub ok {
33     my ($n, $result, @info) = @_;
34     if ($result) {
35         print "ok $n\n";
36     }
37     else {
38         print "not ok $n\n";
39         print "# @info\n" if @info;
40     }
41 }
42
43 if (!$have_gettimeofday) {
44     skip 2..6;
45 }
46 else {
47     my @one = gettimeofday();
48     ok 2, @one == 2, 'gettimeofday returned ', 0+@one, ' args';
49     ok 3, $one[0] > 850_000_000, "@one too small";
50
51     sleep 1;
52
53     my @two = gettimeofday();
54     ok 4, ($two[0] > $one[0] || ($two[0] == $one[0] && $two[1] > $one[1])),
55             "@two is not greater than @one";
56
57     my $f = Time::HiRes::time;
58     ok 5, $f > 850_000_000, "$f too small";
59     ok 6, $f - $two[0] < 2, "$f - @two >= 2";
60 }
61
62 if (!$have_usleep) {
63     skip 7..8;
64 }
65 else {
66     my $one = time;
67     usleep(10_000);
68     my $two = time;
69     usleep(10_000);
70     my $three = time;
71     ok 7, $one == $two || $two == $three, "slept too long, $one $two $three";
72
73     if (!$have_gettimeofday) {
74         skip 8;
75     }
76     else {
77         my $f = Time::HiRes::time;
78         usleep(500_000);
79         my $f2 = Time::HiRes::time;
80         my $d = $f2 - $f;
81         ok 8, $d > 0.4 && $d < 0.8, "slept $d secs $f to $f2";
82     }
83 }
84
85 # Two-arg tv_interval() is always available.
86 {
87     my $f = tv_interval [5, 100_000], [10, 500_000];
88     ok 9, $f == 5.4, $f;
89 }
90
91 if (!$have_gettimeofday) {
92     skip 10;
93 }
94 else {
95     my $r = [gettimeofday()];
96     my $f = tv_interval $r;
97     ok 10, $f < 2, $f;
98 }
99
100 if (!$have_usleep) {
101     skip 11;
102 }
103 else {
104     my $r = [gettimeofday()];
105     #jTime::HiRes::sleep 0.5;
106     Time::HiRes::sleep( 0.5 );
107     my $f = tv_interval $r;
108     ok 11, $f > 0.4 && $f < 0.8, "slept $f secs";
109 }
110
111 if (!$have_ualarm) {
112     skip 12..13;
113 }
114 else {
115     my $tick = 0;
116     local $SIG{ALRM} = sub { $tick++ };
117
118     my $one = time; $tick = 0; ualarm(10_000); sleep until $tick;
119     my $two = time; $tick = 0; ualarm(10_000); sleep until $tick;
120     my $three = time;
121     ok 12, $one == $two || $two == $three, "slept too long, $one $two $three";
122
123     $tick = 0;
124     ualarm(10_000, 10_000);
125     sleep until $tick >= 3;
126     ok 13, 1;
127     ualarm(0);
128 }
129
130 # new test: did we even get close?
131
132 {
133  my $t = time();
134  my $tf = Time::HiRes::time();
135  ok 14, ($tf >= $t) && (($tf - $t) <= 1),
136   "time $t differs from Time::HiRes::time $tf";
137 }
138
139 unless (defined &Time::HiRes::gettimeofday
140         && defined &Time::HiRes::ualarm
141         && defined &Time::HiRes::usleep) {
142     for (15..17) {
143         print "ok $_ # skipped\n";
144     }
145 } else {
146     use Time::HiRes qw (time alarm sleep);
147
148     my ($f, $r, $i);
149
150     print "# time...";
151     $f = time; 
152     print "$f\nok 15\n";
153
154     print "# sleep...";
155     $r = [Time::HiRes::gettimeofday];
156     sleep (0.5);
157     print Time::HiRes::tv_interval($r), "\nok 16\n";
158
159     $r = [Time::HiRes::gettimeofday];
160     $i = 5;
161     $SIG{ALRM} = "tick";
162     while ($i)
163     {
164         alarm(0.3);
165         select (undef, undef, undef, 10);
166         print "# Select returned! $i ", Time::HiRes::tv_interval ($r), "\n";
167     }
168
169     sub tick
170     {
171         $i--;
172         print "# Tick! $i ", Time::HiRes::tv_interval ($r), "\n";
173     }
174     $SIG{ALRM} = 'DEFAULT';
175
176     print "ok 17\n";
177 }
178
179 unless (defined &Time::HiRes::setitimer
180         && defined &Time::HiRes::getitimer
181         && exists &Time::HiRes::ITIMER_VIRTUAL
182         && $Config{d_select}) {
183     for (18..19) {
184         print "ok $_ # Skip: no virtual interval timers\n";
185     }
186 } else {
187     use Time::HiRes qw (setitimer getitimer ITIMER_VIRTUAL);
188
189     my $i = 3;
190     my $r = [Time::HiRes::gettimeofday];
191
192     $SIG{VTALRM} = sub {
193         $i ? $i-- : setitimer(ITIMER_VIRTUAL, 0);
194         print "# Tick! $i ", Time::HiRes::tv_interval($r), "\n";
195     };  
196
197     print "# setitimer: ", join(" ", setitimer(ITIMER_VIRTUAL, 0.5, 0.4)), "\n";
198
199     # Assume interval timer granularity of 0.05 seconds.  Too bold?
200     print "not " unless abs(getitimer(ITIMER_VIRTUAL) / 0.5) - 1 < 0.1;
201     print "ok 18\n";
202
203     print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
204
205     while (getitimer(ITIMER_VIRTUAL)) {
206         my $j; $j++ for 1..1000; # Can't be unbreakable, must test getitimer().
207     }
208
209     print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
210
211     print "not " unless getitimer(ITIMER_VIRTUAL) == 0;
212     print "ok 19\n";
213
214     $SIG{VTALRM} = 'DEFAULT';
215 }
216