diff options
author | Niko Tyni <ntyni@debian.org> | 2009-07-22 11:22:44 +0200 |
---|---|---|
committer | Steffen Mueller <smueller@cpan.org> | 2009-07-22 11:22:44 +0200 |
commit | 16f708c9bc0dc48713b200031295a40bed83bbfc (patch) | |
tree | 1d7e4c9a211f5a74a4ea497edf25eb6222f98742 /lib/File | |
parent | bb74b0ee4e732d7f05e2d9e9690a7ada65f6039e (diff) | |
download | perl-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.pm | 4 | ||||
-rw-r--r-- | lib/File/Copy.t | 15 |
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-$$"; |