diff options
| author | Steve Hay <steve.m.hay@googlemail.com> | 2012-08-28 11:33:00 +0100 |
|---|---|---|
| committer | Steve Hay <steve.m.hay@googlemail.com> | 2012-08-28 18:29:12 +0100 |
| commit | 39b80fd98d49815a504e4c2feeb5d6ae5ee1555e (patch) | |
| tree | 09f1f16a5fcee7afdc77d1a131eb72ee476d79df /lib | |
| parent | a0084943302ae84253561a08e28aecf602611ac4 (diff) | |
| download | perl-39b80fd98d49815a504e4c2feeb5d6ae5ee1555e.tar.gz | |
Revert File::Copy::copy() to fail when copying a file onto itself
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.
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/File/Copy.pm | 6 | ||||
| -rw-r--r-- | lib/File/Copy.t | 4 |
2 files changed, 4 insertions, 6 deletions
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index fd7403dff4..ef27037c4b 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -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 diff --git a/lib/File/Copy.t b/lib/File/Copy.t index e46de358f6..8108caf0b8 100644 --- a/lib/File/Copy.t +++ b/lib/File/Copy.t @@ -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'; |