Make File::Copy always return 0 (not "") on failure.

[p5sagit/p5-mst-13.2.git] / lib / File / Copy.t

diff --git a/lib/File/Copy.t b/lib/File/Copy.t
index 7081f5e..cf5b2d9 100755 (executable)
--- a/lib/File/Copy.t
+++ b/lib/File/Copy.t
@@ -14,7 +14,7 @@ use Test::More;
 
 my $TB = Test::More->builder;
 
-plan tests => 451;
+plan tests => 459;
 
 # We're going to override rename() later on but Perl has to see an override
 # at compile time to honor it.
@@ -284,7 +284,30 @@ SKIP: {
 
             $s_perm  |= $id << 9;
             $c_perm1 |= $id << 9;
-            diag sprintf "Src permission: %04o; umask %03o\n", $s_perm, $umask;
+            diag(sprintf "Src permission: %04o; umask %03o\n", $s_perm, $umask)
+                unless ($ENV{PERL_CORE});
+
+           # Test that we can actually set a file to the correct permission.
+           # Slightly convoluted, because some operating systems will let us
+           # set a directory, but not a file. These should all work:
+           mkdir $copy1 or die "Can't mkdir $copy1: $!";
+           chmod $s_perm, $copy1 or die "Can't chmod %o $copy1: $!", $s_perm;
+           rmdir $copy1 or die "Can't rmdir $copy1: $!";
+           open my $fh0, '>', $copy1 or die "Can't open $copy1: $!";
+           close $fh0 or die "Can't close $copy1: $!";
+           unless (chmod $s_perm, $copy1) {
+               $TB->skip(sprintf "Can't chmod $copy1 to %o: $!", $s_perm)
+                   for 1..6;
+               next;
+           }
+            my $perm0 = (stat $copy1) [2] & 07777;
+           unless ($perm0 == $s_perm) {
+               $TB->skip(sprintf "chmod %o $copy1 lies - we actually get %o",
+                         $s_perm, $perm0)
+                   for 1..6;
+               next;
+           }
+           unlink $copy1 or die "Can't unlink $copy1: $!";
 
             (umask $umask) // die $!;
             chmod $s_perm  => $src   or die sprintf "$!: $src => %o", $s_perm;
@@ -373,6 +396,43 @@ SKIP: {
     }
 }
 
+# On Unix systems, File::Copy always returns 0 to signal failure,
+# even when in list context!  On Windows, it always returns "" to signal
+# failure.
+#
+# While returning a list containing a false value is arguably a bad
+# API design, at the very least we can make sure it always returns
+# the same false value.
+
+my $NO_SUCH_FILE       = "this_file_had_better_not_exist";
+my $NO_SUCH_OTHER_FILE = "my_goodness_im_sick_of_airports";
+
+use constant EXPECTED_SCALAR => 0;
+use constant EXPECTED_LIST   => [ EXPECTED_SCALAR ];
+
+my %subs = (
+    copy    =>  \&File::Copy::copy,
+    cp      =>  \&File::Copy::cp,
+    move    =>  \&File::Copy::move,
+    mv      =>  \&File::Copy::mv,
+);
+
+SKIP: {
+    skip( "Test can't run with $NO_SUCH_FILE existing", 2 * keys %subs)
+        if (-e $NO_SUCH_FILE);
+
+    foreach my $name (keys %subs) {
+
+        my $sub = $subs{$name};
+
+        my $scalar = $sub->( $NO_SUCH_FILE, $NO_SUCH_OTHER_FILE );
+        is( $scalar, EXPECTED_SCALAR, "$name in scalar context");
+
+        my @array  = $sub->( $NO_SUCH_FILE, $NO_SUCH_OTHER_FILE );
+        is_deeply( \@array, EXPECTED_LIST, "$name in list context");
+    }
+}
+
 END {
     1 while unlink "file-$$";
     1 while unlink "lib/file-$$";