[perl #48078] Backwards compat issue with File::Copy
Justin DeVuyst
# Please include the string: [perl #48078]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=48078 >
This is a bug report for perl from jus...@devuyst.com,
generated with the help of perlbug 1.36 running under perl 5.10.0.
-----------------------------------------------------------------
[Please enter your report here]
File::Copy::copy() checks whether its two args are equal. Newer
versions like 2.10 & 2.11 break when passed Path::Class objects.
Version 2.9 worked just fine. The following patch seems to fix the
problem.
--- ./perl-5.10.0-RC2/lib/File/Copy.pm 2007-11-25 13:09:07.000000000
-0500
+++ ./lib/File/Copy.pm 2007-12-02 18:06:41.000000000 -0500
@@ -12,6 +12,7 @@
use warnings;
use File::Spec;
use Config;
+use Scalar::Util qw( reftype );
our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
sub copy;
sub syscopy;
@@ -67,7 +68,8 @@
# _eq($from, $to) tells whether $from and $to are identical
# works for strings and references
sub _eq {
- return $_[0] == $_[1] if ref $_[0] && ref $_[1];
+ return $_[0] == $_[1]
+ if reftype( $_[0] ) eq 'GLOB' && reftype( $_[1] ) eq 'GLOB';
return $_[0] eq $_[1] if !ref $_[0] && !ref $_[1];
return "";
}
The test case I used was this:
<snip>
use File::Copy;
use Path::Class;
use strict;
use warnings;
copy( file( 'file1' ), file( 'file2' ) ) or die "Copy failed: $!";
</snip>
Thanks,
jdv
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=library
severity=medium
---
Site configuration information for perl 5.10.0:
Configured by jdv at Sun Dec 2 04:38:26 EST 2007.
Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
Platform:
osname=darwin, osvers=8.11.1, archname=darwin-2level
uname='darwin maclap 8.11.1 darwin kernel version 8.11.1: wed oct
10 18:23:28 pdt 2007; root:xnu-792.25.20~1release_i386 i386 i386 '
config_args='-de'
hint=recommended, useposix=true, d_sigaction=define
useithreads=undef, usemultiplicity=undef
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=undef, use64bitall=undef, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-fno-common -DPERL_DARWIN -no-cpp-precomp
-fno-strict-aliasing -pipe -I/usr/local/include
-I/opt/local/include',
optimize='-O3',
cppflags='-no-cpp-precomp -fno-common -DPERL_DARWIN
-no-cpp-precomp -fno-strict-aliasing -pipe -I/usr/local/include
-I/opt/local/include'
ccversion='', gccversion='4.0.1 (Apple Computer, Inc. build
5250)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags ='
-L/usr/local/lib -L/opt/local/lib'
libpth=/usr/local/lib /opt/local/lib /usr/lib
libs=-ldbm -ldl -lm -lc
perllibs=-ldl -lm -lc
libc=/usr/lib/libc.dylib, so=dylib, useshrplib=false,
libperl=libperl.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup
-L/usr/local/lib -L/opt/local/lib'
Locally applied patches:
RC2
---
@INC for perl 5.10.0:
./lib
/sw/lib/perl5
/sw/lib/perl5/darwin
/Users/jdv/Desktop/lib
/usr/local/lib/perl5/5.10.0/darwin-2level
/usr/local/lib/perl5/5.10.0
/usr/local/lib/perl5/site_perl/5.10.0/darwin-2level
/usr/local/lib/perl5/site_perl/5.10.0
.
---
Environment for perl 5.10.0:
DYLD_LIBRARY_PATH (unset)
HOME=/Users/jdv
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/opt/local/bin:/opt/local/sbin:/sw/bin:/sw/sbin:/Users/jdv/Desktop/bin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin
PERL5LIB=/sw/lib/perl5:/sw/lib/perl5/darwin:/Users/jdv/Desktop/lib:
PERL_BADLANG (unset)
SHELL=/bin/bash
Rafael Garcia-Suarez
> File::Copy::copy() checks whether its two args are equal. Newer
> versions like 2.10 & 2.11 break when passed Path::Class objects.
> Version 2.9 worked just fine. The following patch seems to fix the
> problem.
>
> --- ./perl-5.10.0-RC2/lib/File/Copy.pm 2007-11-25 13:09:07.000000000
> -0500
> +++ ./lib/File/Copy.pm 2007-12-02 18:06:41.000000000 -0500
> @@ -12,6 +12,7 @@
> use warnings;
> use File::Spec;
> use Config;
> +use Scalar::Util qw( reftype );
> our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
> sub copy;
> sub syscopy;
> @@ -67,7 +68,8 @@
> # _eq($from, $to) tells whether $from and $to are identical
> # works for strings and references
> sub _eq {
> - return $_[0] == $_[1] if ref $_[0] && ref $_[1];
> + return $_[0] == $_[1]
> + if reftype( $_[0] ) eq 'GLOB' && reftype( $_[1] ) eq 'GLOB';
reftype() might be a bit overkill here. I think we want use ref address
comparison if both refs are (unblessed) GLOBs, and use eq as a fallback:
> return $_[0] eq $_[1] if !ref $_[0] && !ref $_[1];
return $_[0] eq $_[1];
This way, objects with overloaded stringification will work.
Comments?
Justin DeVuyst
That sounds much more sane. I did my patch hastily and realized
it wasn't very good after the fact. Thanks for not accepting it.
Justin DeVuyst
diff -ru lib/File/Copy.pm lib2/File/Copy.pm
--- lib/File/Copy.pm 2007-12-10 04:53:02.000000000 -0500
+++ lib2/File/Copy.pm 2007-12-10 04:12:33.000000000 -0500
@@ -12,6 +12,7 @@
use warnings;
use File::Spec;
use Config;
+use Scalar::Util qw( blessed refaddr );
our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
sub copy;
sub syscopy;
@@ -67,9 +68,9 @@
# _eq($from, $to) tells whether $from and $to are identical
# works for strings and references
sub _eq {
- return $_[0] == $_[1] if ref $_[0] && ref $_[1];
- return $_[0] eq $_[1] if !ref $_[0] && !ref $_[1];
- return "";
+ return refaddr $_[0] == refaddr $_[1]
+ if ref $_[0] && ref $_[1] && ! blessed $_[0] && ! blessed $_[1];
+ return $_[0] eq $_[1];
}
sub copy {
diff -ru lib/File/Copy.t lib2/File/Copy.t
--- lib/File/Copy.t 2007-12-10 04:14:20.000000000 -0500
+++ lib2/File/Copy.t 2007-12-10 05:00:28.000000000 -0500
@@ -11,7 +11,7 @@
my $TB = Test::More->builder;
-plan tests => 60;
+plan tests => 72;
# We're going to override rename() later on but Perl has to see an
override
# at compile time to honor it.
@@ -142,6 +142,33 @@
ok -s "file-$$", 'contents preserved';
}
+ {
+ open( my $fh, 'file-$$' ) or die $!;
+ my $warnings = '';
+ local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
+ ok copy($fh, $fh), 'copy(fh, fh) succeeds';
+
+ like $warnings, qr/are identical/, 'but warns';
+ ok -s "file-$$", 'contents preserved';
+ }
+
+ {
+ package SomeClass;
+ use overload
+ '""' => sub { $_[0]->{str} },
+ fallback => 1;
+ package main;
+ my $obj1 = bless( { str => "file-$$" }, 'SomeClass' );
+ my $obj2 = bless( { str => "file-$$" }, 'SomeClass' );
+ my $warnings = '';
+ local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
+ ok copy($obj1, $obj2), 'copy(o, o) succeeds';
+
+ unlike $warnings, qr/isn't numeric/, 'rt.perl.org 48078: bad
comparison';
+ like $warnings, qr/are identical/, 'but warns';
+ ok -s $obj1, 'contents preserved';
+ }
+
move "file-$$", "lib";
open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>;
close(R);
is $foo, "ok\n", 'move(fn, dir): same contents';
-jdv