t000755001750001750 014547226476 15452 5ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1EV.t100644001750001750 614114547226476 16313 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/tuse 5.008001; use warnings; use strict; use utf8; use Test::More; use Test::Exception; use Test::Mock::Time; BEGIN { plan skip_all => 'EV not installed' if !eval { require EV }; } my $t = time; my $w; my ($res, $want) = (0, 0); is EV::now, $t, 'EV::now'; is EV::time, $t, 'EV::time'; select undef,undef,undef,1.1; is EV::now, $t, 'EV::now is same after real 1.1 second delay'; is EV::time, $t, 'EV::time is same after real 1.1 second delay'; EV::sleep(-1); is EV::now, $t, 'EV::now is same after EV::sleep(-1)'; is EV::time, $t, 'EV::time is same after EV::sleep(-1)'; EV::sleep(0); is EV::now, $t, 'EV::now is same after EV::sleep(0)'; is EV::time, $t, 'EV::time is same after EV::sleep(0)'; EV::sleep(0.5); is EV::now, $t+=0.5, 'EV::now is increased after EV::sleep(0.5)'; is EV::time, $t, 'EV::time is increased after EV::sleep(0.5)'; EV::sleep(100); is EV::now, $t+=100, 'EV::now is increased after EV::sleep(100)'; is EV::time, $t, 'EV::time is increased after EV::sleep(100)'; ff(1000); is EV::now, $t+=1000, 'EV::now is increased after ff(1000)'; is EV::time, $t, 'EV::time is increased after ff(1000)'; $w = EV::timer 10, 0, sub { $res++; EV::break }; EV::run; is EV::now, $t+=10, 'EV::run terminated'; is $res, $want+=1, '... by timer'; $w = EV::timer 0.5, 0, sub { $res++ }; EV::run(EV::RUN_ONCE); is EV::now, $t+=0.5, 'EV::run(EV::RUN_ONCE) terminated'; is $res, $want+=1, '... by timer'; EV::run(EV::RUN_ONCE); is EV::now, $t, 'EV::run(EV::RUN_ONCE) terminated'; is $res, $want, '... because there are no watchers'; EV::run; is EV::now, $t, 'EV::run terminated'; is $res, $want, '... because there are no watchers'; $w = EV::timer_ns 0.5, 0.5, sub { $res++ }; EV::run(EV::RUN_ONCE); is EV::now, $t, 'EV::run(EV::RUN_ONCE) terminated'; is $res, $want, '... because there are no active watchers'; EV::run; is EV::now, $t, 'EV::run terminated'; is $res, $want, '... because there are no active watchers'; my $w2 = EV::timer 10, 10, sub { $res+=10 }; EV::run(EV::RUN_ONCE); is EV::now, $t+=10, 'EV::run(EV::RUN_ONCE) terminated'; is $res, $want+=10, '... by active timer'; $w2->stop; EV::run(EV::RUN_ONCE); is EV::now, $t, 'EV::run(EV::RUN_ONCE) terminated'; is $res, $want, '... because there are no active watchers'; $w->again; EV::run(EV::RUN_ONCE); is EV::now, $t+=0.5, 'EV::run(EV::RUN_ONCE) terminated'; is $res, $want+=1, '... by another active timer'; $w->stop; $w2->start; EV::run(EV::RUN_ONCE); is EV::now, $t+=9.5, 'EV::run(EV::RUN_ONCE) terminated'; is $res, $want+=10, '... by another one active timer'; ok !$w->is_active, 'first timer is inactive'; ok $w2->is_active, 'second timer is active'; undef $w; undef $w2; EV::run; is EV::now, $t, 'EV::run terminated'; is $res, $want, '... because there are no watchers'; $w = EV::periodic EV::now+0.3, 0, undef, sub { $res+=3 }; EV::run(EV::RUN_ONCE); is EV::now, $t+=0.3, 'EV::run(EV::RUN_ONCE) terminated'; is $res, $want+=3, '... by absolute periodic'; $w2 = EV::periodic 0, 3600, undef, sub { $res+=3600 }; EV::run(EV::RUN_ONCE); is EV::now, $t=int($t)+3600-$t%3600, 'EV::run(EV::RUN_ONCE) terminated'; is $res, $want+=3600, '... by interval periodic'; done_testing; Test-Mock-Time-v0.2.1000755001750001750 014547226476 15266 5ustar00powermanpowerman000000000000README100644001750001750 1101714547226476 16247 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1NAME Test::Mock::Time - Deterministic time & timers for event loop tests VERSION This document describes Test::Mock::Time version v0.2.1 SYNOPSIS use Test::Mock::Time; # All these functions will return same constant time # until you manually move time forward by some deterministic # value by sleep(), ff() or doing one tick of your event loop. say time(); say localtime(); say gmtime(); say Time::HiRes::time(); say Time::HiRes::gettimeofday(); say Time::HiRes::clock_gettime(CLOCK_REALTIME()); say Time::HiRes::clock_gettime(CLOCK_MONOTONIC()); # All these functions will fast-forward time (so time() etc. # will return increased value on next call) and return immediately. # Pending timers of your event loop (if any) will not be processed. sleep(1); Time::HiRes::sleep(0.5); Time::HiRes::usleep(500_000); Time::HiRes::nanosleep(500_000_000); Time::HiRes::clock_nanosleep(500_000_000); # This will fast-forward time and process pending timers (if any). ff(0.5); # These will call ff() in case no other (usually I/O) event happens in # $Test::Mock::Time::WAIT_ONE_TICK seconds of real time and there are # some active timers. Mojo::IOLoop->one_tick; EV::run(EV::RUN_ONCE); DESCRIPTION This module replaces actual time with simulated time everywhere (core time(), Time::HiRes, EV, AnyEvent with EV, Mojolicious, …) and provide a way to write deterministic tests for event loop based applications with timers. IMPORTANT! This module must be loaded by your script/app/test before other related modules (Time::HiRes, Mojolicious, EV, etc.). EXPORTS These functions are exported by default: ff INTERFACE WAIT_ONE_TICK $Test::Mock::Time::WAIT_ONE_TICK = 0.05; This value is used to limit amount of real time spend waiting for non-timer (usually I/O) event while one tick of event loop if there are some active timers. In case no events happens while this time event loop will be interrupted and time will be fast-forward to time when next timer should expire by calling ff(). ff ff( $seconds ); ff(); Fast-forward current time by $seconds (can be fractional). All functions like time() will returns previous value increased by $seconds after that. Will run callbacks for pending timers of your event loop if they'll expire while $seconds or if they've already expired (because you've used functions like sleep() which fast-forward time without processing timers). When called without params will fast-forward time by amount needed to run callback for next pending timer (it may be 0 in case there are no pending timers or if next pending timer already expired). Mocked functions/methods from other modules See "SYNOPSIS" for explanation how they works. CORE::GLOBAL time localtime gmtime sleep Time::HiRes time gettimeofday clock_gettime clock_getres sleep usleep nanosleep clock_nanosleep Mojo::Reactor::Poll All required methods. EV All required methods except: EV::once EV::Watcher::feed_event SUPPORT Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at https://github.com/powerman/perl-Test-Mock-Time/issues. You will be notified automatically of any progress on your issue. Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. Feel free to fork the repository and submit pull requests. https://github.com/powerman/perl-Test-Mock-Time git clone https://github.com/powerman/perl-Test-Mock-Time.git Resources * MetaCPAN Search https://metacpan.org/search?q=Test-Mock-Time * CPAN Ratings http://cpanratings.perl.org/dist/Test-Mock-Time * AnnoCPAN: Annotated CPAN documentation http://annocpan.org/dist/Test-Mock-Time * CPAN Testers Matrix http://matrix.cpantesters.org/?dist=Test-Mock-Time * CPANTS: A CPAN Testing Service (Kwalitee) http://cpants.cpanauthors.org/dist/Test-Mock-Time AUTHOR Alex Efros COPYRIGHT AND LICENSE This software is Copyright (c) 2016- by Alex Efros . This is free software, licensed under: The MIT (X11) License Changes100644001750001750 135414547226476 16645 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1Revision history for Test-Mock-Time v0.2.1 2024-01-09 13:25:43 EET - Fix warning about bigint/bignum conflict. v0.2.0 2023-06-07 01:30:38 EEST - Fix compatibility with modern EV. v0.1.7 2018-01-09 21:05:29 EET - Add support for perl-5.8. v0.1.6 2016-02-29 23:22:56 EET - Reformat doc. - Drop support for Mojolicious < 6.0. v0.1.5 2016-02-18 14:27:57 EET - Fix floating point math on perl with -Duselongdouble. v0.1.4 2016-02-17 19:37:45 EET - Fix EV::run() support. v0.1.3 2016-02-15 20:15:56 EET - Fix POD. v0.1.2 2016-02-15 15:37:39 EET - Improve EV::run() support. - Bugfixes. v0.1.1 2016-02-15 08:27:25 EET - Improve tests portability (BSD). v0.1.0 2016-02-14 21:59:31 EET - Initial release LICENSE100644001750001750 223214547226476 16353 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1This software is Copyright (c) 2016- by Alex Efros . This is free software, licensed under: The MIT (X11) License The MIT License Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. cpanfile100644001750001750 102614547226476 17052 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1requires 'perl', '5.008001'; requires 'Export::Attrs'; requires 'List::Util', '1.33'; requires 'Scalar::Util'; requires 'Test::MockModule'; requires 'bignum'; on configure => sub { requires 'Module::Build::Tiny', '0.034'; }; on test => sub { requires 'Test::Exception'; requires 'Test::More', '0.96'; recommends 'Time::HiRes', '1.9724'; recommends 'EV'; recommends 'Mojolicious', '6'; suggests 'AnyEvent'; }; on develop => sub { requires 'Test::Distribution'; requires 'Test::Perl::Critic'; }; dist.ini100644001750001750 45514547226476 16777 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1[@Milla] [MetaProvides::Package] [Substitute] code = s/^(This document describes \S+ version |VERSION=['"])([^'"\r\n]*)/my($s,$v)=($1,$2);my%h=%Term::ReadLine::Gnu::Attribs;$s.($h{prompt}?($h{line_buffer}||$h{prompt}=~m{ \[(.*)\]})[0]:$v)/e [GitHubREADME::Badge] badges = travis badges = coveralls CORE.t100644001750001750 355714547226476 16541 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/tuse 5.008001; use warnings; use strict; use utf8; use Test::More; use Test::Exception; use Test::Mock::Time; my $t = time; my $loc = localtime; my @loc = localtime; my $gmt = gmtime; my @gmt = gmtime; cmp_ok $t, '>', 1455000000, 'time looks like current actual time'; is scalar gmtime(1455000000), 'Tue Feb 9 06:40:00 2016', 'gmtime with param'; like $loc, qr/\d\d:\d\d:\d\d/ms, 'scalar localtime looks like time'; like $gmt, qr/\d\d:\d\d:\d\d/ms, 'scalar gmtime looks like time'; is 0+@loc, 9, 'localtime returns 9 values'; is 0+@gmt, 9, 'gmttime returns 9 values'; is time(), $t, 'time()'; cmp_ok CORE::time(), '>=', $t, 'CORE::time() looks like time()'; select undef,undef,undef,1.1; cmp_ok CORE::time(), '>', $t, 'CORE::time() is increased'; cmp_ok CORE::localtime(), 'ne', $loc, 'CORE::localtime() is changed'; is time, $t, 'time is same after real 1.1 second delay'; is time(), $t, 'time() is same'; is scalar localtime, $loc, 'localtime is same'; is scalar gmtime, $gmt, 'gmtime is same'; throws_ok { sleep -1.5 } qr/sleep with negative value is not supported/; throws_ok { sleep -1 } qr/sleep with negative value is not supported/; is sleep -0.5, 0, 'sleep -0.5'; is time, $t, 'time is same after sleep -0.5'; is sleep 0, 0, 'sleep 0'; is time, $t, 'time is same after sleep 0'; is sleep 0.5, 0, 'sleep 0.5'; is time, $t, 'time is same after sleep 0.5'; is sleep 1, 1, 'sleep 1'; is time, $t+=1, 'time is increased by 1'; is sleep 1.5, 1, 'sleep 1.5'; is time, $t+=1, 'time is increased by 1'; is sleep 1000, 1000, 'sleep 1000'; is time, $t+=1000, 'time is increased by 1000'; cmp_ok localtime, 'ne', $loc, 'localtime is changed'; cmp_ok gmtime, 'ne', $gmt, 'gmtime is changed'; ff(0.5); is time, $t, 'time is same after ff(0.5)'; ff(0.5); is time, $t+=1, 'time is increased by 1 after ff(0.5)'; ff(1000); is time, $t+=1000, 'time is increased by 1000 after ff(1000)'; done_testing(); Build.PL100644001750001750 26614547226476 16627 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1# This Build.PL for Test-Mock-Time was generated by Dist::Zilla::Plugin::ModuleBuildTiny 0.017. use strict; use warnings; use 5.008001; use Module::Build::Tiny 0.034; Build_PL(); META.yml100644001750001750 224114547226476 16617 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1--- abstract: 'Deterministic time & timers for event loop tests' author: - 'Alex Efros ' build_requires: Test::Exception: '0' Test::More: '0.96' configure_requires: Module::Build::Tiny: '0.034' dynamic_config: 0 generated_by: 'Dist::Milla version v1.0.22, Dist::Zilla version 6.030, CPAN::Meta::Converter version 2.150010' license: mit meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test-Mock-Time no_index: directory: - eg - examples - inc - share - t - xt provides: Test::Mock::Time: file: lib/Test/Mock/Time.pm version: v0.2.1 requires: Export::Attrs: '0' List::Util: '1.33' Scalar::Util: '0' Test::MockModule: '0' bignum: '0' perl: '5.008001' resources: bugtracker: https://github.com/powerman/perl-Test-Mock-Time/issues homepage: https://github.com/powerman/perl-Test-Mock-Time repository: https://github.com/powerman/perl-Test-Mock-Time.git version: v0.2.1 x_contributors: - 'Dagfinn Ilmari Mannsåker ' x_generated_by_perl: v5.38.2 x_serialization_backend: 'YAML::Tiny version 1.74' x_spdx_expression: MIT x_static_install: 1 MANIFEST100644001750001750 54214547226476 16461 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.030. Build.PL Changes LICENSE MANIFEST META.json META.yml README cpanfile dist.ini lib/Test/Mock/Time.pm t/00.load.t t/01.export.t t/AnyEvent.t t/CORE.t t/EV.t t/Mojolicious-EV.t t/Mojolicious.t t/TimeHiRes.t t/author-perlcritic.t t/author-pod-syntax.t t/release-distribution.t META.json100644001750001750 462514547226476 16777 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1{ "abstract" : "Deterministic time & timers for event loop tests", "author" : [ "Alex Efros " ], "dynamic_config" : 0, "generated_by" : "Dist::Milla version v1.0.22, Dist::Zilla version 6.030, CPAN::Meta::Converter version 2.150010", "license" : [ "mit" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Test-Mock-Time", "no_index" : { "directory" : [ "eg", "examples", "inc", "share", "t", "xt" ] }, "prereqs" : { "configure" : { "requires" : { "Module::Build::Tiny" : "0.034" }, "suggests" : { "JSON::PP" : "2.27300" } }, "develop" : { "requires" : { "Dist::Milla" : "v1.0.22", "Test::Distribution" : "0", "Test::Perl::Critic" : "0", "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "Export::Attrs" : "0", "List::Util" : "1.33", "Scalar::Util" : "0", "Test::MockModule" : "0", "bignum" : "0", "perl" : "5.008001" } }, "test" : { "recommends" : { "EV" : "0", "Mojolicious" : "6", "Time::HiRes" : "1.9724" }, "requires" : { "Test::Exception" : "0", "Test::More" : "0.96" }, "suggests" : { "AnyEvent" : "0" } } }, "provides" : { "Test::Mock::Time" : { "file" : "lib/Test/Mock/Time.pm", "version" : "v0.2.1" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/powerman/perl-Test-Mock-Time/issues" }, "homepage" : "https://github.com/powerman/perl-Test-Mock-Time", "repository" : { "type" : "git", "url" : "https://github.com/powerman/perl-Test-Mock-Time.git", "web" : "https://github.com/powerman/perl-Test-Mock-Time" } }, "version" : "v0.2.1", "x_contributors" : [ "Dagfinn Ilmari Manns\u00e5ker " ], "x_generated_by_perl" : "v5.38.2", "x_serialization_backend" : "Cpanel::JSON::XS version 4.37", "x_spdx_expression" : "MIT", "x_static_install" : 1 } 00.load.t100644001750001750 32014547226476 17107 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/tuse warnings; use strict; use Test::More tests => 1; BEGIN { use_ok( 'Test::Mock::Time' ) or BAIL_OUT('unable to load module') } diag( "Testing Test::Mock::Time $Test::Mock::Time::VERSION, Perl $], $^X" ); AnyEvent.t100644001750001750 307314547226476 17533 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/tuse 5.008001; use warnings; use strict; use utf8; use Test::More; use Test::Exception; use Test::Mock::Time; BEGIN { $ENV{PERL_ANYEVENT_MODEL} = 'EV'; plan skip_all => 'EV not installed' if !eval { require EV }; plan skip_all => 'AnyEvent not installed' if !eval { require AnyEvent }; } my $t = time; my $w; my ($res, $want) = (0, 0); my $cv; is AE::now, $t, 'AE::now'; is AE::time, $t, 'AE::time'; select undef,undef,undef,1.1; is AE::now, $t, 'AE::now is same after real 1.1 second delay'; is AE::time, $t, 'AE::time is same after real 1.1 second delay'; EV::sleep(-1); is AE::now, $t, 'AE::now is same after EV::sleep(-1)'; is AE::time, $t, 'AE::time is same after EV::sleep(-1)'; EV::sleep(0); is AE::now, $t, 'AE::now is same after EV::sleep(0)'; is AE::time, $t, 'AE::time is same after EV::sleep(0)'; EV::sleep(0.5); is AE::now, $t+=0.5, 'AE::now is increased after EV::sleep(0.5)'; is AE::time, $t, 'AE::time is increased after EV::sleep(0.5)'; EV::sleep(100); is AE::now, $t+=100, 'AE::now is increased after EV::sleep(100)'; is AE::time, $t, 'AE::time is increased after EV::sleep(100)'; ff(1000); is AE::now, $t+=1000, 'AE::now is increased after ff(1000)'; is AE::time, $t, 'AE::time is increased after ff(1000)'; $cv = AnyEvent->condvar; $w = AE::timer 10, 0, sub { $res++; $cv->send }; $cv->recv; is AE::now, $t+=10, 'cv->recv terminated'; is $res, $want+=1, '... by timer'; $cv = AnyEvent->condvar; $w = AE::timer 0.5, 0, sub { $res++; $cv->send }; $cv->recv; is AE::now, $t+=0.5, 'cv->recv terminated'; is $res, $want+=1, '... by timer'; done_testing; 01.export.t100644001750001750 66714547226476 17530 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/tuse warnings; use strict; use Test::More; use Test::Mock::Time; my @exports = qw( ff ); my @not_exports = qw( ); plan +(@exports + @not_exports) ? ( tests => @exports + @not_exports ) : ( skip_all => q{This module doesn't export anything} ) ; for my $export (@exports) { can_ok( __PACKAGE__, $export ); } for my $not_export (@not_exports) { ok( ! __PACKAGE__->can($not_export) ); } TimeHiRes.t100644001750001750 573314547226476 17640 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/tuse 5.008001; use warnings; use strict; use utf8; use Test::More; use Test::Exception; use Test::Mock::Time; BEGIN { plan skip_all => 'Time::HiRes not installed' if !eval { require Time::HiRes }; Time::HiRes->import(qw( time gettimeofday sleep usleep nanosleep )); eval { Time::HiRes->import(qw( CLOCK_REALTIME CLOCK_MONOTONIC clock_gettime clock_getres )) }; eval { Time::HiRes->import(qw( CLOCK_REALTIME CLOCK_MONOTONIC clock_nanosleep )) }; } my $t = time; cmp_ok $t, '>', 1455000000, 'time looks like current actual time'; like $t, qr/\A\d+\z/ms, 'time is initially integer'; select undef,undef,undef,1.1; is time, $t, 'time is same after real 1.1 second delay'; is time(), $t, 'time() is same'; SKIP: { skip 'clock_gettime(): unimplemented in this platform', 4 if !exists &clock_gettime; is clock_gettime(CLOCK_REALTIME()), $t, 'clock_gettime(CLOCK_REALTIME) is same'; cmp_ok clock_gettime(CLOCK_MONOTONIC()), '<', $t, 'clock_gettime(CLOCK_MONOTONIC) < time()'; cmp_ok clock_gettime(CLOCK_MONOTONIC()), '>', 0, 'clock_gettime(CLOCK_MONOTONIC) > 0'; is clock_gettime(42), -1, 'clock_gettime(42) is not supported'; } SKIP: { skip 'clock_getres(): unimplemented in this platform', 3 if !exists &clock_getres; isnt clock_getres(CLOCK_REALTIME()), -1, 'clock_getres(CLOCK_REALTIME) is supported'; isnt clock_getres(CLOCK_MONOTONIC()), -1, 'clock_getres(CLOCK_MONOTONIC) is supported'; is clock_getres(42), -1, 'clock_getres(42) is not supported'; } is scalar gettimeofday(), $t, 'gettimeofday is same as scalar'; is_deeply [gettimeofday()], [$t,0], 'gettimeofday is same as array'; throws_ok { sleep -0.5 } qr/Time::HiRes::sleep\(-0.5\): negative time not invented yet/ms; throws_ok { sleep } qr/sleep without arg is not supported/ms; sleep 0.5; is time, $t+=0.5, 'time is increased by 0.5'; is scalar gettimeofday(), $t, 'gettimeofday is increased by 0.5 as scalar'; is_deeply [gettimeofday()], [$t-0.5,500000], 'gettimeofday is increased by 0.5 as array'; throws_ok { usleep(-1) } qr/Time::HiRes::usleep\(-1\): negative time not invented yet/ms; usleep(10_000); is time, $t+=0.01, 'time is increased by 0.01'; throws_ok { nanosleep(-2) } qr/Time::HiRes::nanosleep\(-2\): negative time not invented yet/ms; nanosleep(2_000_000); is time, $t+=0.002, 'time is increased by 0.002'; SKIP: { skip 'clock_nanosleep(): unimplemented in this platform', 4 if !exists &clock_nanosleep; throws_ok { clock_nanosleep(CLOCK_REALTIME(), -3) } qr/Time::HiRes::clock_nanosleep\(..., -3\): negative time not invented yet/ms; throws_ok { clock_nanosleep(42, 1) } qr/only CLOCK_REALTIME and CLOCK_MONOTONIC are supported/ms; throws_ok { clock_nanosleep(CLOCK_MONOTONIC(), 1, 1) } qr/only flags=0 is supported/ms; clock_nanosleep(CLOCK_REALTIME(), 1_500_000); clock_nanosleep(CLOCK_MONOTONIC(), 1_500_000, 0); is time, $t+=0.003, 'time is increased by 0.003'; } ff(1000.5); is time, $t+=1000.5, 'time is increased by 1000.5 after ff(1000.5)'; done_testing(); Mojolicious.t100644001750001750 414114547226476 20273 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/tuse 5.008001; use warnings; use strict; use utf8; use Test::More; use Test::Exception; BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Test::Mock::Time; BEGIN { plan skip_all => 'Mojolicious not installed' if !eval { require Mojolicious; Mojolicious->VERSION('6'); require Mojo::IOLoop }; } my $t = time; my $id; is ref Mojo::IOLoop->singleton->reactor, 'Mojo::Reactor::Poll', 'using Poll'; Mojo::IOLoop->timer(10, sub { Mojo::IOLoop->stop }); Mojo::IOLoop->start; is time, $t+=10, 'Mojo::IOLoop->start terminated by timer'; Mojo::IOLoop->one_tick; is time, $t, 'Mojo::IOLoop->one_tick terminated without timers'; Mojo::IOLoop->timer(5, sub {}); Mojo::IOLoop->one_tick; is time, $t+=5, 'Mojo::IOLoop->one_tick terminated by timer'; Mojo::IOLoop->recurring(3, sub {}); Mojo::IOLoop->one_tick; is time, $t+=3, 'Mojo::IOLoop->one_tick terminated by recurring'; Mojo::IOLoop->one_tick; is time, $t+=3, 'Mojo::IOLoop->one_tick terminated by recurring'; Mojo::IOLoop->one_tick; is time, $t+=3, 'Mojo::IOLoop->one_tick terminated by recurring'; Mojo::IOLoop->reset; is time, $t, 'Mojo::IOLoop->one_tick terminated after reset'; Mojo::IOLoop->timer(5, sub {}); sleep 3; is time, $t+=3, 'sleep 3 (2 seconds left until timer 5)'; Mojo::IOLoop->one_tick; is time, $t+=2, 'Mojo::IOLoop->one_tick terminated by timer in 2 seconds'; $id = Mojo::IOLoop->timer(5, sub {}); sleep 3; is time, $t+=3, 'sleep 3 (2 seconds left until timer 5), again'; Mojo::IOLoop->singleton->reactor->again($id); Mojo::IOLoop->one_tick; is time, $t+=5, 'Mojo::IOLoop->one_tick terminated by timer in 5 seconds'; $id = Mojo::IOLoop->recurring(5, sub {}); sleep 3; is time, $t+=3, 'sleep 3 (2 seconds left until timer 5), again'; Mojo::IOLoop->singleton->reactor->again($id); Mojo::IOLoop->one_tick; is time, $t+=5, 'Mojo::IOLoop->one_tick terminated by timer in 5 seconds'; Mojo::IOLoop->remove($id); $id = Mojo::IOLoop->timer(5, sub {}); sleep 3; is time, $t+=3, 'sleep 3 (2 seconds left until timer 5), remove'; Mojo::IOLoop->remove($id); Mojo::IOLoop->one_tick; is time, $t, 'Mojo::IOLoop->one_tick terminated without timers'; done_testing; Mojolicious-EV.t100644001750001750 415014547226476 20603 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/tuse 5.008001; use warnings; use strict; use utf8; use Test::More; use Test::Exception; use Test::Mock::Time; BEGIN { plan skip_all => 'EV not installed' if !eval { require EV }; plan skip_all => 'Mojolicious not installed' if !eval { require Mojolicious; Mojolicious->VERSION('6'); require Mojo::IOLoop }; } my $t = time; my $id; is ref Mojo::IOLoop->singleton->reactor, 'Mojo::Reactor::EV', 'using EV'; Mojo::IOLoop->timer(10, sub { Mojo::IOLoop->stop }); Mojo::IOLoop->start; is time, $t+=10, 'Mojo::IOLoop->start terminated by timer'; Mojo::IOLoop->one_tick; is time, $t, 'Mojo::IOLoop->one_tick terminated without timers'; Mojo::IOLoop->timer(5, sub {}); Mojo::IOLoop->one_tick; is time, $t+=5, 'Mojo::IOLoop->one_tick terminated by timer'; Mojo::IOLoop->recurring(3, sub {}); Mojo::IOLoop->one_tick; is time, $t+=3, 'Mojo::IOLoop->one_tick terminated by recurring'; Mojo::IOLoop->one_tick; is time, $t+=3, 'Mojo::IOLoop->one_tick terminated by recurring'; Mojo::IOLoop->one_tick; is time, $t+=3, 'Mojo::IOLoop->one_tick terminated by recurring'; Mojo::IOLoop->reset; is time, $t, 'Mojo::IOLoop->one_tick terminated after reset'; Mojo::IOLoop->timer(5, sub {}); sleep 3; is time, $t+=3, 'sleep 3 (2 seconds left until timer 5)'; Mojo::IOLoop->one_tick; is time, $t+=2, 'Mojo::IOLoop->one_tick terminated by timer in 2 seconds'; $id = Mojo::IOLoop->timer(5, sub {}); sleep 3; is time, $t+=3, 'sleep 3 (2 seconds left until timer 5), again'; Mojo::IOLoop->singleton->reactor->again($id); Mojo::IOLoop->one_tick; is time, $t+=5, 'Mojo::IOLoop->one_tick terminated by timer in 5 seconds'; $id = Mojo::IOLoop->recurring(5, sub {}); sleep 3; is time, $t+=3, 'sleep 3 (2 seconds left until timer 5), again'; Mojo::IOLoop->singleton->reactor->again($id); Mojo::IOLoop->one_tick; is time, $t+=5, 'Mojo::IOLoop->one_tick terminated by timer in 5 seconds'; Mojo::IOLoop->remove($id); $id = Mojo::IOLoop->timer(5, sub {}); sleep 3; is time, $t+=3, 'sleep 3 (2 seconds left until timer 5), remove'; Mojo::IOLoop->remove($id); Mojo::IOLoop->one_tick; is time, $t, 'Mojo::IOLoop->one_tick terminated without timers'; done_testing; Mock000755001750001750 014547226476 17565 5ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/lib/TestTime.pm100644001750001750 5353414547226476 21213 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/lib/Test/Mockpackage Test::Mock::Time; use 5.008001; use warnings; use strict; use utf8; use Carp; our $VERSION = 'v0.2.1'; use Export::Attrs; use List::Util qw( any ); use Scalar::Util qw( weaken ); use Test::MockModule; use constant TIME_HIRES_CLOCK_NOT_SUPPORTED => -1; use constant MICROSECONDS => 1_000_000; use constant NANOSECONDS => 1_000_000_000; use constant DEFAULT_WAIT_ONE_TICK => 0.05; our $WAIT_ONE_TICK = DEFAULT_WAIT_ONE_TICK; my $Absolute = time; # usual time starts at current actual time my $Monotonic = 0; # monotonic time starts at 0 if not available my $Relative = 0; # how many deterministic time passed since start my @Timers; # active timers my @Timers_ns; # inactive timers my %Module; # keep module mocks _mock_core_global(); ## no critic (RequireCheckingReturnValueOfEval) eval { require Time::HiRes; Time::HiRes->import(qw( CLOCK_REALTIME CLOCK_MONOTONIC )); _mock_time_hires(); }; eval { require EV; _mock_ev(); }; eval { require Mojolicious; Mojolicious->VERSION('6'); # may be compatible with older ones, needs testing require Mojo::Reactor::Poll; _mock_mojolicious(); }; # FIXME make ff() reentrant sub ff :Export(:DEFAULT) { my ($dur) = @_; @Timers = sort { $a->{start}+$a->{after} <=> $b->{start}+$b->{after} or $a->{id} cmp $b->{id} # preserve order to simplify tests } @Timers; my $next_at = @Timers ? $Timers[0]{start}+$Timers[0]{after} : 0; $next_at = sprintf '%.6f', $next_at; if (!defined $dur) { $dur = $next_at > $Relative ? $next_at - $Relative : 0; $dur = sprintf '%.6f', $dur; } croak "ff($dur): negative time not invented yet" if $dur < 0; if ($next_at == 0 || $next_at > $Relative+$dur) { $Relative += $dur; $Relative = sprintf '%.6f', $Relative; return; } if ($next_at > $Relative) { $dur -= $next_at - $Relative; $dur = sprintf '%.6f', $dur; $Relative = $next_at; } my $cb = $Timers[0]{cb}; if ($Timers[0]{repeat} == 0) { if ($Timers[0]{watcher}) { _stop_timer($Timers[0]{watcher}); } else { shift @Timers; } } else { $Timers[0]{after} = $Timers[0]{repeat}; $Timers[0]{start} = $Relative; } $cb->(); @_ = ($dur); goto &ff; } { my $next_id = 0; sub _add_timer { my ($loop, $after, $repeat, $cb, $watcher) = @_; my $id = sprintf 'fake_%05d', $next_id++; push @Timers, { id => $id, start => $Relative, loop => $loop, after => sprintf('%.6f', $after < 0 ? 0 : $after), repeat => sprintf('%.6f', $repeat < 0 ? 0 : $repeat), cb => $cb, watcher => $watcher, }; if ($watcher) { weaken($Timers[-1]{watcher}); } return $id; } } sub _start_timer { my ($watcher) = @_; my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $watcher } @Timers_ns; if ($timer) { @Timers_ns = grep { !$_->{watcher} || $_->{watcher} ne $watcher } @Timers_ns; push @Timers, $timer; } return; } sub _stop_timer { my ($watcher) = @_; my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $watcher } @Timers; if ($timer) { @Timers = grep { !$_->{watcher} || $_->{watcher} ne $watcher } @Timers; push @Timers_ns, $timer; } return; } sub _mock_core_global { $Module{'CORE::GLOBAL'} = Test::MockModule->new('CORE::GLOBAL', no_auto=>1); $Module{'CORE::GLOBAL'}->mock(time => sub () { return int($Absolute + $Relative); }); $Module{'CORE::GLOBAL'}->mock(localtime => sub (;$) { my $time = defined $_[0] ? $_[0] : int($Absolute + $Relative); return CORE::localtime($time); }); $Module{'CORE::GLOBAL'}->mock(gmtime => sub (;$) { my $time = defined $_[0] ? $_[0] : int($Absolute + $Relative); return CORE::gmtime($time); }); $Module{'CORE::GLOBAL'}->mock(sleep => sub ($) { my $dur = int $_[0]; croak 'sleep with negative value is not supported' if $dur < 0; $Relative += $dur; $Relative = sprintf '%.6f', $Relative; return $dur; }); return; } sub _mock_time_hires { # Do not improve precision of current actual time to simplify tests. #$Absolute = Time::HiRes::time(); # Use current actual monotonic time. $Monotonic = Time::HiRes::clock_gettime(CLOCK_MONOTONIC()); $Module{'Time::HiRes'} = Test::MockModule->new('Time::HiRes'); $Module{'Time::HiRes'}->mock(time => sub () { return 0+sprintf '%.6f', $Absolute + $Relative; }); $Module{'Time::HiRes'}->mock(gettimeofday => sub () { my $t = sprintf '%.6f', $Absolute + $Relative; return wantarray ? (map {0+$_} split qr/[.]/ms, $t) : 0+$t; }); $Module{'Time::HiRes'}->mock(clock_gettime => sub (;$) { my ($which) = @_; if ($which == CLOCK_REALTIME()) { return 0+sprintf '%.6f', $Absolute + $Relative; } elsif ($which == CLOCK_MONOTONIC()) { return 0+sprintf '%.6f', $Monotonic + $Relative; } return TIME_HIRES_CLOCK_NOT_SUPPORTED; }); $Module{'Time::HiRes'}->mock(clock_getres => sub (;$) { my ($which) = @_; if ($which == CLOCK_REALTIME() || $which == CLOCK_MONOTONIC()) { return $Module{'Time::HiRes'}->original('clock_getres')->(@_); } return TIME_HIRES_CLOCK_NOT_SUPPORTED; }); $Module{'Time::HiRes'}->mock(sleep => sub (;@) { my ($seconds) = @_; croak 'sleep without arg is not supported' if !@_; croak "Time::HiRes::sleep($seconds): negative time not invented yet" if $seconds < 0; $Relative += $seconds; $Relative = sprintf '%.6f', $Relative; return $seconds; }); $Module{'Time::HiRes'}->mock(usleep => sub ($) { my ($useconds) = @_; croak "Time::HiRes::usleep($useconds): negative time not invented yet" if $useconds < 0; $Relative += $useconds / MICROSECONDS; $Relative = sprintf '%.6f', $Relative; return $useconds; }); $Module{'Time::HiRes'}->mock(nanosleep => sub ($) { my ($nanoseconds) = @_; croak "Time::HiRes::nanosleep($nanoseconds): negative time not invented yet" if $nanoseconds < 0; $Relative += $nanoseconds / NANOSECONDS; $Relative = sprintf '%.6f', $Relative; return $nanoseconds; }); $Module{'Time::HiRes'}->mock(clock_nanosleep => sub ($$;$) { my ($which, $nanoseconds, $flags) = @_; croak "Time::HiRes::clock_nanosleep(..., $nanoseconds): negative time not invented yet" if $nanoseconds < 0; croak 'only CLOCK_REALTIME and CLOCK_MONOTONIC are supported' if $which != CLOCK_REALTIME() && $which != CLOCK_MONOTONIC(); croak 'only flags=0 is supported' if $flags; $Relative += $nanoseconds / NANOSECONDS; $Relative = sprintf '%.6f', $Relative; return $nanoseconds; }); return; } # TODO Distinguish timers set on different event loops / Mojo reactor # objects while one_tick? sub _mock_ev { ## no critic (ProhibitExcessComplexity) $Module{'EV'} = Test::MockModule->new('EV'); $Module{'EV::Watcher'} = Test::MockModule->new('EV::Watcher', no_auto=>1); $Module{'EV::Timer'} = Test::MockModule->new('EV::Timer', no_auto=>1); $Module{'EV::Periodic'} = Test::MockModule->new('EV::Periodic', no_auto=>1); $Module{'EV'}->mock(time => sub () { return 0+sprintf '%.6f', $Absolute + $Relative; }); $Module{'EV'}->mock(now => sub () { return 0+sprintf '%.6f', $Absolute + $Relative; }); $Module{'EV'}->mock(sleep => sub ($) { my ($seconds) = @_; if ($seconds < 0) { $seconds = 0; } $Relative += $seconds; $Relative = sprintf '%.6f', $Relative; return; }); $Module{'EV'}->mock(run => sub (;$) { my ($flags) = @_; my $tick = 0; my $w; if (@Timers) { $w = $Module{'EV'}->original('timer')->( $WAIT_ONE_TICK, $WAIT_ONE_TICK, sub { my $me = shift; my $k; if (!$tick++ || !$flags) { $k = $me->keepalive(0); ff(); } if (!@Timers) { $me->stop; } elsif ($k && ($flags || any {$_->{watcher} && $_->{watcher}->keepalive} @Timers)) { $me->keepalive(1); } } ); if (!($flags || any {$_->{watcher} && $_->{watcher}->keepalive} @Timers)) { $w->keepalive(0); } } # $tick above and this second RUN_ONCE is work around bug in EV-4.10+ # http://lists.schmorp.de/pipermail/libev/2016q1/002656.html # FIXME I believe this workaround isn't correct with EV-4.03 - calling # RUN_ONCE twice must have side effect in processing two events # (at least one of them must be a non-timer event) instead of one. # To make it correct we probably need to mock all watcher types # to intercept invoking their callbacks and thus make it possible # to find out is first RUN_ONCE has actually called any callbacks. if ($flags && $flags == EV::RUN_ONCE()) { $Module{'EV'}->original('run')->(@_); } return $Module{'EV'}->original('run')->(@_); }); $Module{'EV'}->mock(timer => sub ($$$) { my ($after, $repeat, $cb) = @_; my $w = $Module{'EV'}->original('timer_ns')->(@_); weaken(my $weakw = $w); _add_timer('EV', $after, $repeat, sub { $weakw && $weakw->invoke(EV::TIMER()) }, $w); return $w; }); $Module{'EV'}->mock(timer_ns => sub ($$$) { my ($after, $repeat, $cb) = @_; my $w = EV::timer($after, $repeat, $cb); _stop_timer($w); return $w; }); $Module{'EV'}->mock(periodic => sub ($$$$) { my ($at, $repeat, $reschedule_cb, $cb) = @_; croak 'reschedule_cb is not supported yet' if $reschedule_cb; $at = sprintf '%.6f', $at < 0 ? 0 : $at; $repeat = sprintf '%.6f', $repeat < 0 ? 0 : $repeat; my $now = sprintf '%.6f', $Absolute + $Relative; if ($repeat > 0 && $at < $now) { use bignum; $at += $repeat * int(($now - $at) / $repeat + 1); $at = sprintf '%.6f', $at; } my $after = $at > $now ? $at - $now : 0; $after = sprintf '%.6f', $after; my $w = $Module{'EV'}->original('periodic_ns')->(@_); weaken(my $weakw = $w); _add_timer('EV', $after, $repeat, sub { $weakw && $weakw->invoke(EV::TIMER()) }, $w); return $w; }); $Module{'EV'}->mock(periodic_ns => sub ($$$$) { my ($at, $repeat, $reschedule_cb, $cb) = @_; my $w = EV::periodic($at, $repeat, $reschedule_cb, $cb); _stop_timer($w); return $w; }); $Module{'EV::Watcher'}->mock(is_active => sub { my ($w) = @_; my ($active) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers; my ($inactive) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers_ns; if ($active) { return 1; } elsif ($inactive) { return; } return $Module{'EV::Watcher'}->original('is_active')->(@_); }); $Module{'EV::Timer'}->mock(DESTROY => sub { my ($w) = @_; @Timers = grep { !$_->{watcher} || $_->{watcher} ne $w } @Timers; @Timers_ns = grep { !$_->{watcher} || $_->{watcher} ne $w } @Timers_ns; return $Module{'EV::Timer'}->original('DESTROY')->(@_); }); $Module{'EV::Timer'}->mock(start => sub { return _start_timer(@_); }); $Module{'EV::Timer'}->mock(stop => sub { return _stop_timer(@_); }); $Module{'EV::Timer'}->mock(set => sub { my ($w, $after, $repeat) = @_; if (!defined $repeat) { $repeat = 0; } my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers, @Timers_ns; if ($timer) { $timer->{start} = $Relative; $timer->{after} = sprintf '%.6f', $after < 0 ? 0 : $after; $timer->{repeat}= sprintf '%.6f', $repeat < 0 ? 0 : $repeat; } return; }); $Module{'EV::Timer'}->mock(remaining => sub { my ($w) = @_; my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers, @Timers_ns; if ($timer) { return 0+sprintf '%.6f', $timer->{start} + $timer->{after} - $Relative; } return; }); $Module{'EV::Timer'}->mock(again => sub { my ($w, $repeat) = @_; if (defined $repeat && $repeat < 0) { $repeat = 0; } my ($active) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers; my ($inactive) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers_ns; if ($active) { $active->{repeat} = sprintf '%.6f', defined $repeat ? $repeat : $active->{repeat}; if ($active->{repeat} > 0) { $active->{after} = $active->{repeat}; $active->{start} = $Relative; } else { _stop_timer($active->{watcher}); } } elsif ($inactive) { $inactive->{repeat} = sprintf '%.6f', defined $repeat ? $repeat : $inactive->{repeat}; if ($inactive->{repeat} > 0) { $inactive->{after} = $inactive->{repeat}; $inactive->{start} = $Relative; _start_timer($inactive->{watcher}); } } return; }); $Module{'EV::Periodic'}->mock(DESTROY => sub { my ($w) = @_; @Timers = grep { !$_->{watcher} || $_->{watcher} ne $w } @Timers; @Timers_ns = grep { !$_->{watcher} || $_->{watcher} ne $w } @Timers_ns; return $Module{'EV::Periodic'}->original('DESTROY')->(@_); }); $Module{'EV::Periodic'}->mock(start => sub { return _start_timer(@_); }); $Module{'EV::Periodic'}->mock(stop => sub { return _stop_timer(@_); }); $Module{'EV::Periodic'}->mock(set => sub { my ($w, $at, $repeat, $reschedule_cb, $cb) = @_; croak 'reschedule_cb is not supported yet' if $reschedule_cb; $at = sprintf '%.6f', $at < 0 ? 0 : $at; $repeat = sprintf '%.6f', $repeat < 0 ? 0 : $repeat; my $now = sprintf '%.6f', $Absolute + $Relative; if ($repeat > 0 && $at < $now) { use bignum; $at += $repeat * int(($now - $at) / $repeat + 1); $at = sprintf '%.6f', $at; } my $after = $at > $now ? $at - $now : 0; $after = sprintf '%.6f', $after; my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers, @Timers_ns; if ($timer) { $timer->{start} = $Relative; $timer->{after} = $after; $timer->{repeat}= $repeat; } return; }); $Module{'EV::Periodic'}->mock(again => sub { return _start_timer(@_); }); $Module{'EV::Periodic'}->mock(at => sub { my ($w) = @_; my ($timer) = grep { $_->{watcher} && $_->{watcher} eq $w } @Timers, @Timers_ns; if ($timer) { return 0+sprintf '%.6f', $timer->{start} + $timer->{after}; } return; }); return; } sub _mock_mojolicious { $Module{'Mojo::Reactor::Poll'} = Test::MockModule->new('Mojo::Reactor::Poll'); $Module{'Mojo::Reactor::Poll'}->mock(one_tick => sub { my ($self) = @_; if (!@Timers) { return $Module{'Mojo::Reactor::Poll'}->original('one_tick')->(@_); } my $id = $Module{'Mojo::Reactor::Poll'}->original('timer')->( $self, $WAIT_ONE_TICK, sub { ff() } ); $Module{'Mojo::Reactor::Poll'}->original('one_tick')->(@_); $Module{'Mojo::Reactor::Poll'}->original('remove')->($self, $id); return; }); $Module{'Mojo::Reactor::Poll'}->mock(timer => sub { my ($self, $delay, $cb) = @_; if ($delay == 0) { # do not fake timer for 0 seconds to avoid hang return $Module{'Mojo::Reactor::Poll'}->original('timer')->(@_); } return _add_timer($self, $delay, 0, sub { $cb->($self) }); }); $Module{'Mojo::Reactor::Poll'}->mock(recurring => sub { my ($self, $delay, $cb) = @_; return _add_timer($self, $delay, $delay, sub { $cb->($self) }); }); $Module{'Mojo::Reactor::Poll'}->mock(again => sub { my ($self, $id) = @_; if ($id !~ /\Afake_\d+\z/ms) { $Module{'Mojo::Reactor::Poll'}->original('again')->(@_); } else { my ($timer) = grep { $_->{id} eq $id } @Timers; if ($timer) { $timer->{start} = $Relative; } } return; }); $Module{'Mojo::Reactor::Poll'}->mock(remove => sub { my ($self, $id) = @_; if ($id !~ /\Afake_\d+\z/ms) { $Module{'Mojo::Reactor::Poll'}->original('remove')->(@_); } else { @Timers = grep { $_->{loop} ne $self || $_->{id} ne $id } @Timers; } return; }); $Module{'Mojo::Reactor::Poll'}->mock(reset => sub { my ($self) = @_; @Timers = grep { $_->{loop} ne $self } @Timers; return $Module{'Mojo::Reactor::Poll'}->original('reset')->(@_); }); return; } 1; __END__ =encoding utf8 =for stopwords localtime gmtime gettimeofday usleep nanosleep =head1 NAME Test::Mock::Time - Deterministic time & timers for event loop tests =head1 VERSION This document describes Test::Mock::Time version v0.2.1 =head1 SYNOPSIS use Test::Mock::Time; # All these functions will return same constant time # until you manually move time forward by some deterministic # value by sleep(), ff() or doing one tick of your event loop. say time(); say localtime(); say gmtime(); say Time::HiRes::time(); say Time::HiRes::gettimeofday(); say Time::HiRes::clock_gettime(CLOCK_REALTIME()); say Time::HiRes::clock_gettime(CLOCK_MONOTONIC()); # All these functions will fast-forward time (so time() etc. # will return increased value on next call) and return immediately. # Pending timers of your event loop (if any) will not be processed. sleep(1); Time::HiRes::sleep(0.5); Time::HiRes::usleep(500_000); Time::HiRes::nanosleep(500_000_000); Time::HiRes::clock_nanosleep(500_000_000); # This will fast-forward time and process pending timers (if any). ff(0.5); # These will call ff() in case no other (usually I/O) event happens in # $Test::Mock::Time::WAIT_ONE_TICK seconds of real time and there are # some active timers. Mojo::IOLoop->one_tick; EV::run(EV::RUN_ONCE); =head1 DESCRIPTION This module replaces actual time with simulated time everywhere (core time(), Time::HiRes, EV, AnyEvent with EV, Mojolicious, …) and provide a way to write deterministic tests for event loop based applications with timers. B This module B be loaded by your script/app/test before other related modules (Time::HiRes, Mojolicious, EV, etc.). =head1 EXPORTS These functions are exported by default: ff =head1 INTERFACE =head2 WAIT_ONE_TICK $Test::Mock::Time::WAIT_ONE_TICK = 0.05; This value is used to limit amount of real time spend waiting for non-timer (usually I/O) event while one tick of event loop if there are some active timers. In case no events happens while this time event loop will be interrupted and time will be fast-forward to time when next timer should expire by calling ff(). =head2 ff ff( $seconds ); ff(); Fast-forward current time by $seconds (can be fractional). All functions like time() will returns previous value increased by $seconds after that. Will run callbacks for pending timers of your event loop if they'll expire while $seconds or if they've already expired (because you've used functions like sleep() which fast-forward time without processing timers). When called without params will fast-forward time by amount needed to run callback for next pending timer (it may be 0 in case there are no pending timers or if next pending timer already expired). =head2 Mocked functions/methods from other modules See L for explanation how they works. =over =item CORE::GLOBAL =over =item time =item localtime =item gmtime =item sleep =back =item Time::HiRes =over =item time =item gettimeofday =item clock_gettime =item clock_getres =item sleep =item usleep =item nanosleep =item clock_nanosleep =back =item Mojo::Reactor::Poll All required methods. =item EV All required methods except: EV::once EV::Watcher::feed_event =back =head1 SUPPORT =head2 Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at L. You will be notified automatically of any progress on your issue. =head2 Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. Feel free to fork the repository and submit pull requests. L git clone https://github.com/powerman/perl-Test-Mock-Time.git =head2 Resources =over =item * MetaCPAN Search L =item * CPAN Ratings L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Testers Matrix L =item * CPANTS: A CPAN Testing Service (Kwalitee) L =back =head1 AUTHOR Alex Efros Epowerman@cpan.orgE =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2016- by Alex Efros Epowerman@cpan.orgE. This is free software, licensed under: The MIT (X11) License =cut author-perlcritic.t100644001750001750 63314547226476 21421 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/t#!/usr/bin/perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; use Test::More; eval { require Test::Perl::Critic; }; plan(skip_all=>'Test::Perl::Critic required to criticise code') if $@; Test::Perl::Critic->import( -verbose => 9, # verbose 6 will hide rule name ); all_critic_ok(); author-pod-syntax.t100644001750001750 45414547226476 21370 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); release-distribution.t100644001750001750 65614547226476 22123 0ustar00powermanpowerman000000000000Test-Mock-Time-v0.2.1/t BEGIN { unless ($ENV{RELEASE_TESTING}) { print qq{1..0 # SKIP these tests are for release candidate testing\n}; exit } } use Test::More; eval { require Test::Distribution }; plan( skip_all => 'Test::Distribution not installed' ) if $@; Test::Distribution->import( podcoveropts => { # also_private => [ # qr/^(?:IMPORT)$/, # ], # pod_from => 'MAIN PM FILE HERE', } );