Support Time::HiRes in File::Copy #16225
Comments
From afresh1@openbsd.orgCreated by afresh1@openbsd.orgAutoconf uses File::Copy to move files between filesystems, and because https://marc.info/?t=150963727200003&r=1&w=2 Attached is a patch that attempts to import stat and utime from I have only tested this on OpenBSD, so not sure what fallout there may Perl Info |
From afresh1@openbsd.org0001-Support-Time-HiRes-utime-in-File-Copy.patchFrom 07e85662fce844bb8ff74dec63f9e27058c69682 Mon Sep 17 00:00:00 2001
From: Andrew Hewus Fresh <afresh1@openbsd.org>
Date: Sun, 5 Nov 2017 12:31:12 -0800
Subject: [PATCH] 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.
---
lib/File/Copy.pm | 2 ++
lib/File/Copy.t | 4 ++++
2 files changed, 6 insertions(+)
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index 47e6429771..c36ff11c0a 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
+eval q{ require Time::HiRes; Time::HiRes->import(qw( stat utime )); 1 };
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..b54ebf4c25 100644
--- a/lib/File/Copy.t
+++ b/lib/File/Copy.t
@@ -24,6 +24,9 @@ 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.
+my $have_hires_utime = eval {Time::HiRes::d_hires_utime()};
+note "Testing Time::HiRes::utime support" if $have_hires_utime;
foreach my $code ("copy()", "copy('arg')", "copy('arg', 'arg', 'arg', 'arg')",
"move()", "move('arg')", "move('arg', 'arg', 'arg')"
@@ -103,6 +106,7 @@ for my $cross_partition_test (0..1) {
# Doesn't really matter what time it is as long as its not now.
my $time = 1000000000;
+ $time += 0.1234 if $have_hires_utime;
utime( $time, $time, "copy-$$" );
# Recheck the mtime rather than rely on utime in case we're on a
--
2.14.2
|
From andrew@cpan.orgAs noticed by others, I did a poor job with the test and this was not actually working, as overriding utime needs to happen earlier in a BEGIN block. This patch should work better. |
From andrew@cpan.org0001-Support-Time-HiRes-utime-in-File-Copy.patchFrom 0cc4a732b6a92c24b6cc7881676d37a1717ab21c Mon Sep 17 00:00:00 2001
From: Andrew Fresh <afresh1@openbsd.org>
Date: Sun, 5 Nov 2017 12:31:12 -0800
Subject: [PATCH] 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.
---
lib/File/Copy.pm | 2 ++
lib/File/Copy.t | 7 ++++++-
2 files changed, 8 insertions(+), 1 deletion(-)
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
--
2.14.2
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @jkeenanOn Sun, 05 Nov 2017 22:27:48 GMT, andrew@cpan.org wrote:
I have made this code available for smoke-testing (updating $VERSION) in this branch: smoke-me/jkeenan/afresh/132401-file-copy I will apply this code to blead in 7 days unless there are unfavorable smoke results or someone objects. Thank you very much. |
From @jkeenanOn Mon, 06 Nov 2017 14:55:25 GMT, jkeenan wrote:
Tony, thank you for smoke-testing the branch on Cygwin. Unfortunately I see that we have some test failures: ##### [stdio] -Uusethreads -Uusemymalloc [1] For some reason this report is not showing up at http://perl5.test-smoke.org/search This is the first smoke-test report on Cygwin in over 6 months. When I look at older reports, I notice failures in time-related tests. Example ##### ~~ ../dist/Time-HiRes/t/utime.t ................................ FAILED 2-3 Non-zero exit status: 8 My hunch is that we have long-standing problems with perl on Cygwin that need addressing -- but that there's no real obstacle to the application of the patch/branch discussed in this ticket. Do you concur? Thank you very much. |
From @jkeenanOn Tue, 07 Nov 2017 18:02:12 GMT, jkeenan wrote:
Ah, I see that I can answer my own question with your data. At http://perl.develop-help.com/raw/?id=202757 you have posted a smoke-test report on blead on Cygwin which shows the same test failure in branch. So I infer that those test failures are not associated with the patch/branch. Thanks. |
|
@jkeenan - Status changed from 'open' to 'resolved' |
From @iabynOn Sun, Nov 12, 2017 at 03:34:25PM -0800, James E Keenan via RT wrote:
That merge was a bit messy. We prefer merges which only have commits on -- |
Migrated from rt.perl.org#132401 (status was 'resolved')
Searchable as RT132401$
The text was updated successfully, but these errors were encountered: