summaryrefslogtreecommitdiff
path: root/lib/File
diff options
context:
space:
mode:
authorNiko Tyni <ntyni@debian.org>2009-07-22 11:22:44 +0200
committerSteffen Mueller <smueller@cpan.org>2009-07-22 11:22:44 +0200
commit16f708c9bc0dc48713b200031295a40bed83bbfc (patch)
tree1d7e4c9a211f5a74a4ea497edf25eb6222f98742 /lib/File
parentbb74b0ee4e732d7f05e2d9e9690a7ada65f6039e (diff)
downloadperl-16f708c9bc0dc48713b200031295a40bed83bbfc.tar.gz
Fix File::Copy::copy with pipes on GNU/kFreeBSD
Quoting Petr Salinger in http://bugs.debian.org/537555: The Copy tries to detect whether source and dest are the same files. Unfortunately, on the GNU/kFreeBSD the kernel returns for all pipes as device and inode numbers just zero. See pipe_stat() in http://www.freebsd.org/cgi/cvsweb.cgi/src/sys/kern/sys_pipe.c Patch by Petr Salinger, tests by Niko Tyni.
Diffstat (limited to 'lib/File')
-rw-r--r--lib/File/Copy.pm4
-rw-r--r--lib/File/Copy.t15
2 files changed, 16 insertions, 3 deletions
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index be1442f745..83d7a25c67 100644
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -22,7 +22,7 @@ sub syscopy;
sub cp;
sub mv;
-$VERSION = '2.15';
+$VERSION = '2.16';
require Exporter;
@ISA = qw(Exporter);
@@ -150,7 +150,7 @@ sub copy {
my @fs = stat($from);
if (@fs) {
my @ts = stat($to);
- if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) {
+ if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1] && !-p $from) {
carp("'$from' and '$to' are identical (not copied)");
return 0;
}
diff --git a/lib/File/Copy.t b/lib/File/Copy.t
index 7077a38511..abff488099 100644
--- a/lib/File/Copy.t
+++ b/lib/File/Copy.t
@@ -14,7 +14,7 @@ use Test::More;
my $TB = Test::More->builder;
-plan tests => 459;
+plan tests => 461;
# We're going to override rename() later on but Perl has to see an override
# at compile time to honor it.
@@ -435,6 +435,19 @@ SKIP: {
}
}
+SKIP: {
+ skip("fork required to test pipe copying", 2)
+ if (!$Config{'d_fork'});
+
+ open(my $IN, "-|") || exec $^X, '-e', 'print "Hello, world!\n"';
+ open(my $OUT, "|-") || exec $^X, '-ne', 'exit(/Hello/ ? 55 : 0)';
+
+ ok(copy($IN, $OUT), "copy pipe to another");
+ close($OUT);
+ is($? >> 8, 55, "content copied through the pipes");
+ close($IN);
+}
+
END {
1 while unlink "file-$$";
1 while unlink "lib/file-$$";