# New Ticket Created by 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:
> 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:
> 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>
> On 03/12/2007, via RT Justin DeVuyst <perlbug-follo...@perl.org> > wrote: >> 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:
>> 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>
# 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';
