This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert File::Copy::copy() to fail when copying a file onto itself
authorSteve Hay <steve.m.hay@googlemail.com>
Tue, 28 Aug 2012 10:33:00 +0000 (11:33 +0100)
committerSteve Hay <steve.m.hay@googlemail.com>
Tue, 28 Aug 2012 17:29:12 +0000 (18:29 +0100)
Copying a file onto itself was made a fatal error by 96a91e0163.
This was changed in 754f2cd0b9 from an undesirable croak() to return 1,
but the documentation was never changed from it being a fatal error.
It should probably have remained an error as per the documentation (but
updated not to say fatal) for consistency with cases of copying a file
onto itself via symbolic links or hard links.

lib/File/Copy.pm
lib/File/Copy.t

index fd7403d..ef27037 100644 (file)
@@ -128,9 +128,7 @@ sub copy {
 
     if (_eq($from, $to)) { # works for references, too
        carp("'$from' and '$to' are identical (not copied)");
-        # The "copy" was a success as the source and destination contain
-        # the same data.
-        return 1;
+        return 0;
     }
 
     if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
@@ -472,7 +470,7 @@ glob. Obviously, if the first argument is a filehandle of some
 sort, it will be read from, and if it is a file I<name> it will
 be opened for reading. Likewise, the second argument will be
 written to (and created if need be).  Trying to copy a file on top
-of itself is a fatal error.
+of itself is an error.
 
 If the destination (second argument) already exists and is a directory,
 and the source (first argument) is not a filehandle, then the source
index e46de35..8108caf 100644 (file)
@@ -139,7 +139,7 @@ for my $cross_partition_test (0..1) {
   { 
     my $warnings = '';
     local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
-    ok copy("file-$$", "file-$$"), 'copy(fn, fn) succeeds';
+    ok !copy("file-$$", "file-$$"), 'copy to itself fails';
 
     like $warnings, qr/are identical/, 'but warns';
     ok -s "file-$$", 'contents preserved';
@@ -411,7 +411,7 @@ SKIP: {
        foreach my $right (qw(plain object1 object2)) {
            @warnings = ();
            $! = 0;
-           is eval {copy $what{$left}, $what{$right}}, 1, "copy $left $right";
+           is eval {copy $what{$left}, $what{$right}}, 0, "copy $left $right";
            is $@, '', 'No croaking';
            is $!, '', 'No system call errors';
            is @warnings, 1, 'Exactly 1 warning';