diff options
| author | Andrew Fresh <afresh1@openbsd.org> | 2017-11-05 12:31:12 -0800 |
|---|---|---|
| committer | James E Keenan <jkeenan@cpan.org> | 2017-11-06 09:21:06 -0500 |
| commit | 310d015584c7347660e80d991a5d32c55cc06c94 (patch) | |
| tree | 4af704b9f1baddec6d2eaed096a9671d92278909 /lib/File | |
| parent | 7c82d9f4e30048d2cb50ba6c29952ffe75daee94 (diff) | |
| download | perl-310d015584c7347660e80d991a5d32c55cc06c94.tar.gz | |
Support Time::HiRes::utime in File::Copy
If Time::HiRes exists and has utime support for setting hires
utime, use that so cross-device moves can keep time accurately.
Used by autoconf.
Diffstat (limited to 'lib/File')
| -rw-r--r-- | lib/File/Copy.pm | 2 | ||||
| -rw-r--r-- | lib/File/Copy.t | 7 |
2 files changed, 8 insertions, 1 deletions
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index 47e6429771..7656cb7204 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -16,6 +16,8 @@ use Config; # And then we need these games to avoid loading overload, as that will # confuse miniperl during the bootstrap of perl. my $Scalar_Util_loaded = eval q{ require Scalar::Util; require overload; 1 }; +# We want HiRes stat and utime if available +BEGIN { eval q{ use Time::HiRes qw( stat utime ) } }; our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy); sub copy; sub syscopy; diff --git a/lib/File/Copy.t b/lib/File/Copy.t index 25f340d1c0..57d9478a68 100644 --- a/lib/File/Copy.t +++ b/lib/File/Copy.t @@ -24,6 +24,11 @@ BEGIN { *CORE::GLOBAL::rename = sub { CORE::rename($_[0], $_[1]) }; } use File::Copy qw(copy move cp); use Config; +# If we have Time::HiRes, File::Copy loaded it for us. +BEGIN { + eval { Time::HiRes->import(qw( stat utime )) }; + note "Testing Time::HiRes::utime support" unless $@; +} foreach my $code ("copy()", "copy('arg')", "copy('arg', 'arg', 'arg', 'arg')", "move()", "move('arg')", "move('arg', 'arg', 'arg')" @@ -102,7 +107,7 @@ for my $cross_partition_test (0..1) { ok -e "copy-$$", ' target still there'; # Doesn't really matter what time it is as long as its not now. - my $time = 1000000000; + my $time = 1000000000.12345; utime( $time, $time, "copy-$$" ); # Recheck the mtime rather than rely on utime in case we're on a |