Change 11526 by jhi@alpha on 2001/07/31 23:47:57
Fix for
Subject: [ID 20010116.001] File::Copy truncates orig file
From: [EMAIL PROTECTED]
Date: Tue, 16 Jan 2001 11:43:02 GMT
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/lib/File/Copy.pm#21 edit
... //depot/perl/lib/File/Copy.t#2 edit
Differences ...
==== //depot/perl/lib/File/Copy.pm#21 (text) ====
Index: perl/lib/File/Copy.pm
--- perl/lib/File/Copy.pm.~1~ Tue Jul 31 18:00:05 2001
+++ perl/lib/File/Copy.pm Tue Jul 31 18:00:05 2001
@@ -12,6 +12,7 @@
use warnings;
use Carp;
use File::Spec;
+use Config;
our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
sub copy;
sub syscopy;
@@ -65,6 +66,21 @@
|| UNIVERSAL::isa($to, 'IO::Handle'))
: (ref(\$to) eq 'GLOB'));
+ if ($from eq $to) { # works for references, too
+ croak("'$from' and '$to' are identical (not copied)");
+ }
+
+ if ($Config{d_symlink} && $Config{d_readlink} &&
+ !($^O eq 'Win32' || $^O eq 'os2' || $^O eq 'vms')) {
+ if (-l $from || -l $to) {
+ my @fs = stat($from);
+ my @ts = stat($to);
+ if ($fs[0] == $ts[0] && $fs[1] == $ts[1]) {
+ croak("'$from' and '$to' are identical (not copied)");
+ }
+ }
+ }
+
if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
$to = _catname($from, $to);
}
@@ -275,7 +291,8 @@
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).
+written to (and created if need be). Trying to copy a file on top
+of itself is a fatal error.
B<Note that passing in
files as handles instead of names may lead to loss of information
==== //depot/perl/lib/File/Copy.t#2 (xtext) ====
Index: perl/lib/File/Copy.t
--- perl/lib/File/Copy.t.~1~ Tue Jul 31 18:00:05 2001
+++ perl/lib/File/Copy.t Tue Jul 31 18:00:05 2001
@@ -9,7 +9,7 @@
$| = 1;
my @pass = (0,1);
-my $tests = $^O eq 'MacOS' ? 14 : 11;
+my $tests = $^O eq 'MacOS' ? 15 : 12;
printf "1..%d\n", $tests * scalar(@pass);
use File::Copy;
@@ -116,6 +116,11 @@
print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst)
and not -e "file-$$";;
printf "ok %d\n", 14+$loopconst;
+
+ eval { copy("copy-$$", "copy-$$") };
+ printf "ok %d\n", 15+$loopconst
+ unless $@ =~ /are identical/ && -s "copy-$$";
+
unlink ":lib:file-$$" or die "unlink: $!";
} else {
@@ -131,6 +136,11 @@
print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst)
and not -e "file-$$";;
printf "ok %d\n", 11+$loopconst;
+
+ eval { copy("copy-$$", "copy-$$") };
+ printf "ok %d\n", 12+$loopconst
+ unless $@ =~ /are identical/ && -s "copy-$$";
+
unlink "lib/file-$$" or die "unlink: $!";
}
End of Patch.
