[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]
Reloading File::Copy
This patch makes File::Copy reloadable. With the current algorithm
reloading can result in an endless loop that is difficult to debug.
Thanks to Ulrich Pfeifer who diagnosed the problem.
Most chunks just eliminate trailing whitespace in case you wonder.
The test harness now does a second pass on the otherwise identical
tests as before. Without this patch, it would hang after test 11 on a
machine where "syscopy is copy".
--- perl5.005_63..4750/lib/File/Copy.pm.2.02 Mon Jan 3 19:44:33 2000
+++ perl5.005_63..4750/lib/File/Copy.pm Mon Jan 3 21:39:06 2000
@@ -10,14 +10,14 @@
use strict;
use Carp;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $Too_Big
- © &syscopy &cp &mv);
+ © &syscopy &cp &mv $Syscopy_is_copy);
# Note that this module implements only *part* of the API defined by
# the File/Copy.pm module of the File-Tools-2.0 package. However, that
# package has not yet been updated to work with Perl 5.004, and so it
# would be a Bad Thing for the CPAN module to grab it and replace this
# module. Therefore, we set this module's version higher than 2.0.
-$VERSION = '2.02';
+$VERSION = '2.03';
require Exporter;
@ISA = qw(Exporter);
@@ -60,12 +60,12 @@
$to = _catname($from, $to);
}
- if (defined &syscopy && \&syscopy != \©
+ if (defined &syscopy && !$Syscopy_is_copy
&& !$to_a_handle
&& !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles
&& !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX.
&& !($from_a_handle && $^O eq 'MSWin32')
- )
+ )
{
return syscopy($from, $to);
}
@@ -83,16 +83,16 @@
open(FROM, "< $from\0") or goto fail_open1;
binmode FROM or die "($!,$^E)";
$closefrom = 1;
- }
-
+ }
+
if ($to_a_handle) {
*TO = *$to{FILEHANDLE};
- } else {
+ } else {
$to = "./$to" if $to =~ /^\s/;
open(TO,"> $to\0") or goto fail_open2;
binmode TO or die "($!,$^E)";
$closeto = 1;
- }
+ }
if (@_) {
$size = shift(@_) + 0;
@@ -120,7 +120,7 @@
# Use this idiom to avoid uninitialized value warning.
return 1;
-
+
# All of these contortions try to preserve error messages...
fail_inner:
if ($closeto) {
@@ -163,10 +163,10 @@
(($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there
($tosz1 != $tosz2 or $tomt1 != $tomt2) && # and changed
$tosz2 == $fromsz; # it's all there
-
+
($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something
return 1 if ($copied = copy($from,$to)) && unlink($from);
-
+
($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
($!,$^E) = ($sts,$ossts);
@@ -193,6 +193,7 @@
return Win32::CopyFile(@_, 1);
};
} else {
+ $Syscopy_is_copy = 1;
*syscopy = \©
}
}
--- perl5.005_63..4750/t/lib/filecopy.t~63~4750 Mon Jan 3 21:06:46 2000
+++ perl5.005_63..4750/t/lib/filecopy.t Mon Jan 3 21:38:29 2000
@@ -5,88 +5,103 @@
unshift @INC, '../lib';
}
-print "1..11\n";
-
$| = 1;
+my @pass = (0,1);
+my $tests = 11;
+printf "1..%d\n", $tests * scalar(@pass);
+
use File::Copy;
-# First we create a file
-open(F, ">file-$$") or die;
-binmode F; # for DOSISH platforms, because test 3 copies to stdout
-print F "ok 3\n";
-close F;
-
-copy "file-$$", "copy-$$";
-
-open(F, "copy-$$") or die;
-$foo = <F>;
-close(F);
-
-print "not " if -s "file-$$" != -s "copy-$$";
-print "ok 1\n";
-
-print "not " unless $foo eq "ok 3\n";
-print "ok 2\n";
-
-binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode
-copy "copy-$$", \*STDOUT;
-unlink "copy-$$" or die "unlink: $!";
-
-open(F,"file-$$");
-copy(*F, "copy-$$");
-open(R, "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R);
-print "not " unless $foo eq "ok 3\n";
-print "ok 4\n";
-unlink "copy-$$" or die "unlink: $!";
-open(F,"file-$$");
-copy(\*F, "copy-$$");
-close(F) or die "close: $!";
-open(R, "copy-$$") or die; $foo = <R>; close(R) or die "close: $!";
-print "not " unless $foo eq "ok 3\n";
-print "ok 5\n";
-unlink "copy-$$" or die "unlink: $!";
-
-require IO::File;
-$fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!";
-binmode $fh or die;
-copy("file-$$",$fh);
-$fh->close or die "close: $!";
-open(R, "copy-$$") or die; $foo = <R>; close(R);
-print "# foo=`$foo'\nnot " unless $foo eq "ok 3\n";
-print "ok 6\n";
-unlink "copy-$$" or die "unlink: $!";
-require FileHandle;
-my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!";
-binmode $fh or die;
-copy("file-$$",$fh);
-$fh->close;
-open(R, "copy-$$") or die; $foo = <R>; close(R);
-print "not " unless $foo eq "ok 3\n";
-print "ok 7\n";
-unlink "file-$$" or die "unlink: $!";
-
-print "# moved missing file.\nnot " if move("file-$$", "copy-$$");
-print "# target disappeared.\nnot " if not -e "copy-$$";
-print "ok 8\n";
-
-move "copy-$$", "file-$$" or print "# move did not succeed.\n";
-print "# not moved: $!\nnot " unless -e "file-$$" and not -e "copy-$$";
-open(R, "file-$$") or die; $foo = <R>; close(R);
-print "# foo=`$foo'\nnot " unless $foo eq "ok 3\n";
-print "ok 9\n";
-
-copy "file-$$", "lib";
-open(R, "lib/file-$$") or die; $foo = <R>; close(R);
-print "not " unless $foo eq "ok 3\n";
-print "ok 10\n";
-unlink "lib/file-$$" or die "unlink: $!";
-
-move "file-$$", "lib";
-open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>; close(R);
-print "not " unless $foo eq "ok 3\n" and not -e "file-$$";;
-print "ok 11\n";
-unlink "lib/file-$$" or die "unlink: $!";
+for my $pass (@pass) {
+
+ require File::Copy;
+
+ my $loopconst = $pass*$tests;
+
+ # First we create a file
+ open(F, ">file-$$") or die;
+ binmode F; # for DOSISH platforms, because test 3 copies to stdout
+ printf F "ok %d\n", 3 + $loopconst;
+ close F;
+
+ copy "file-$$", "copy-$$";
+
+ open(F, "copy-$$") or die;
+ $foo = <F>;
+ close(F);
+
+ print "not " if -s "file-$$" != -s "copy-$$";
+ printf "ok %d\n", 1 + $loopconst;
+
+ print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+ printf "ok %d\n", 2+$loopconst;
+
+ binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode
+ copy "copy-$$", \*STDOUT;
+ unlink "copy-$$" or die "unlink: $!";
+
+ open(F,"file-$$");
+ copy(*F, "copy-$$");
+ open(R, "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R);
+ print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+ printf "ok %d\n", 4+$loopconst;
+ unlink "copy-$$" or die "unlink: $!";
+ open(F,"file-$$");
+ copy(\*F, "copy-$$");
+ close(F) or die "close: $!";
+ open(R, "copy-$$") or die; $foo = <R>; close(R) or die "close: $!";
+ print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+ printf "ok %d\n", 5+$loopconst;
+ unlink "copy-$$" or die "unlink: $!";
+
+ require IO::File;
+ $fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!";
+ binmode $fh or die;
+ copy("file-$$",$fh);
+ $fh->close or die "close: $!";
+ open(R, "copy-$$") or die; $foo = <R>; close(R);
+ print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+ printf "ok %d\n", 6+$loopconst;
+ unlink "copy-$$" or die "unlink: $!";
+ require FileHandle;
+ my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!";
+ binmode $fh or die;
+ copy("file-$$",$fh);
+ $fh->close;
+ open(R, "copy-$$") or die; $foo = <R>; close(R);
+ print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+ printf "ok %d\n", 7+$loopconst;
+ unlink "file-$$" or die "unlink: $!";
+
+ print "# moved missing file.\nnot " if move("file-$$", "copy-$$");
+ print "# target disappeared.\nnot " if not -e "copy-$$";
+ printf "ok %d\n", 8+$loopconst;
+
+ move "copy-$$", "file-$$" or print "# move did not succeed.\n";
+ print "# not moved: $!\nnot " unless -e "file-$$" and not -e "copy-$$";
+ open(R, "file-$$") or die; $foo = <R>; close(R);
+ print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+ printf "ok %d\n", 9+$loopconst;
+
+ copy "file-$$", "lib";
+ open(R, "lib/file-$$") or die; $foo = <R>; close(R);
+ print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+ printf "ok %d\n", 10+$loopconst;
+ unlink "lib/file-$$" or die "unlink: $!";
+
+ move "file-$$", "lib";
+ open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>; close(R);
+ print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst)
+ and not -e "file-$$";;
+ printf "ok %d\n", 11+$loopconst;
+ unlink "lib/file-$$" or die "unlink: $!";
+
+ # warn sprintf "INC->".$INC{"File/Copy.pm"};
+ delete $INC{"File/Copy.pm"};
+
+}
+
END {
1 while unlink "file-$$";
--
andreas
[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]