File Coverage

blib/lib/Test/Mock/Time.pm
Criterion Covered Total %
statement 313 365 85.7
branch 98 172 56.9
condition 19 33 57.5
subroutine 62 70 88.5
pod 1 1 100.0
total 493 641 76.9


line stmt bran cond sub pod time code
1             package Test::Mock::Time;
2 8     8   454926 use 5.008001;
  8         78  
3 8     8   33 use warnings;
  8         13  
  8         161  
4 8     8   31 use strict;
  8         11  
  8         144  
5 8     8   937 use utf8;
  8         30  
  8         37  
6 8     8   174 use Carp;
  8         13  
  8         527  
7              
8             our $VERSION = 'v0.1.7';
9              
10 8     8   3000 use Export::Attrs;
  8         52501  
  8         38  
11 8     8   552 use List::Util qw( any );
  8         15  
  8         697  
12 8     8   49 use Scalar::Util qw( weaken );
  8         15  
  8         330  
13 8     8   3087 use Test::MockModule;
  8         29704  
  8         249  
14              
15 8     8   46 use constant TIME_HIRES_CLOCK_NOT_SUPPORTED => -1;
  8         13  
  8         512  
16 8     8   38 use constant MICROSECONDS => 1_000_000;
  8         23  
  8         290  
17 8     8   34 use constant NANOSECONDS => 1_000_000_000;
  8         13  
  8         280  
18              
19 8     8   35 use constant DEFAULT_WAIT_ONE_TICK => 0.05;
  8         14  
  8         3234  
20             our $WAIT_ONE_TICK = DEFAULT_WAIT_ONE_TICK;
21              
22             my $Absolute = time; # usual time starts at current actual time
23             my $Monotonic = 0; # monotonic time starts at 0 if not available
24             my $Relative = 0; # how many deterministic time passed since start
25             my @Timers; # active timers
26             my @Timers_ns; # inactive timers
27             my %Module; # keep module mocks
28              
29              
30             _mock_core_global();
31             ## no critic (RequireCheckingReturnValueOfEval)
32             eval {
33                 require Time::HiRes;
34                 Time::HiRes->import(qw( CLOCK_REALTIME CLOCK_MONOTONIC ));
35                 _mock_time_hires();
36             };
37             eval {
38                 require EV;
39                 _mock_ev();
40             };
41             eval {
42                 require Mojolicious;
43                 Mojolicious->VERSION('6'); # may be compatible with older ones, needs testing
44                 require Mojo::Reactor::Poll;
45                 _mock_mojolicious();
46             };
47              
48              
49             # FIXME make ff() reentrant
50             sub ff :Export(:DEFAULT) {
51 51     51 1 821     my ($dur) = @_;
52              
53                 @Timers = sort {
54 51         146         $a->{start}+$a->{after} <=> $b->{start}+$b->{after} or
55                     $a->{id} cmp $b->{id} # preserve order to simplify tests
56 0 0       0         } @Timers;
57 51 100       192     my $next_at = @Timers ? $Timers[0]{start}+$Timers[0]{after} : 0;
58 51         340     $next_at = sprintf '%.6f', $next_at;
59              
60 51 100       139     if (!defined $dur) {
61 23 50       103         $dur = $next_at > $Relative ? $next_at - $Relative : 0;
62 23         88         $dur = sprintf '%.6f', $dur;
63                 }
64 51 50       157     croak "ff($dur): negative time not invented yet" if $dur < 0;
65              
66 51 100 100     228     if ($next_at == 0 || $next_at > $Relative+$dur) {
67 28         48         $Relative += $dur;
68 28         99         $Relative = sprintf '%.6f', $Relative;
69 28         78         return;
70                 }
71              
72 23 50       59     if ($next_at > $Relative) {
73 23         46         $dur -= $next_at - $Relative;
74 23         117         $dur = sprintf '%.6f', $dur;
75 23         42         $Relative = $next_at;
76                 }
77 23         60     my $cb = $Timers[0]{cb};
78 23 100       88     if ($Timers[0]{repeat} == 0) {
79 7 100       17         if ($Timers[0]{watcher}) {
80 3         12             _stop_timer($Timers[0]{watcher});
81                     }
82                     else {
83 4         6             shift @Timers;
84                     }
85                 }
86                 else {
87 16         37         $Timers[0]{after} = $Timers[0]{repeat};
88 16         34         $Timers[0]{start} = $Relative;
89                 }
90 23         78     $cb->();
91 23         302     @_ = ($dur);
92 23         107     goto &ff;
93 8     8   54 }
  8         25  
  8         62  
94              
95             {
96             my $next_id = 0;
97             sub _add_timer {
98 20     20   56     my ($loop, $after, $repeat, $cb, $watcher) = @_;
99 20         89     my $id = sprintf 'fake_%05d', $next_id++;
100 20 50       270     push @Timers, {
    50          
101                     id => $id,
102                     start => $Relative,
103                     loop => $loop,
104                     after => sprintf('%.6f', $after < 0 ? 0 : $after),
105                     repeat => sprintf('%.6f', $repeat < 0 ? 0 : $repeat),
106                     cb => $cb,
107                     watcher => $watcher,
108                 };
109 20 100       91     if ($watcher) {
110 13         40         weaken($Timers[-1]{watcher});
111                 }
112 20         42     return $id;
113             }
114             }
115              
116             sub _start_timer {
117 2     2   5     my ($watcher) = @_;
118 2 50       4     my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $watcher } @Timers_ns;
  4         17  
119 2 50       6     if ($timer) {
120 2 50       4         @Timers_ns = grep { !$_->{watcher} || $_->{watcher} ne $watcher } @Timers_ns;
  4         16  
121 2         4         push @Timers, $timer;
122                 }
123 2         4     return;
124             }
125              
126             sub _stop_timer {
127 13     13   25     my ($watcher) = @_;
128 13 50       29     my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $watcher } @Timers;
  6         50  
129 13 100       32     if ($timer) {
130 6 50       13         @Timers = grep { !$_->{watcher} || $_->{watcher} ne $watcher } @Timers;
  6         40  
131 6         16         push @Timers_ns, $timer;
132                 }
133 13         49     return;
134             }
135              
136             sub _mock_core_global {
137 8     8   61     $Module{'CORE::GLOBAL'} = Test::MockModule->new('CORE::GLOBAL', no_auto=>1);
138                 $Module{'CORE::GLOBAL'}->mock(time => sub () {
139 46     46   676         return int($Absolute + $Relative);
140 8         354     });
141                 $Module{'CORE::GLOBAL'}->mock(localtime => sub (;$) {
142 12 50   12   2303082         my $time = defined $_[0] ? $_[0] : int($Absolute + $Relative);
143 12         407         return CORE::localtime($time);
144 8         630     });
145                 $Module{'CORE::GLOBAL'}->mock(gmtime => sub (;$) {
146 13 100   13   829         my $time = defined $_[0] ? $_[0] : int($Absolute + $Relative);
147 13         96         return CORE::gmtime($time);
148 8         386     });
149                 $Module{'CORE::GLOBAL'}->mock(sleep => sub ($) {
150 16     16   164         my $dur = int $_[0];
151 16 100       64         croak 'sleep with negative value is not supported' if $dur < 0;
152 14         27         $Relative += $dur;
153 14         67         $Relative = sprintf '%.6f', $Relative;
154 14         37         return $dur;
155 8         388     });
156 8         387     return;
157             }
158              
159             sub _mock_time_hires {
160             # Do not improve precision of current actual time to simplify tests.
161             #$Absolute = Time::HiRes::time();
162             # Use current actual monotonic time.
163 8     8   138     $Monotonic = Time::HiRes::clock_gettime(CLOCK_MONOTONIC());
164              
165 8         306     $Module{'Time::HiRes'} = Test::MockModule->new('Time::HiRes');
166                 $Module{'Time::HiRes'}->mock(time => sub () {
167 8     8   1102929         return 0+sprintf '%.6f', $Absolute + $Relative;
168 8         274     });
169                 $Module{'Time::HiRes'}->mock(gettimeofday => sub () {
170 4     4   612         my $t = sprintf '%.6f', $Absolute + $Relative;
171 4 100       32         return wantarray ? (map {0+$_} split qr/[.]/ms, $t) : 0+$t;
  4         27  
172 8         432     });
173                 $Module{'Time::HiRes'}->mock(clock_gettime => sub (;$) {
174 51     51   575586         my ($which) = @_;
175 51 100       149         if ($which == CLOCK_REALTIME()) {
    100          
176 1         17             return 0+sprintf '%.6f', $Absolute + $Relative;
177                     }
178                     elsif ($which == CLOCK_MONOTONIC()) {
179 49         1716             return 0+sprintf '%.6f', $Monotonic + $Relative;
180                     }
181 1         8         return TIME_HIRES_CLOCK_NOT_SUPPORTED;
182 8         380     });
183                 $Module{'Time::HiRes'}->mock(clock_getres => sub (;$) {
184 3     3   1842         my ($which) = @_;
185 3 100 100     8         if ($which == CLOCK_REALTIME() || $which == CLOCK_MONOTONIC()) {
186 2         20             return $Module{'Time::HiRes'}->original('clock_getres')->(@_);
187                     }
188 1         9         return TIME_HIRES_CLOCK_NOT_SUPPORTED;
189 8         414     });
190                 $Module{'Time::HiRes'}->mock(sleep => sub (;@) {
191 3     3   145         my ($seconds) = @_;
192 3 100       16         croak 'sleep without arg is not supported' if !@_;
193 2 100       27         croak "Time::HiRes::sleep($seconds): negative time not invented yet" if $seconds < 0;
194 1         2         $Relative += $seconds;
195 1         7         $Relative = sprintf '%.6f', $Relative;
196 1         3         return $seconds;
197 8         420     });
198                 $Module{'Time::HiRes'}->mock(usleep => sub ($) {
199 10     10   112         my ($useconds) = @_;
200 10 100       35         croak "Time::HiRes::usleep($useconds): negative time not invented yet" if $useconds < 0;
201 9         18         $Relative += $useconds / MICROSECONDS;
202 9         33         $Relative = sprintf '%.6f', $Relative;
203 9         18         return $useconds;
204 8         349     });
205                 $Module{'Time::HiRes'}->mock(nanosleep => sub ($) {
206 2     2   59         my ($nanoseconds) = @_;
207 2 100       18         croak "Time::HiRes::nanosleep($nanoseconds): negative time not invented yet" if $nanoseconds < 0;
208 1         4         $Relative += $nanoseconds / NANOSECONDS;
209 1         8         $Relative = sprintf '%.6f', $Relative;
210 1         5         return $nanoseconds;
211 8         356     });
212                 $Module{'Time::HiRes'}->mock(clock_nanosleep => sub ($$;$) {
213 5     5   152         my ($which, $nanoseconds, $flags) = @_;
214 5 100       22         croak "Time::HiRes::clock_nanosleep(..., $nanoseconds): negative time not invented yet" if $nanoseconds < 0;
215 4 100 100     10         croak 'only CLOCK_REALTIME and CLOCK_MONOTONIC are supported' if $which != CLOCK_REALTIME() && $which != CLOCK_MONOTONIC();
216 3 100       35         croak 'only flags=0 is supported' if $flags;
217 2         5         $Relative += $nanoseconds / NANOSECONDS;
218 2         10         $Relative = sprintf '%.6f', $Relative;
219 2         3         return $nanoseconds;
220 8         356     });
221 8         371     return;
222             }
223              
224             # TODO Distinguish timers set on different event loops / Mojo reactor
225             # objects while one_tick?
226              
227             sub _mock_ev { ## no critic (ProhibitExcessComplexity)
228 8     8   45     $Module{'EV'} = Test::MockModule->new('EV');
229 8         262     $Module{'EV::Watcher'} = Test::MockModule->new('EV::Watcher', no_auto=>1);
230 8         184     $Module{'EV::Timer'} = Test::MockModule->new('EV::Timer', no_auto=>1);
231 8         154     $Module{'EV::Periodic'} = Test::MockModule->new('EV::Periodic', no_auto=>1);
232                 $Module{'EV'}->mock(time => sub () {
233 7     7   82         return 0+sprintf '%.6f', $Absolute + $Relative;
234 8         174     });
235                 $Module{'EV'}->mock(now => sub () {
236 21     21   376         return 0+sprintf '%.6f', $Absolute + $Relative;
237 8         426     });
238                 $Module{'EV'}->mock(sleep => sub ($) {
239 4     4   9         my ($seconds) = @_;
240 4 100       13         if ($seconds < 0) {
241 1         2             $seconds = 0;
242                     }
243 4         7         $Relative += $seconds;
244 4         22         $Relative = sprintf '%.6f', $Relative;
245 4         7         return;
246 8         360     });
247                 $Module{'EV'}->mock(run => sub (;$) {
248 23     23   391         my ($flags) = @_;
249 23         36         my $tick = 0;
250 23         34         my $w;
251 23 100       62         if (@Timers) {
252                         $w = $Module{'EV'}->original('timer')->(
253                             $WAIT_ONE_TICK, $WAIT_ONE_TICK, sub {
254 15     15   121362                     my $me = shift;
255 15         42                     my $k;
256 15 50 33     99                     if (!$tick++ || !$flags) {
257 15         117                         $k = $me->keepalive(0);
258 15         68                         ff();
259                                 }
260 15 100 33     94                     if (!@Timers) {
    50 33        
261 7         28                         $me->stop;
262                                 }
263                                 elsif ($k && ($flags || any {$_->{watcher} && $_->{watcher}->keepalive} @Timers)) {
264 8         62                         $me->keepalive(1);
265                                 }
266                             }
267 15         106             );
268 15 50 66 2   199             if (!($flags || any {$_->{watcher} && $_->{watcher}->keepalive} @Timers)) {
  2 50       34  
269 0         0                 $w->keepalive(0);
270                         }
271                     }
272             # $tick above and this second RUN_ONCE is work around bug in EV-4.10+
273             # http://lists.schmorp.de/pipermail/libev/2016q1/002656.html
274             # FIXME I believe this workaround isn't correct with EV-4.03 - calling
275             # RUN_ONCE twice must have side effect in processing two events
276             # (at least one of them must be a non-timer event) instead of one.
277             # To make it correct we probably need to mock all watcher types
278             # to intercept invoking their callbacks and thus make it possible
279             # to find out is first RUN_ONCE has actually called any callbacks.
280 23 100 66     125         if ($flags && $flags == EV::RUN_ONCE()) {
281 18         66             $Module{'EV'}->original('run')->(@_);
282                     }
283 23         580784         return $Module{'EV'}->original('run')->(@_);
284 8         345     });
285                 $Module{'EV'}->mock(timer => sub ($$$) {
286 11     11   122         my ($after, $repeat, $cb) = @_;
287 11         50         my $w = $Module{'EV'}->original('timer_ns')->(@_);
288 11         163         weaken(my $weakw = $w);
289 11 50   13   64         _add_timer('EV', $after, $repeat, sub { $weakw && $weakw->invoke(EV::TIMER()) }, $w);
  13         157  
290 11         41         return $w;
291 8         341     });
292                 $Module{'EV'}->mock(timer_ns => sub ($$$) {
293 1     1   4         my $w = EV::timer(@_);
294 1         4         _stop_timer($w);
295 1         2         return $w;
296 8         333     });
297                 $Module{'EV'}->mock(periodic => sub ($$$$) {
298 2     2   10         my ($at, $repeat, $reschedule_cb, $cb) = @_;
299 2 50       7         croak 'reschedule_cb is not supported yet' if $reschedule_cb;
300 2 50       15         $at = sprintf '%.6f', $at < 0 ? 0 : $at;
301 2 50       12         $repeat = sprintf '%.6f', $repeat < 0 ? 0 : $repeat;
302 2         9         my $now = sprintf '%.6f', $Absolute + $Relative;
303 2 100 66     19         if ($repeat > 0 && $at < $now) {
304 8     8   19127             use bignum;
  8         50275  
  8         36  
305 1         60             $at += $repeat * int(($now - $at) / $repeat + 1);
306 1         1781             $at = sprintf '%.6f', $at;
307                     }
308 2 50       110         my $after = $at > $now ? $at - $now : 0;
309 2         22         $after = sprintf '%.6f', $after;
310 2         9         my $w = $Module{'EV'}->original('periodic_ns')->(@_);
311 2         31         weaken(my $weakw = $w);
312 2 50   2   17         _add_timer('EV', $after, $repeat, sub { $weakw && $weakw->invoke(EV::TIMER()) }, $w);
  2         33  
313 2         6         return $w;
314 8         349     });
315                 $Module{'EV'}->mock(periodic_ns => sub ($$$$) {
316 0     0   0         my $w = EV::periodic(@_);
317 0         0         _stop_timer($w);
318 0         0         return $w;
319 8         330     });
320                 $Module{'EV::Watcher'}->mock(is_active => sub {
321 2     2   5         my ($w) = @_;
322 2 50       5         my ($active) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers;
  2         16  
323 2 50       4         my ($inactive) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers_ns;
  2         11  
324 2 100       6         if ($active) {
    50          
325 1         5             return 1;
326                     }
327                     elsif ($inactive) {
328 1         5             return;
329                     }
330 0         0         return $Module{'EV::Watcher'}->original('is_active')->(@_);
331 8         382     });
332                 $Module{'EV::Timer'}->mock(DESTROY => sub {
333 26     26   49503         my ($w) = @_;
334 26 50       57         @Timers = grep { !$_->{watcher} || $_->{watcher} ne $w } @Timers;
  18         191  
335 26 50       61         @Timers_ns = grep { !$_->{watcher} || $_->{watcher} ne $w } @Timers_ns;
  11         72  
336 26         129         return $Module{'EV::Timer'}->original('DESTROY')->(@_);
337 8         383     });
338                 $Module{'EV::Timer'}->mock(start => sub {
339 1     1   4         return _start_timer(@_);
340 8         350     });
341                 $Module{'EV::Timer'}->mock(stop => sub {
342 9     9   30         return _stop_timer(@_);
343 8         367     });
344                 $Module{'EV::Timer'}->mock(set => sub {
345 0     0   0         my ($w, $after, $repeat) = @_;
346 0 0       0         if (!defined $repeat) {
347 0         0             $repeat = 0;
348                     }
349 0 0       0         my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers, @Timers_ns;
  0         0  
350 0 0       0         if ($timer) {
351 0         0             $timer->{start} = $Relative;
352 0 0       0             $timer->{after} = sprintf '%.6f', $after < 0 ? 0 : $after;
353 0 0       0             $timer->{repeat}= sprintf '%.6f', $repeat < 0 ? 0 : $repeat;
354                     }
355 0         0         return;
356 8         359     });
357                 $Module{'EV::Timer'}->mock(remaining => sub {
358 0     0   0         my ($w) = @_;
359 0 0       0         my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers, @Timers_ns;
  0         0  
360 0 0       0         if ($timer) {
361 0         0             return 0+sprintf '%.6f', $timer->{start} + $timer->{after} - $Relative;
362                     }
363 0         0         return;
364 8         400     });
365                 $Module{'EV::Timer'}->mock(again => sub {
366 3     3   35         my ($w, $repeat) = @_;
367 3 50 33     19         if (defined $repeat && $repeat < 0) {
368 0         0             $repeat = 0;
369                     }
370 3 50       8         my ($active) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers;
  2         18  
371 3 50       7         my ($inactive) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers_ns;
  2         12  
372 3 100       11         if ($active) {
    50          
373 2 50       19             $active->{repeat} = sprintf '%.6f', defined $repeat ? $repeat : $active->{repeat};
374 2 50       9             if ($active->{repeat} > 0) {
375 2         6                 $active->{after} = $active->{repeat};
376 2         6                 $active->{start} = $Relative;
377                         }
378                         else {
379 0         0                 _stop_timer($active->{watcher});
380                         }
381                     }
382                     elsif ($inactive) {
383 1 50       10             $inactive->{repeat} = sprintf '%.6f', defined $repeat ? $repeat : $inactive->{repeat};
384 1 50       5             if ($inactive->{repeat} > 0) {
385 1         3                 $inactive->{after} = $inactive->{repeat};
386 1         3                 $inactive->{start} = $Relative;
387 1         4                 _start_timer($inactive->{watcher});
388                         }
389                     }
390 3         7         return;
391 8         335     });
392                 $Module{'EV::Periodic'}->mock(DESTROY => sub {
393 2     2   748         my ($w) = @_;
394 2 50       4         @Timers = grep { !$_->{watcher} || $_->{watcher} ne $w } @Timers;
  1         15  
395 2 50       4         @Timers_ns = grep { !$_->{watcher} || $_->{watcher} ne $w } @Timers_ns;
  2         16  
396 2         7         return $Module{'EV::Periodic'}->original('DESTROY')->(@_);
397 8         364     });
398                 $Module{'EV::Periodic'}->mock(start => sub {
399 0     0   0         return _start_timer(@_);
400 8         352     });
401                 $Module{'EV::Periodic'}->mock(stop => sub {
402 0     0   0         return _stop_timer(@_);
403 8         347     });
404                 $Module{'EV::Periodic'}->mock(set => sub {
405 0     0   0         my ($w, $at, $repeat, $reschedule_cb, $cb) = @_;
406 0 0       0         croak 'reschedule_cb is not supported yet' if $reschedule_cb;
407 0 0       0         $at = sprintf '%.6f', $at < 0 ? 0 : $at;
408 0 0       0         $repeat = sprintf '%.6f', $repeat < 0 ? 0 : $repeat;
409 0         0         my $now = sprintf '%.6f', $Absolute + $Relative;
410 0 0 0     0         if ($repeat > 0 && $at < $now) {
411 8     8   502665             use bignum;
  8         19  
  8         47  
412 0         0             $at += $repeat * int(($now - $at) / $repeat + 1);
413 0         0             $at = sprintf '%.6f', $at;
414                     }
415 0 0       0         my $after = $at > $now ? $at - $now : 0;
416 0         0         $after = sprintf '%.6f', $after;
417 0 0       0         my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers, @Timers_ns;
  0         0  
418 0 0       0         if ($timer) {
419 0         0             $timer->{start} = $Relative;
420 0         0             $timer->{after} = $after;
421 0         0             $timer->{repeat}= $repeat;
422                     }
423 0         0         return;
424 8         331     });
425                 $Module{'EV::Periodic'}->mock(again => sub {
426 0     0   0         return _start_timer(@_);
427 8         322     });
428                 $Module{'EV::Periodic'}->mock(at => sub {
429 0     0   0         my ($w) = @_;
430 0 0       0         my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers, @Timers_ns;
  0         0  
431 0 0       0         if ($timer) {
432 0         0             return 0+sprintf '%.6f', $timer->{start} + $timer->{after};
433                     }
434 0         0         return;
435 8         331     });
436 8         311     return;
437             }
438              
439             sub _mock_mojolicious {
440 8     8   70     $Module{'Mojo::Reactor::Poll'} = Test::MockModule->new('Mojo::Reactor::Poll');
441                 $Module{'Mojo::Reactor::Poll'}->mock(one_tick => sub {
442 10     10   225         my ($self) = @_;
443 10 100       21         if (!@Timers) {
444 2         6             return $Module{'Mojo::Reactor::Poll'}->original('one_tick')->(@_);
445                     }
446                     my $id = $Module{'Mojo::Reactor::Poll'}->original('timer')->(
447 8     8   65             $self, $WAIT_ONE_TICK, sub { ff() }
448 8         39         );
449 8         49         $Module{'Mojo::Reactor::Poll'}->original('one_tick')->(@_);
450 8         62         $Module{'Mojo::Reactor::Poll'}->original('remove')->($self, $id);
451 8         77         return;
452 8         504     });
453                 $Module{'Mojo::Reactor::Poll'}->mock(timer => sub {
454 5     5   740         my ($self, $delay, $cb) = @_;
455 5 50       13         if ($delay == 0) { # do not fake timer for 0 seconds to avoid hang
456 0         0             return $Module{'Mojo::Reactor::Poll'}->original('timer')->(@_);
457                     }
458 5     4   17         return _add_timer($self, $delay, 0, sub { $cb->($self) });
  4         9  
459 8         701     });
460                 $Module{'Mojo::Reactor::Poll'}->mock(recurring => sub {
461 2     2   35         my ($self, $delay, $cb) = @_;
462 2     4   8         return _add_timer($self, $delay, $delay, sub { $cb->($self) });
  4         8  
463 8         429     });
464                 $Module{'Mojo::Reactor::Poll'}->mock(again => sub {
465 2     2   17         my ($self, $id) = @_;
466 2 50       11         if ($id !~ /\Afake_\d+\z/ms) {
467 0         0             $Module{'Mojo::Reactor::Poll'}->original('again')->(@_);
468                     }
469                     else {
470 2         5             my ($timer) = grep { $_->{id} eq $id } @Timers;
  2         7  
471 2 50       6             if ($timer) {
472 2         3                 $timer->{start} = $Relative;
473                         }
474                     }
475 2         5         return;
476 8         400     });
477                 $Module{'Mojo::Reactor::Poll'}->mock(remove => sub {
478 12     12   181         my ($self, $id) = @_;
479 12 100       35         if ($id !~ /\Afake_\d+\z/ms) {
480 10         24             $Module{'Mojo::Reactor::Poll'}->original('remove')->(@_);
481                     }
482                     else {
483 2 50       5             @Timers = grep { $_->{loop} ne $self || $_->{id} ne $id } @Timers;
  2         21  
484                     }
485 12         125         return;
486 8         386     });
487                 $Module{'Mojo::Reactor::Poll'}->mock(reset => sub {
488 2     2   50         my ($self) = @_;
489 2         5         @Timers = grep { $_->{loop} ne $self } @Timers;
  2         14  
490 2         16         return $Module{'Mojo::Reactor::Poll'}->original('reset')->(@_);
491 8         384     });
492 8         333     return;
493             }
494              
495              
496             1;
497             __END__
498            
499             =encoding utf8
500            
501             =for stopwords localtime gmtime gettimeofday usleep nanosleep
502            
503             =head1 NAME
504            
505             Test::Mock::Time - Deterministic time & timers for event loop tests
506            
507            
508             =head1 VERSION
509            
510             This document describes Test::Mock::Time version v0.1.7
511            
512            
513             =head1 SYNOPSIS
514            
515             use Test::Mock::Time;
516            
517             # All these functions will return same constant time
518             # until you manually move time forward by some deterministic
519             # value by sleep(), ff() or doing one tick of your event loop.
520             say time();
521             say localtime();
522             say gmtime();
523             say Time::HiRes::time();
524             say Time::HiRes::gettimeofday();
525             say Time::HiRes::clock_gettime(CLOCK_REALTIME());
526             say Time::HiRes::clock_gettime(CLOCK_MONOTONIC());
527            
528             # All these functions will fast-forward time (so time() etc.
529             # will return increased value on next call) and return immediately.
530             # Pending timers of your event loop (if any) will not be processed.
531             sleep(1);
532             Time::HiRes::sleep(0.5);
533             Time::HiRes::usleep(500_000);
534             Time::HiRes::nanosleep(500_000_000);
535             Time::HiRes::clock_nanosleep(500_000_000);
536            
537             # This will fast-forward time and process pending timers (if any).
538             ff(0.5);
539            
540             # These will call ff() in case no other (usually I/O) event happens in
541             # $Test::Mock::Time::WAIT_ONE_TICK seconds of real time and there are
542             # some active timers.
543             Mojo::IOLoop->one_tick;
544             EV::run(EV::RUN_ONCE);
545            
546            
547             =head1 DESCRIPTION
548            
549             This module replaces actual time with simulated time everywhere
550             (core time(), Time::HiRes, EV, AnyEvent with EV, Mojolicious, …) and
551             provide a way to write deterministic tests for event loop based
552             applications with timers.
553            
554             B<IMPORTANT!> This module B<must> be loaded by your script/app/test before
555             other related modules (Time::HiRes, Mojolicious, EV, etc.).
556            
557            
558             =head1 EXPORTS
559            
560             These functions are exported by default:
561            
562             ff
563            
564            
565             =head1 INTERFACE
566            
567             =head2 WAIT_ONE_TICK
568            
569             $Test::Mock::Time::WAIT_ONE_TICK = 0.05;
570            
571             This value is used to limit amount of real time spend waiting for
572             non-timer (usually I/O) event while one tick of event loop if there are
573             some active timers. In case no events happens while this time event loop
574             will be interrupted and time will be fast-forward to time when next timer
575             should expire by calling ff().
576            
577             =head2 ff
578            
579             ff( $seconds );
580             ff();
581            
582             Fast-forward current time by $seconds (can be fractional). All functions
583             like time() will returns previous value increased by $seconds after that.
584            
585             Will run callbacks for pending timers of your event loop if they'll expire
586             while $seconds or if they've already expired (because you've used functions
587             like sleep() which fast-forward time without processing timers).
588            
589             When called without params will fast-forward time by amount needed to run
590             callback for next pending timer (it may be 0 in case there are no pending
591             timers or if next pending timer already expired).
592            
593             =head2 Mocked functions/methods from other modules
594            
595             See L</"SYNOPSIS"> for explanation how they works.
596            
597             =over
598            
599             =item CORE::GLOBAL
600            
601             =over
602            
603             =item time
604            
605             =item localtime
606            
607             =item gmtime
608            
609             =item sleep
610            
611             =back
612            
613             =item Time::HiRes
614            
615             =over
616            
617             =item time
618            
619             =item gettimeofday
620            
621             =item clock_gettime
622            
623             =item clock_getres
624            
625             =item sleep
626            
627             =item usleep
628            
629             =item nanosleep
630            
631             =item clock_nanosleep
632            
633             =back
634            
635             =item Mojo::Reactor::Poll
636            
637             All required methods.
638            
639             =item EV
640            
641             All required methods except:
642            
643             EV::once
644             EV::Watcher::feed_event
645            
646             =back
647            
648            
649             =head1 SUPPORT
650            
651             =head2 Bugs / Feature Requests
652            
653             Please report any bugs or feature requests through the issue tracker
654             at L<https://github.com/powerman/perl-Test-Mock-Time/issues>.
655             You will be notified automatically of any progress on your issue.
656            
657             =head2 Source Code
658            
659             This is open source software. The code repository is available for
660             public review and contribution under the terms of the license.
661             Feel free to fork the repository and submit pull requests.
662            
663             L<https://github.com/powerman/perl-Test-Mock-Time>
664            
665             git clone https://github.com/powerman/perl-Test-Mock-Time.git
666            
667             =head2 Resources
668            
669             =over
670            
671             =item * MetaCPAN Search
672            
673             L<https://metacpan.org/search?q=Test-Mock-Time>
674            
675             =item * CPAN Ratings
676            
677             L<http://cpanratings.perl.org/dist/Test-Mock-Time>
678            
679             =item * AnnoCPAN: Annotated CPAN documentation
680            
681             L<http://annocpan.org/dist/Test-Mock-Time>
682            
683             =item * CPAN Testers Matrix
684            
685             L<http://matrix.cpantesters.org/?dist=Test-Mock-Time>
686            
687             =item * CPANTS: A CPAN Testing Service (Kwalitee)
688            
689             L<http://cpants.cpanauthors.org/dist/Test-Mock-Time>
690            
691             =back
692            
693            
694             =head1 AUTHOR
695            
696             Alex Efros E<lt>powerman@cpan.orgE<gt>
697            
698            
699             =head1 COPYRIGHT AND LICENSE
700            
701             This software is Copyright (c) 2016- by Alex Efros E<lt>powerman@cpan.orgE<gt>.
702            
703             This is free software, licensed under:
704            
705             The MIT (X11) License
706            
707            
708             =cut
709