----------------
____________________________________________________________________________
+[ 4752] By: gsar on 2000/01/04 01:19:20
+ Log: s/USE_TEXTMODE_SCRIPTS/PERL_TEXTMODE_SCRIPTS/g
+ Branch: perl
+ ! win32/Makefile win32/makefile.mk win32/win32.h
+____________________________________________________________________________
+[ 4751] By: gsar on 2000/01/03 18:26:08
+ Log: avoid using (custom) autoloader in MakeMaker (from Andreas Koenig)
+ Branch: perl
+ ! lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 4750] By: gsar on 2000/01/02 21:58:02
+ Log: make DProf look at $ENV{PERL_DPROF_OUT_FILE_NAME} to make it possible
+ to write to a file other than tmon.out (suggested by Haakon Alstadheim
+ <Haakon.Alstadheim@sds.no>)
+ Branch: perl
+ ! ext/Devel/DProf/DProf.pm ext/Devel/DProf/DProf.xs
+____________________________________________________________________________
+[ 4749] By: gsar on 2000/01/02 21:37:29
+ Log: disable optimization in change#3612 for join() and quotemeta()--this
+ removes all the gross hacks for the special cases in that change; fix
+ pp_concat() for when TARG == arg (modified version of patch suggested
+ by Ilya Zakharevich)
+ Branch: perl
+ ! op.c opcode.h opcode.pl pp_hot.c sv.c t/op/lex_assign.t
+____________________________________________________________________________
+[ 4748] By: gsar on 2000/01/02 20:26:06
+ Log: MakeMaker should attempt to "require" rather than "use" prerequisites
+ to avoid imports (from Michael G Schwern <schwern@pobox.com>)
+ Branch: perl
+ ! lib/ExtUtils/MakeMaker.pm
+____________________________________________________________________________
+[ 4747] By: gsar on 2000/01/02 20:17:36
+ Log: fix 4-arg substr() when used as argument to subroutine
+ Branch: perl
+ ! pp.c t/op/substr.t
+____________________________________________________________________________
+[ 4746] By: gsar on 2000/01/02 18:45:58
+ Log: usethreads build fixups for NeXTstep (as suggested by Hans Mulder)
+ Branch: perl
+ ! embed.h embed.pl ext/DynaLoader/dl_beos.xs
+ ! ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs
+ ! ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_rhapsody.xs
+ ! perlapi.c proto.h thread.h util.c
+____________________________________________________________________________
+[ 4745] By: gsar on 2000/01/02 18:15:44
+ Log: ebcdic fix for Data::Dumper from Peter Prymmer
+ Branch: perl
+ ! ext/Data/Dumper/Dumper.pm regcomp.c
+____________________________________________________________________________
+[ 4744] By: gsar on 1999/12/31 22:42:23
+ Log: missing files in previous submit
+ Branch: perl
+ ! embed.h embed.pl ext/Devel/DProf/DProf.xs globals.c
+ ! lib/ExtUtils/MM_Unix.pm objXSUB.h perlapi.c proto.h
+____________________________________________________________________________
+[ 4743] By: gsar on 1999/12/31 06:47:18
+ Log: various Windows build tweaks
+ Branch: perl
+ ! win32/win32.h
+____________________________________________________________________________
+[ 4742] By: gsar on 1999/12/30 21:32:36
+ Log: change#4705 breaks code that interpolates $], so leave string value
+ of $] as it was for compatibility (and perhaps introduce $^V or similar
+ for the utf8 representation, maybe?)
+ Branch: perl
+ ! configpm gv.c
+____________________________________________________________________________
+[ 4741] By: gsar on 1999/12/30 19:36:21
+ Log: avoid CRLF in byteloadable files created by perlcc
+ Branch: perl
+ ! utils/perlcc.PL
+____________________________________________________________________________
+[ 4740] By: gsar on 1999/12/30 19:35:07
+ Log: leave DATA open in binmode if __END__ line doesn't have CRLF
+ Branch: perl
+ ! pod/perldelta.pod toke.c
+____________________________________________________________________________
+[ 4739] By: gsar on 1999/12/30 05:44:21
+ Log: enable the PERL_BINMODE_SCRIPTS behavior by default on Windows
+ to allow ByteLoader to work; the DATA filehandles continue to
+ be left open in text mode for compatibility
+ Branch: perl
+ ! embed.h embed.pl objXSUB.h pod/perldelta.pod proto.h sv.c
+ ! toke.c win32/Makefile win32/makefile.mk win32/win32.c
+ ! win32/win32.h
+____________________________________________________________________________
+[ 4738] By: gsar on 1999/12/30 04:36:12
+ Log: CR-LF support broken for formats
+ Branch: perl
+ ! toke.c
+____________________________________________________________________________
+[ 4737] By: gsar on 1999/12/29 22:30:52
+ Log: make DProf functional under pseudo-fork()
+ Branch: perl
+ ! ext/Devel/DProf/DProf.xs
+____________________________________________________________________________
+[ 4736] By: gsar on 1999/12/29 21:04:59
+ Log: slurp mode fix in change#2910 wasn't quite right (spotted by Hans
+ Mulder)
+ Branch: perl
+ ! doio.c pp_hot.c t/io/argv.t
+____________________________________________________________________________
+[ 4735] By: gsar on 1999/12/29 18:12:40
+ Log: re.pm is needed earlier, xsubpp now uses it (spotted by Andreas
+ Koenig)
+ Branch: perl
+ ! Makefile.SH
+____________________________________________________________________________
+[ 4734] By: gsar on 1999/12/28 21:10:37
+ Log: Windows build tweaks
+ Branch: perl
+ ! INTERN.h sv.c
+____________________________________________________________________________
+[ 4733] By: gsar on 1999/12/28 20:45:15
+ Log: remove never-taken branch for making getc() operate on ARGV (spotted
+ by Ralph Corderoy <ralph@inputplus.demon.co.uk>)
+ Branch: perl
+ ! pp_sys.c
+____________________________________________________________________________
+[ 4732] By: gsar on 1999/12/28 20:42:13
+ Log: tests for change#4642 and pod fixups suggested by Ralph Corderoy
+ <ralph@inputplus.demon.co.uk>
+ Branch: perl
+ ! pod/perldelta.pod pod/perlfunc.pod pod/perlre.pod t/io/argv.t
+____________________________________________________________________________
+[ 4731] By: gsar on 1999/12/28 20:23:17
+ Log: optimize XSUBs to use targets if the -nooptimize xsubpp option is
+ not supplied (variant of patch suggested by Ilya Zakharevich)
+ Branch: perl
+ ! XSUB.h lib/ExtUtils/xsubpp
+____________________________________________________________________________
+[ 4730] By: gsar on 1999/12/28 19:55:56
+ Log: range operator does magical string increment iff both operands
+ are non-numbers, from Tom Phoenix <rootbeer@redcat.com>; fixed
+ the "foreach (RANGE)" case as well
+ Branch: perl
+ ! pp_ctl.c t/op/range.t
+____________________________________________________________________________
+[ 4729] By: gsar on 1999/12/28 18:40:19
+ Log: Win9x + GCC update from Benjamin Stuhl <sho_pi@hotmail.com>
+ Branch: perl
+ - win32/PerlCRT.def win32/gstartup.c win32/oldnames.def
+ ! EXTERN.h INTERN.h MANIFEST README.win32 iperlsys.h
+ ! lib/ExtUtils/MM_Win32.pm makedef.pl win32/Makefile
+ ! win32/config.gc win32/genmk95.pl win32/makefile.mk
+ ! win32/perlhost.h win32/perllib.c win32/runperl.c win32/win32.c
+ ! win32/win32.h
+____________________________________________________________________________
+[ 4728] By: gsar on 1999/12/28 07:44:19
+ Log: typecasts needed
+ Branch: perl
+ ! toke.c
+____________________________________________________________________________
+[ 4727] By: gsar on 1999/12/28 06:23:08
+ Log: change#4721 needed line number adjustments
+ Branch: perl
+ ! MANIFEST global.sym proto.h t/pragma/warn/doop
+ ! t/pragma/warn/pp t/pragma/warn/regcomp t/pragma/warn/sv
+ ! t/pragma/warn/toke t/pragma/warn/utf8
+____________________________________________________________________________
+[ 4726] By: gsar on 1999/12/28 04:18:15
+ Log: integrate utfperl contents into mainline
+ Branch: perl
+ +> lib/byte.pm lib/byte_heavy.pl
+ !> configpm embed.h embed.pl embedvar.h gv.c intrpvar.h objXSUB.h
+ !> patchlevel.h perl.c perl.h perlapi.c pp_ctl.c pp_hot.c proto.h
+ !> regnodes.h sv.c sv.h t/comp/require.t toke.c utf8.h
+____________________________________________________________________________
+[ 4725] By: gsar on 1999/12/28 04:08:09
+ Log: integrate mainline contents
+ Branch: utfperl
+ - ext/DynaLoader/dl_cygwin.xs lib/unicode/Eq/Latin1
+ - lib/unicode/Eq/Unicode
+ !> (integrate 60 files)
+____________________________________________________________________________
+[ 4724] By: gsar on 1999/12/28 03:44:10
+ Log: fix for /(^|a)b/ breakage from Ilya Zakharevich
+ Branch: perl
+ ! regcomp.c t/op/re_tests
+____________________________________________________________________________
+[ 4723] By: gsar on 1999/12/28 03:28:39
+ Log: more ebcdic testsuite fixups (from Peter Prymmer)
+ Branch: perl
+ ! Changes lib/bigfloat.pl t/lib/charnames.t t/lib/dumper.t
+ ! t/pragma/overload.t t/pragma/utf8.t
+____________________________________________________________________________
+[ 4722] By: gsar on 1999/12/28 03:14:48
+ Log: avoid "used once" warning
+ Branch: perl
+ ! lib/diagnostics.pm
+____________________________________________________________________________
[ 4722] By: gsar on 1999/12/28 03:14:48
Log: avoid "used once" warning
Branch: perl
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);
$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);
}
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;
# Use this idiom to avoid uninitialized value warning.
return 1;
-
+
# All of these contortions try to preserve error messages...
fail_inner:
if ($closeto) {
(($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);
return Win32::CopyFile(@_, 1);
};
} else {
+ $Syscopy_is_copy = 1;
*syscopy = \©
}
}
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-$$";