| |
@@ -1,196 +0,0 @@
|
| |
- From 48256128727cb2c0866be0342b9ddafef8ca1471 Mon Sep 17 00:00:00 2001
|
| |
- From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
| |
- Date: Mon, 21 Mar 2022 17:42:10 +0100
|
| |
- Subject: [PATCH] Fix code and tests to Time::HiRes implicitly loaded by
|
| |
- Test::More
|
| |
- MIME-Version: 1.0
|
| |
- Content-Type: text/plain; charset=UTF-8
|
| |
- Content-Transfer-Encoding: 8bit
|
| |
-
|
| |
- After upgrading Test-Simple to 1.302190 the tests faild like this:
|
| |
-
|
| |
- "/usr/bin/perl" -MExtUtils::Command::MM -e 'cp_nonempty' -- Warp.bs blib/arch/auto/Time/Warp/Warp.bs 644
|
| |
- PERL_DL_NONLAZY=1 "/usr/bin/perl" "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
|
| |
- # Failed test at t/when.t line 26.
|
| |
- # got: '4.00038433074951'
|
| |
- # expected: '4'
|
| |
- # Failed test at t/when.t line 29.
|
| |
- # got: '3.57627868652344e-06'
|
| |
- # expected: '0'
|
| |
- # Failed test at t/when.t line 32.
|
| |
- # got: '3.03583312034607'
|
| |
- # expected: '0'
|
| |
- # Failed test at t/when.t line 35.
|
| |
- # got: '5.76009702682495'
|
| |
- # expected: '5'
|
| |
- # Looks like you planned 8 tests but ran 7.
|
| |
- # Looks like you failed 4 tests of 7 run.
|
| |
- t/when.t ..
|
| |
- Dubious, test returned 4 (wstat 1024, 0x400)
|
| |
- Failed 5/8 subtests
|
| |
-
|
| |
- A root cause was that Test2::API started to import
|
| |
- Time::HiRes::test(). This patch fixes four bugs:
|
| |
-
|
| |
- (1) If Time::HiRes was loaded, Time::Warp computed with franctional
|
| |
- times, but tests expected integer values. A fix is replacing is() with
|
| |
- and approximative comparison. (I guess there is a module on CPAN for
|
| |
- this, but I did not want to drag a new dependency, so I implemented
|
| |
- approx() subroutine.)
|
| |
-
|
| |
- (2) A scale(scale()*2) test failed because of an arithmetic error in
|
| |
- Wrap.xs. I tried to hunt the bug, but in the end I realized that
|
| |
- two variables are enough for implementing this linear algebra, hence
|
| |
- I reimplemented scale(), to() and warped_NVtime() with less variables
|
| |
- than original code used.
|
| |
-
|
| |
- (3) The last rest();to(&time+5) test failed because the library
|
| |
- computed with Time::HiRes::time(), but the test checked against
|
| |
- CORE::time(). A fix was using the same reference time (i.e. with the
|
| |
- same granularity) in tests as it is used in the code. (That's the
|
| |
- $ref_time reference to symbol table.)
|
| |
-
|
| |
- (4) A last small issue was a test plan whitch did not account with
|
| |
- a missing test for a warning about missing Time::HiRes. I fixed it
|
| |
- with moving the test out of warning handler.
|
| |
-
|
| |
- Fixed this way the tests pass for me with and without Time::HiRes.
|
| |
-
|
| |
- https://github.com/manwar/Time-Warp/issues/7
|
| |
- Signed-off-by: Petr Písař <ppisar@redhat.com>
|
| |
- ---
|
| |
- Warp.xs | 25 +++++++++++--------------
|
| |
- t/when.t | 29 +++++++++++++++++++++--------
|
| |
- 2 files changed, 32 insertions(+), 22 deletions(-)
|
| |
-
|
| |
- diff --git a/Warp.xs b/Warp.xs
|
| |
- index de05b00..a7d12c9 100644
|
| |
- --- a/Warp.xs
|
| |
- +++ b/Warp.xs
|
| |
- @@ -30,13 +30,11 @@ static NV (*realNVtime)();
|
| |
- static void (*realU2time)(U32 *);
|
| |
-
|
| |
- static double Lost; /** time relative to now */
|
| |
- -static double Zero; /** apply Scale from when? */
|
| |
- static double Scale; /** speed of time (.5 == half speed) */
|
| |
-
|
| |
- static void reset_warp()
|
| |
- {
|
| |
- Lost=0;
|
| |
- - Zero=(*realNVtime)();
|
| |
- Scale=1;
|
| |
- }
|
| |
-
|
| |
- @@ -44,10 +42,7 @@ static void reset_warp()
|
| |
-
|
| |
- static NV warped_NVtime()
|
| |
- {
|
| |
- - double now = (*realNVtime)() - Lost;
|
| |
- - double delta = now - Zero;
|
| |
- - delta *= Scale;
|
| |
- - return Zero + delta;
|
| |
- + return (*realNVtime)() * Scale + Lost;
|
| |
- }
|
| |
-
|
| |
- static void warped_U2time(U32 *ret)
|
| |
- @@ -106,27 +101,29 @@ to(when)
|
| |
- double when
|
| |
- CODE:
|
| |
- {
|
| |
- - Lost += (warped_NVtime() - when) / Scale;
|
| |
- + Lost = when - (*realNVtime)() * Scale;
|
| |
- }
|
| |
-
|
| |
- void
|
| |
- scale(...)
|
| |
- + PREINIT:
|
| |
- + double new_Scale;
|
| |
- PPCODE:
|
| |
- {
|
| |
- if (items == 0) {
|
| |
- XPUSHs(sv_2mortal(newSVnv(Scale)));
|
| |
- } else {
|
| |
- - Zero = warped_NVtime();
|
| |
- - Lost = 0;
|
| |
- - Scale = SvNV(ST(0));
|
| |
- - if (Scale < 0) {
|
| |
- + new_Scale = SvNV(ST(0));
|
| |
- + if (new_Scale < 0) {
|
| |
- warn("Sorry, Time::Warp cannot go backwards");
|
| |
- - Scale = 1;
|
| |
- + new_Scale = 1;
|
| |
- }
|
| |
- - else if (Scale < .001) {
|
| |
- + else if (new_Scale < .001) {
|
| |
- warn("Sorry, Time::Warp cannot stop time");
|
| |
- - Scale = .001;
|
| |
- + new_Scale = .001;
|
| |
- }
|
| |
- + Lost += (*realNVtime)() * (Scale - new_Scale);
|
| |
- + Scale = new_Scale;
|
| |
- }
|
| |
- }
|
| |
-
|
| |
- diff --git a/t/when.t b/t/when.t
|
| |
- index 68416ba..cd3d8cd 100644
|
| |
- --- a/t/when.t
|
| |
- +++ b/t/when.t
|
| |
- @@ -2,34 +2,47 @@ use strict;
|
| |
- use warnings;
|
| |
-
|
| |
-
|
| |
- -# These tests may occationally fail due to small timing differences.
|
| |
- -
|
| |
- use Test::More tests => 8;
|
| |
- +# Use an overloaded time() (e.g. by Time::HiRes), or CORE::time as a reference
|
| |
- +# clock.
|
| |
- +my $ref_time = (exists $main::{'time'}) ? $main::{'time'} : $CORE::{'time'};
|
| |
- +
|
| |
- {
|
| |
- + my $time_hires_warning_emitted;
|
| |
- local $SIG{__WARN__} = sub {
|
| |
- if ($_[0] =~ /Time::HiRes/) {
|
| |
- - ok 1;
|
| |
- + $time_hires_warning_emitted = 1;
|
| |
- } else {
|
| |
- warn $_[0];
|
| |
- }
|
| |
- };
|
| |
- require Time::Warp;
|
| |
- + ok ($time_hires_warning_emitted xor exists $INC{'Time/HiRes.pm'});
|
| |
- }
|
| |
- +
|
| |
- Time::Warp->import(qw(time to scale));
|
| |
- ok 1;
|
| |
- is scale(), 1;
|
| |
-
|
| |
- +# These tests may occationally fail due to small timing differences.
|
| |
- +sub approx {
|
| |
- + my ($got, $expected) = @_;
|
| |
- + my $epsilon = 0.3 * scale();
|
| |
- + ok($got - $expected < $epsilon,
|
| |
- + "$got is approximately equivalent to $expected with a tolerance $epsilon");
|
| |
- +}
|
| |
- +
|
| |
- scale(2);
|
| |
- is &scale, 2;
|
| |
- my $now = &time;
|
| |
- sleep 2;
|
| |
- -is(&time - $now, 4);
|
| |
- +approx(&time - $now, 4);
|
| |
-
|
| |
- -to(CORE::time);
|
| |
- -is(&time - CORE::time, 0);
|
| |
- +to(&$ref_time);
|
| |
- +approx(&time - &$ref_time, 0);
|
| |
-
|
| |
- scale(scale() * 2);
|
| |
- -is(&time - CORE::time, 0);
|
| |
- +approx(&time - &$ref_time, 0);
|
| |
-
|
| |
- Time::Warp::reset(); to(&time + 5);
|
| |
- -is(&time - CORE::time, 5);
|
| |
- +approx(&time - &$ref_time, 5);
|
| |
- --
|
| |
- 2.34.1
|
| |
-
|
| |
