[PATCH] 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.
---
 lib/File/Copy.pm |    2 +-
 lib/File/Copy.t  |   15 ++++++++++++++-
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index be1442f..d7ba500 100644
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -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 7077a38..abff488 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-$$";
-- 
1.5.6.5

• [PATCH] Fix File::Copy::copy with pipes on GNU/kFreeBSD by Niko Tyni
• Re: [PATCH] Fix File::Copy::copy with pipes on GNU/kFreeBSD by Steffen Mueller