Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

File::Copy::copy() "works" when given a directory as a from parameter #16419

Open
p5pRT opened this issue Feb 13, 2018 · 11 comments
Open

File::Copy::copy() "works" when given a directory as a from parameter #16419

p5pRT opened this issue Feb 13, 2018 · 11 comments

Comments

@p5pRT
Copy link

p5pRT commented Feb 13, 2018

Migrated from rt.perl.org#132866 (status was 'open')

Searchable as RT132866$

@p5pRT
Copy link
Author

p5pRT commented Feb 13, 2018

From daver@activestate.com

Created by daver@activestate.com

File​::Copy​::copy() seems to expect that calling

  open $fh, '<', '/dir' or ...

will fail. However, on HPUX this succeeds and reading from the filehandle
returns a directory listing and some sort of binary data junk.

Perl Info

Flags:
    category=library
    severity=low
    module=File::Copy

Site configuration information for perl 5.20.3:

Configured by ActiveState at Thu Dec 24 19:25:37 PST 2015.

Summary of my perl5 (revision 5 version 20 subversion 3) configuration:

  Platform:
    osname=hpux, osvers=11.23, archname=IA64.ARCHREV_0-thread-multi-LP64
    uname='hp-ux bugaboo b.11.23 u ia64 3532919469 unlimited-user license '
    config_args='-ders -Dcc=cc -Dusethreads -Duseithreads
-Uinstallusrbinperl -Ulocincpth= -Uloclibpth= -Duse64bitall
-Dsh=/usr/bin/sh -Dd_attribut=undef -Dd_attribute_warn_unused_result=undef
-Dd_u32align=define -Aprepend:libswanted=cl  -Accflags=+DSitanium2
-Doptimize=-fast +Ofltacc=strict -Accflags=+Z -Accflags=-DUSE_SITECUSTOMIZE
-Duselargefiles -Accflags=-DPERL_RELOCATABLE_INCPUSH
-Dprefix=/home/gecko/ap520 -Dprivlib=/home/gecko/ap520/lib
-Darchlib=/home/gecko/ap520/lib -Dsiteprefix=/home/gecko/ap520/site
-Dsitelib=/home/gecko/ap520/site/lib -Dsitearch=/home/gecko/ap520/site/lib
-Dsed=/usr/bin/sed -Duseshrplib -Dcf_by=ActiveState
-Dcf_email=support@ActiveState.com'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags =' -D_POSIX_C_SOURCE=199506L -D_REENTRANT -Ae
-D_HPUX_SOURCE -Wl,+vnocompatwarnings +DD64 +DSitanium2 +Z
-DUSE_SITECUSTOMIZE -DPERL_RELOCATABLE_INCPUSH -D_LARGEFILE_SOURCE
-D_FILE_OFFSET_BITS=64 ',
    optimize='-fast +Ofltacc=strict',
    cppflags=''
    ccversion='B3910B A.05.55', gccversion='', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=87654321
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='/usr/bin/ld', ldflags =' +DD64 -L/usr/lib/hpux64'
    libpth=/usr/lib/hpux64 /lib /usr/lib /usr/ccs/lib /usr/local/lib
    libs=-lcl -lpthread -lnsl -lnm -ldl -lm -lsec -lc
    perllibs=-lcl -lpthread -lnsl -lnm -ldl -lm -lsec -lc
    libc=/usr/lib/hpux64/libc.so, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_hpux.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E
-Wl,-B,deferred '
    cccdlflags='+Z', lddlflags='-b +vnocompatwarnings -L/usr/lib/hpux64'

Locally applied patches:
    ActivePerl Enterprise Build 2003.1 [299574]


@INC for perl 5.20.3:
    /home/gecko/ap520/site/lib
    /home/gecko/ap520/lib
    .


Environment for perl 5.20.3:
    HOME=/home/gecko
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)

PATH=/home/gecko/ap520/bin:/home/gecko/localbin:/usr/local/bin:/usr/contrib/bin:/usr/bin:/bin:/usr/sbin:/sbin:/usr/ccs/bin:/opt/imake/bin
    PERL_BADLANG (unset)
    SHELL=/usr/local/bin/bash

@p5pRT
Copy link
Author

p5pRT commented Feb 14, 2018

From @jkeenan

On Tue, 13 Feb 2018 23​:07​:40 GMT, daver@​activestate.com wrote​:

This is a bug report for perl from daver@​activestate.com,
generated with the help of perlbug 1.40 running under perl 5.20.3.

-----------------------------------------------------------------
[Please describe your issue here]

File​::Copy​::copy() seems to expect that calling

open $fh, '<', '/dir' or ...

will fail. However, on HPUX this succeeds and reading from the
filehandle
returns a directory listing and some sort of binary data junk.

As far as I can tell from reading "perldoc -f open" and "perldoc perlopentut", what happens when you call "open $fh, '<', 'something'" when 'something' is a directory is pretty much undefined.

Hence, I would expect that when you call "copy $fh", you would get undefined behavior as well. Moreover, 'perldoc File​::Copy' specifically guides you away from attempting to copy from filehandles​:

#####
Note that passing in files as handles instead of names may lead to loss of information on some operating systems; it is recommended that you use file names whenever possible.
#####

Thank you very much.
--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Feb 14, 2018

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Feb 14, 2018

From @autarch

On Wed, 14 Feb 2018 06​:36​:13 -0800, jkeenan wrote​:

As far as I can tell from reading "perldoc -f open" and "perldoc
perlopentut", what happens when you call "open $fh, '<', 'something'"
when 'something' is a directory is pretty much undefined.

Right, which is why I think File​::Copy should check if the from parameter is directory.

Hence, I would expect that when you call "copy $fh", you would get
undefined behavior as well. Moreover, 'perldoc File​::Copy'
specifically guides you away from attempting to copy from filehandles​:

Which is not what my bug report was about. I'm talking about calling copy('/path/to/directory', 'foo')

@p5pRT
Copy link
Author

p5pRT commented Feb 14, 2018

From @jkeenan

On Wed, 14 Feb 2018 15​:24​:05 GMT, autarch wrote​:

On Wed, 14 Feb 2018 06​:36​:13 -0800, jkeenan wrote​:

As far as I can tell from reading "perldoc -f open" and "perldoc
perlopentut", what happens when you call "open $fh, '<', 'something'"
when 'something' is a directory is pretty much undefined.

Right, which is why I think File​::Copy should check if the from
parameter is directory.

Hence, I would expect that when you call "copy $fh", you would get
undefined behavior as well. Moreover, 'perldoc File​::Copy'
specifically guides you away from attempting to copy from
filehandles​:

Which is not what my bug report was about. I'm talking about calling
copy('/path/to/directory', 'foo')

In lib/File/Copy.pm, we have this code inside the definition of copy()​:

#####
sub copy {
  croak("Usage​: copy(FROM, TO [, BUFFERSIZE]) ")
  unless(@​_ == 2 || @​_ == 3);

  my $from = shift;
  my $to = shift;

  my $size;
  if (@​_) {
  $size = shift(@​_) + 0;
  croak("Bad buffer size for copy​: $size\n") unless ($size > 0);
  }

  my $from_a_handle = (ref($from)
  ? (ref($from) eq 'GLOB'
  || UNIVERSAL​::isa($from, 'GLOB')
  || UNIVERSAL​::isa($from, 'IO​::Handle'))
  : (ref(\$from) eq 'GLOB'));
...
#####

If the first argument to copy() is a filehandle (albeit one, in this circumstance, opened to a directory rather than a file), then $from_a_handle is Perl-true and $from, when dumped, is a GLOB reference like this​:

#####
GLOB(0x1ab84a0)
#####

... which, if fed to Data​::Dumper, dumps to this​:

#####
$VAR1 = \*{'​::$IN'};
#####

Am I correct in thinking that, to achieve what you want, we would need to determine the "target" of '​::$IN'? Is it possible to do that?

(Note​: Whatever we do about this, I think that, given the centrality of File​::Copy in the core distribution, we should not attempt to rush any change into perl-5.28.)

Thank you very much.
Jim Keenan

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Feb 14, 2018

From @autarch

On Wed, 14 Feb 2018 09​:17​:44 -0800, jkeenan wrote​:

In lib/File/Copy.pm, we have this code inside the definition of
copy()​:

#####
sub copy {
croak("Usage​: copy(FROM, TO [, BUFFERSIZE]) ")
unless(@​_ == 2 || @​_ == 3);

my $from = shift;
my $to = shift;

my $size;
if (@​_) {
$size = shift(@​_) + 0;
croak("Bad buffer size for copy​: $size\n") unless ($size > 0);
}

my $from_a_handle = (ref($from)
? (ref($from) eq 'GLOB'
|| UNIVERSAL​::isa($from, 'GLOB')
|| UNIVERSAL​::isa($from, 'IO​::Handle'))
: (ref(\$from) eq 'GLOB'));
...
#####

If the first argument to copy() is a filehandle (albeit one, in this
circumstance, opened to a directory rather than a file), then
$from_a_handle is Perl-true and $from, when dumped, is a GLOB
reference like this​:

#####
GLOB(0x1ab84a0)
#####

... which, if fed to Data​::Dumper, dumps to this​:

#####
$VAR1 = \*{'​::$IN'};
#####

Am I correct in thinking that, to achieve what you want, we would need
to determine the "target" of '​::$IN'? Is it possible to do that?

(Note​: Whatever we do about this, I think that, given the centrality
of File​::Copy in the core distribution, we should not attempt to rush
any change into perl-5.28.)

Obviously is File​::Copy is given a handle as the from param there's nothing to check.

Again, I'm talking about the case where the from parameter is a string and that strings refers to a directory. It seems like in that case it's worth bailing early and returning 0.

@p5pRT
Copy link
Author

p5pRT commented Feb 14, 2018

From @jkeenan

On Wed, 14 Feb 2018 17​:35​:29 GMT, autarch wrote​:

On Wed, 14 Feb 2018 09​:17​:44 -0800, jkeenan wrote​:

In lib/File/Copy.pm, we have this code inside the definition of
copy()​:

#####
sub copy {
croak("Usage​: copy(FROM, TO [, BUFFERSIZE]) ")
unless(@​_ == 2 || @​_ == 3);

my $from = shift;
my $to = shift;

my $size;
if (@​_) {
$size = shift(@​_) + 0;
croak("Bad buffer size for copy​: $size\n") unless ($size > 0);
}

my $from_a_handle = (ref($from)
? (ref($from) eq 'GLOB'
|| UNIVERSAL​::isa($from, 'GLOB')
|| UNIVERSAL​::isa($from, 'IO​::Handle'))
: (ref(\$from) eq 'GLOB'));
...
#####

If the first argument to copy() is a filehandle (albeit one, in this
circumstance, opened to a directory rather than a file), then
$from_a_handle is Perl-true and $from, when dumped, is a GLOB
reference like this​:

#####
GLOB(0x1ab84a0)
#####

... which, if fed to Data​::Dumper, dumps to this​:

#####
$VAR1 = \*{'​::$IN'};
#####

Am I correct in thinking that, to achieve what you want, we would
need
to determine the "target" of '​::$IN'? Is it possible to do that?

(Note​: Whatever we do about this, I think that, given the centrality
of File​::Copy in the core distribution, we should not attempt to rush
any change into perl-5.28.)

Obviously is File​::Copy is given a handle as the from param there's
nothing to check.

Again, I'm talking about the case where the from parameter is a string
and that strings refers to a directory. It seems like in that case
it's worth bailing early and returning 0.

I tried implementing the bare minimum for what I think you were requesting. See patch attached.

However, I got plenty of test failures. "Fixing" them implies revising long-held assumptions (perhaps implicit ones) about the behavior of copy(). I'm reluctant to proceed further.

#####
$ gitcurr
2nd-132866-file-copy
$ ./perl -Ilib lib/File/Copy.t
...
ok 410 - No croaking
not ok 411 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 412 - Exactly 1 warning
ok 413 - with the text we expect
ok 414 - copy plain object1
ok 415 - No croaking
not ok 416 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 417 - Exactly 1 warning
ok 418 - with the text we expect
ok 419 - copy plain object2
ok 420 - No croaking
not ok 421 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 422 - Exactly 1 warning
ok 423 - with the text we expect
ok 424 - copy object1 plain
ok 425 - No croaking
not ok 426 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 427 - Exactly 1 warning
ok 428 - with the text we expect
ok 429 - copy object1 object1
ok 430 - No croaking
not ok 431 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 432 - Exactly 1 warning
ok 433 - with the text we expect
ok 434 - copy object1 object2
ok 435 - No croaking
not ok 436 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 437 - Exactly 1 warning
ok 438 - with the text we expect
ok 439 - copy object2 plain
ok 440 - No croaking
not ok 441 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 442 - Exactly 1 warning
ok 443 - with the text we expect
ok 444 - copy object2 object1
ok 445 - No croaking
not ok 446 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 447 - Exactly 1 warning
ok 448 - with the text we expect
ok 449 - copy object2 object2
ok 450 - No croaking
not ok 451 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 452 - Exactly 1 warning
ok 453 - with the text we expect
...
# Looks like you failed 9 tests of 466.
#####

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Feb 14, 2018

From @jkeenan

0001-Prevent-first-argument-to-copy-from-being-a-director.patch
From 1b332897594260fa49a8b2a549912ca244919c6b Mon Sep 17 00:00:00 2001
From: James E Keenan <jkeenan@cpan.org>
Date: Wed, 14 Feb 2018 15:04:21 -0500
Subject: [PATCH] Prevent first argument to copy() from being a directory.

Per suggestion by Dave Rolsky in RT #132866.

But test failures suggest we need more thought about this.
---
 lib/File/Copy.pm | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index b796451..2b4b0099 100644
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -24,7 +24,7 @@ sub syscopy;
 sub cp;
 sub mv;
 
-$VERSION = '2.33';
+$VERSION = '2.34';
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -84,6 +84,9 @@ sub copy {
 			    || UNIVERSAL::isa($from, 'GLOB')
                             || UNIVERSAL::isa($from, 'IO::Handle'))
 			 : (ref(\$from) eq 'GLOB'));
+    if (! $from_a_handle and -d $from) {
+        croak "First argument to copy() must be file or filehandle, not a directory";
+    }
     my $to_a_handle =   (ref($to)
 			 ? (ref($to) eq 'GLOB'
 			    || UNIVERSAL::isa($to, 'GLOB')
-- 
2.7.4

@p5pRT
Copy link
Author

p5pRT commented Feb 14, 2018

From @autarch

On Wed, 14 Feb 2018 12​:07​:11 -0800, jkeenan wrote​:

On Wed, 14 Feb 2018 17​:35​:29 GMT, autarch wrote​:

On Wed, 14 Feb 2018 09​:17​:44 -0800, jkeenan wrote​:

In lib/File/Copy.pm, we have this code inside the definition of
copy()​:

#####
sub copy {
croak("Usage​: copy(FROM, TO [, BUFFERSIZE]) ")
unless(@​_ == 2 || @​_ == 3);

my $from = shift;
my $to = shift;

my $size;
if (@​_) {
$size = shift(@​_) + 0;
croak("Bad buffer size for copy​: $size\n") unless ($size > 0);
}

my $from_a_handle = (ref($from)
? (ref($from) eq 'GLOB'
|| UNIVERSAL​::isa($from, 'GLOB')
|| UNIVERSAL​::isa($from, 'IO​::Handle'))
: (ref(\$from) eq 'GLOB'));
...
#####

If the first argument to copy() is a filehandle (albeit one, in
this
circumstance, opened to a directory rather than a file), then
$from_a_handle is Perl-true and $from, when dumped, is a GLOB
reference like this​:

#####
GLOB(0x1ab84a0)
#####

... which, if fed to Data​::Dumper, dumps to this​:

#####
$VAR1 = \*{'​::$IN'};
#####

Am I correct in thinking that, to achieve what you want, we would
need
to determine the "target" of '​::$IN'? Is it possible to do that?

(Note​: Whatever we do about this, I think that, given the
centrality
of File​::Copy in the core distribution, we should not attempt to
rush
any change into perl-5.28.)

Obviously is File​::Copy is given a handle as the from param there's
nothing to check.

Again, I'm talking about the case where the from parameter is a
string
and that strings refers to a directory. It seems like in that case
it's worth bailing early and returning 0.

I tried implementing the bare minimum for what I think you were
requesting. See patch attached.

However, I got plenty of test failures. "Fixing" them implies
revising long-held assumptions (perhaps implicit ones) about the
behavior of copy(). I'm reluctant to proceed further.

#####
$ gitcurr
2nd-132866-file-copy
$ ./perl -Ilib lib/File/Copy.t
...
ok 410 - No croaking
not ok 411 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 412 - Exactly 1 warning
ok 413 - with the text we expect
ok 414 - copy plain object1
ok 415 - No croaking
not ok 416 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 417 - Exactly 1 warning
ok 418 - with the text we expect
ok 419 - copy plain object2
ok 420 - No croaking
not ok 421 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 422 - Exactly 1 warning
ok 423 - with the text we expect
ok 424 - copy object1 plain
ok 425 - No croaking
not ok 426 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 427 - Exactly 1 warning
ok 428 - with the text we expect
ok 429 - copy object1 object1
ok 430 - No croaking
not ok 431 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 432 - Exactly 1 warning
ok 433 - with the text we expect
ok 434 - copy object1 object2
ok 435 - No croaking
not ok 436 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 437 - Exactly 1 warning
ok 438 - with the text we expect
ok 439 - copy object2 plain
ok 440 - No croaking
not ok 441 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 442 - Exactly 1 warning
ok 443 - with the text we expect
ok 444 - copy object2 object1
ok 445 - No croaking
not ok 446 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 447 - Exactly 1 warning
ok 448 - with the text we expect
ok 449 - copy object2 object2
ok 450 - No croaking
not ok 451 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 452 - Exactly 1 warning
ok 453 - with the text we expect
...
# Looks like you failed 9 tests of 466.
#####

Thank you very much.

copy() mostly calls carp() and then returns 0.

I think the current code relies on open() returning false when given a directory​:

  open $from_h, "<", $from or goto fail_open1;

@p5pRT
Copy link
Author

p5pRT commented Feb 15, 2018

From @tonycoz

On Wed, 14 Feb 2018 12​:07​:11 -0800, jkeenan wrote​:

However, I got plenty of test failures. "Fixing" them implies
revising long-held assumptions (perhaps implicit ones) about the
behavior of copy(). I'm reluctant to proceed further.

#####
$ gitcurr
2nd-132866-file-copy
$ ./perl -Ilib lib/File/Copy.t
...
ok 410 - No croaking
not ok 411 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 412 - Exactly 1 warning

The problem is -d can modify $!, if that's preserved the tests pass​:

tony@​mars​:.../git/perl$ git diff

Inline Patch
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index b796451e37..265636af60 100644
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -89,7 +89,9 @@ sub copy {
                            || UNIVERSAL::isa($to, 'GLOB')
                             || UNIVERSAL::isa($to, 'IO::Handle'))
                         : (ref(\$to) eq 'GLOB'));
-
+    if (! $from_a_handle and do { local $!; -d $from }) {
+        croak "First argument to copy() must be file or filehandle, not a directory";
+    }
     if (_eq($from, $to)) { # works for references, too
        carp("'$from' and '$to' are identical (not copied)");
         return 0;

tony@mars:.../perl/t$ ./perl harness ../lib/File/Copy.t \.\./lib/File/Copy\.t \.\. ok All tests successful\. Files=1\, Tests=466\, 1 wallclock secs \( 0\.04 usr 0\.01 sys \+ 0\.22 cusr 0\.03 csys = 0\.30 CPU\) Result​: PASS

though perhaps the local should be in a block to make the code less esoteric.

(and the general change probably needs tests)

Tony

@p5pRT
Copy link
Author

p5pRT commented Mar 7, 2018

From @tonycoz

On Wed, 14 Feb 2018 16​:10​:31 -0800, tonyc wrote​:

On Wed, 14 Feb 2018 12​:07​:11 -0800, jkeenan wrote​:

However, I got plenty of test failures. "Fixing" them implies
revising long-held assumptions (perhaps implicit ones) about the
behavior of copy(). I'm reluctant to proceed further.

#####
$ gitcurr
2nd-132866-file-copy
$ ./perl -Ilib lib/File/Copy.t
...
ok 410 - No croaking
not ok 411 - No system call errors
# Failed test 'No system call errors'
# at lib/File/Copy.t line 424.
# got​: 'No such file or directory'
# expected​: ''
ok 412 - Exactly 1 warning

The problem is -d can modify $!, if that's preserved the tests pass​:

tony@​mars​:.../git/perl$ git diff
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index b796451e37..265636af60 100644
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@​@​ -89,7 +89,9 @​@​ sub copy {
|| UNIVERSAL​::isa($to, 'GLOB')
|| UNIVERSAL​::isa($to, 'IO​::Handle'))
: (ref(\$to) eq 'GLOB'));
-
+ if (! $from_a_handle and do { local $!; -d $from }) {
+ croak "First argument to copy() must be file or filehandle,
not a directory";
+ }
if (_eq($from, $to)) { # works for references, too
carp("'$from' and '$to' are identical (not copied)");
return 0;

tony@​mars​:.../perl/t$ ./perl harness ../lib/File/Copy.t
../lib/File/Copy.t .. ok
All tests successful.
Files=1, Tests=466, 1 wallclock secs ( 0.04 usr 0.01 sys + 0.22
cusr 0.03 csys = 0.30 CPU)
Result​: PASS

though perhaps the local should be in a block to make the code less
esoteric.

(and the general change probably needs tests)

Thinking about it, I'm not sure the test is correct.

It was added as part of e55c0a8, presumably the extra tests Nicholas mentioned in https://rt-archive.perl.org/perl5/Ticket/Display.html?id=48078#txn-485730

The File​::Copy documentation doesn't say anything about the value of $! on success.

Tony

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

2 participants