diff options
author | David Mitchell <davem@iabyn.com> | 2018-04-27 12:43:44 +0100 |
---|---|---|
committer | Karl Williamson <khw@cpan.org> | 2018-08-08 11:05:40 -0600 |
commit | 66f85150154f441b79024356cbc59fbafcff7c2a (patch) | |
tree | 7f4d3d550ba57d124274cc678999df984bd85ca8 /dist | |
parent | 3a778cce7686b868d662edc1334a9946c06e925d (diff) | |
download | perl-66f85150154f441b79024356cbc59fbafcff7c2a.tar.gz |
time::HiRes: don't truncate nanosec utime
When passed a floating point atime/mtime value, T::HR::utime()
was converting it into two longs: secs and nsec. But the nanosec value
was calculated using a final NV to long cast, which truncates any
fractional part rather than rounding to nearest. Use a 0.5 addition to
force rounding.
This was manifesting as a test in lib/File/Copy.t failing to preserve
the same mtime after a couple of round trips with utime() and stat().
In particular, the test was attempting to set an mtime to the literal
floating-point value
1000000000.12345
This value can't be represented exactly as an NV, so was actually
(under -Dquadmath)
1000000000.1234499999999999999999999568211720247320
which was (using truncation) being converted into the two sec/nsec
longs:
1000000000, 123449999
After this commit, it instead correctly gets converted to
1000000000, 123450000
Diffstat (limited to 'dist')
-rw-r--r-- | dist/Time-HiRes/HiRes.xs | 10 | ||||
-rw-r--r-- | dist/Time-HiRes/t/utime.t | 15 |
2 files changed, 22 insertions, 3 deletions
diff --git a/dist/Time-HiRes/HiRes.xs b/dist/Time-HiRes/HiRes.xs index c4a7af7575..97e870c788 100644 --- a/dist/Time-HiRes/HiRes.xs +++ b/dist/Time-HiRes/HiRes.xs @@ -1444,10 +1444,16 @@ PROTOTYPE: $$@ "): negative time not invented yet", SvNV(accessed), SvNV(modified)); Zero(&utbuf, sizeof utbuf, char); + utbuf[0].tv_sec = (Time_t)SvNV(accessed); /* time accessed */ - utbuf[0].tv_nsec = (long)( ( SvNV(accessed) - utbuf[0].tv_sec ) * 1e9 ); + utbuf[0].tv_nsec = (long)( + (SvNV(accessed) - (NV)utbuf[0].tv_sec) + * NV_1E9 + (NV)0.5); + utbuf[1].tv_sec = (Time_t)SvNV(modified); /* time modified */ - utbuf[1].tv_nsec = (long)( ( SvNV(modified) - utbuf[1].tv_sec ) * 1e9 ); + utbuf[1].tv_nsec = (long)( + (SvNV(modified) - (NV)utbuf[1].tv_sec) + * NV_1E9 + (NV)0.5); } while (items > 0) { diff --git a/dist/Time-HiRes/t/utime.t b/dist/Time-HiRes/t/utime.t index 7fd4604b35..bb4621a920 100644 --- a/dist/Time-HiRes/t/utime.t +++ b/dist/Time-HiRes/t/utime.t @@ -112,7 +112,7 @@ BEGIN { } } -use Test::More tests => 18; +use Test::More tests => 22; BEGIN { push @INC, '.' } use t::Watchdog; use File::Temp qw( tempfile ); @@ -164,6 +164,19 @@ print "#utime \$filename\n"; is $got_mtime, $mtime, "mtime set correctly"; }; +print "#utime \$filename round-trip\n"; +{ + my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); + # this fractional part is not exactly representable + my $t = 1000000000.12345; + is Time::HiRes::utime($t, $t, $filename), 1, "One file changed"; + my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh) )[8, 9]; + is Time::HiRes::utime($got_atime, $got_mtime, $filename), 1, "One file changed"; + my ($got_atime2, $got_mtime2) = ( Time::HiRes::stat($fh) )[8, 9]; + is $got_atime, $got_atime2, "atime round trip ok"; + is $got_mtime, $got_mtime2, "mtime round trip ok"; +}; + print "utime \$filename and \$fh\n"; { my ($fh1, $filename1) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); |