diff options
author | Zefram <zefram@fysh.org> | 2017-12-24 11:09:54 +0000 |
---|---|---|
committer | Zefram <zefram@fysh.org> | 2017-12-24 11:09:54 +0000 |
commit | d2e38af7de734aa1e317de7166c6995e432e2f30 (patch) | |
tree | 8b86a58283f68240c1a396dc803ba2c8f466e11e /dist/PathTools | |
parent | e7e8ce8540f1612023d46e27e60ff002d8ab5dd7 (diff) | |
download | perl-d2e38af7de734aa1e317de7166c6995e432e2f30.tar.gz |
correct error returns from _perl_abs_path()
The perl implementation of abs_path(), and hence of getcwd(), was
returning an empty string on error, and sending a diagnostic to stderr.
The diagnostic for failing to find a directory in its parent included a
bogus $! value. This differed from the XS version, which returns undef
with $! set appropriately. The documentation, not explicit on the topic,
suggests that errors should be signalled more like what the XS was doing.
Resolve the discrepancy by changing the perl implementation to signal
errors by returning undef with $! set appropriately. Document getcwd()
and abs_path() as doing this.
Fixes [perl #132648].
Diffstat (limited to 'dist/PathTools')
-rw-r--r-- | dist/PathTools/Cwd.pm | 21 | ||||
-rw-r--r-- | dist/PathTools/lib/File/Spec.pm | 2 | ||||
-rw-r--r-- | dist/PathTools/lib/File/Spec/AmigaOS.pm | 2 | ||||
-rw-r--r-- | dist/PathTools/lib/File/Spec/Cygwin.pm | 2 | ||||
-rw-r--r-- | dist/PathTools/lib/File/Spec/Epoc.pm | 2 | ||||
-rw-r--r-- | dist/PathTools/lib/File/Spec/Functions.pm | 2 | ||||
-rw-r--r-- | dist/PathTools/lib/File/Spec/Mac.pm | 2 | ||||
-rw-r--r-- | dist/PathTools/lib/File/Spec/OS2.pm | 2 | ||||
-rw-r--r-- | dist/PathTools/lib/File/Spec/Unix.pm | 2 | ||||
-rw-r--r-- | dist/PathTools/lib/File/Spec/VMS.pm | 2 | ||||
-rw-r--r-- | dist/PathTools/lib/File/Spec/Win32.pm | 2 | ||||
-rw-r--r-- | dist/PathTools/t/cwd_enoent.t | 42 |
12 files changed, 64 insertions, 19 deletions
diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm index 1f94997c7e..d6c65e9d3a 100644 --- a/dist/PathTools/Cwd.pm +++ b/dist/PathTools/Cwd.pm @@ -3,7 +3,7 @@ use strict; use Exporter; -our $VERSION = '3.71'; +our $VERSION = '3.72'; my $xs_version = $VERSION; $VERSION =~ tr/_//d; @@ -387,8 +387,7 @@ sub _perl_abs_path unless (@cst = stat( $start )) { - _carp("stat($start): $!"); - return ''; + return undef; } unless (-d _) { @@ -428,9 +427,10 @@ sub _perl_abs_path } unless (@cst = stat($dotdots)) { - _carp("stat($dotdots): $!"); + my $e = $!; closedir(PARENT); - return ''; + $! = $e; + return undef; } if ($pst[0] == $cst[0] && $pst[1] == $cst[1]) { @@ -442,9 +442,10 @@ sub _perl_abs_path { unless (defined ($dir = readdir(PARENT))) { - _carp("readdir($dotdots): $!"); closedir(PARENT); - return ''; + require Errno; + $! = Errno::ENOENT(); + return undef; } $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir")) } @@ -701,7 +702,8 @@ absolute path of the current working directory. my $cwd = getcwd(); -Returns the current working directory. +Returns the current working directory. On error returns C<undef>, +with C<$!> set to indicate the error. Exposes the POSIX function getcwd(3) or re-implements it if it's not available. @@ -764,7 +766,8 @@ given they'll use the current working directory. Uses the same algorithm as getcwd(). Symbolic links and relative-path components ("." and "..") are resolved to return the canonical -pathname, just like realpath(3). +pathname, just like realpath(3). On error returns C<undef>, with C<$!> +set to indicate the error. =item realpath diff --git a/dist/PathTools/lib/File/Spec.pm b/dist/PathTools/lib/File/Spec.pm index 5a53413124..ca90b9e610 100644 --- a/dist/PathTools/lib/File/Spec.pm +++ b/dist/PathTools/lib/File/Spec.pm @@ -2,7 +2,7 @@ package File::Spec; use strict; -our $VERSION = '3.71'; +our $VERSION = '3.72'; $VERSION =~ tr/_//d; my %module = ( diff --git a/dist/PathTools/lib/File/Spec/AmigaOS.pm b/dist/PathTools/lib/File/Spec/AmigaOS.pm index 63a9050ee3..a9bdefc9fa 100644 --- a/dist/PathTools/lib/File/Spec/AmigaOS.pm +++ b/dist/PathTools/lib/File/Spec/AmigaOS.pm @@ -3,7 +3,7 @@ package File::Spec::AmigaOS; use strict; require File::Spec::Unix; -our $VERSION = '3.71'; +our $VERSION = '3.72'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Cygwin.pm b/dist/PathTools/lib/File/Spec/Cygwin.pm index 955af23b2e..e0b9abb4f3 100644 --- a/dist/PathTools/lib/File/Spec/Cygwin.pm +++ b/dist/PathTools/lib/File/Spec/Cygwin.pm @@ -3,7 +3,7 @@ package File::Spec::Cygwin; use strict; require File::Spec::Unix; -our $VERSION = '3.71'; +our $VERSION = '3.72'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Epoc.pm b/dist/PathTools/lib/File/Spec/Epoc.pm index 0e581852a6..dba67a781e 100644 --- a/dist/PathTools/lib/File/Spec/Epoc.pm +++ b/dist/PathTools/lib/File/Spec/Epoc.pm @@ -2,7 +2,7 @@ package File::Spec::Epoc; use strict; -our $VERSION = '3.71'; +our $VERSION = '3.72'; $VERSION =~ tr/_//d; require File::Spec::Unix; diff --git a/dist/PathTools/lib/File/Spec/Functions.pm b/dist/PathTools/lib/File/Spec/Functions.pm index 6e3e6d3e63..ad0f1f4261 100644 --- a/dist/PathTools/lib/File/Spec/Functions.pm +++ b/dist/PathTools/lib/File/Spec/Functions.pm @@ -3,7 +3,7 @@ package File::Spec::Functions; use File::Spec; use strict; -our $VERSION = '3.71'; +our $VERSION = '3.72'; $VERSION =~ tr/_//d; require Exporter; diff --git a/dist/PathTools/lib/File/Spec/Mac.pm b/dist/PathTools/lib/File/Spec/Mac.pm index ed30f1aa85..105c2b7708 100644 --- a/dist/PathTools/lib/File/Spec/Mac.pm +++ b/dist/PathTools/lib/File/Spec/Mac.pm @@ -4,7 +4,7 @@ use strict; use Cwd (); require File::Spec::Unix; -our $VERSION = '3.71'; +our $VERSION = '3.72'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/OS2.pm b/dist/PathTools/lib/File/Spec/OS2.pm index f2a05f6279..c57cfd88e3 100644 --- a/dist/PathTools/lib/File/Spec/OS2.pm +++ b/dist/PathTools/lib/File/Spec/OS2.pm @@ -4,7 +4,7 @@ use strict; use Cwd (); require File::Spec::Unix; -our $VERSION = '3.71'; +our $VERSION = '3.72'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Unix.pm b/dist/PathTools/lib/File/Spec/Unix.pm index f2412e1c44..ff140a62e1 100644 --- a/dist/PathTools/lib/File/Spec/Unix.pm +++ b/dist/PathTools/lib/File/Spec/Unix.pm @@ -3,7 +3,7 @@ package File::Spec::Unix; use strict; use Cwd (); -our $VERSION = '3.71'; +our $VERSION = '3.72'; $VERSION =~ tr/_//d; =head1 NAME diff --git a/dist/PathTools/lib/File/Spec/VMS.pm b/dist/PathTools/lib/File/Spec/VMS.pm index e67ff8efe6..2ed7e0c2e1 100644 --- a/dist/PathTools/lib/File/Spec/VMS.pm +++ b/dist/PathTools/lib/File/Spec/VMS.pm @@ -4,7 +4,7 @@ use strict; use Cwd (); require File::Spec::Unix; -our $VERSION = '3.71'; +our $VERSION = '3.72'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Win32.pm b/dist/PathTools/lib/File/Spec/Win32.pm index d9693ff65d..708a238371 100644 --- a/dist/PathTools/lib/File/Spec/Win32.pm +++ b/dist/PathTools/lib/File/Spec/Win32.pm @@ -5,7 +5,7 @@ use strict; use Cwd (); require File::Spec::Unix; -our $VERSION = '3.71'; +our $VERSION = '3.72'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/t/cwd_enoent.t b/dist/PathTools/t/cwd_enoent.t new file mode 100644 index 0000000000..59e3612568 --- /dev/null +++ b/dist/PathTools/t/cwd_enoent.t @@ -0,0 +1,42 @@ +use warnings; +use strict; + +use Config; +use Errno qw(ENOENT); +use File::Temp qw(tempdir); +use Test::More; + +my $tmp = tempdir(CLEANUP => 1); +unless(mkdir("$tmp/testdir") && chdir("$tmp/testdir") && rmdir("$tmp/testdir")){ + plan skip_all => "can't be in non-existent directory"; +} + +plan tests => 8; +my $EXTRA_ABSPATH_TESTS = ($Config{prefix} =~ m/\//) && $^O ne 'cygwin'; +require Cwd; + +foreach my $type (qw(regular perl)) { + SKIP: { + skip "_perl_abs_path() not expected to work", 4 + if $type eq "perl" && + !(($Config{prefix} =~ m/\//) && $^O ne "cygwin"); + no warnings "redefine"; + local *Cwd::abs_path = \&Cwd::_perl_abs_path if $type eq "perl"; + local *Cwd::getcwd = \&Cwd::_perl_getcwd if $type eq "perl"; + my($res, $eno); + $! = 0; + $res = Cwd::getcwd(); + $eno = 0+$!; + is $res, undef, "$type getcwd result on non-existent directory"; + is $eno, ENOENT, "$type getcwd errno on non-existent directory"; + $! = 0; + $res = Cwd::abs_path("."); + $eno = 0+$!; + is $res, undef, "$type abs_path result on non-existent directory"; + is $eno, ENOENT, "$type abs_path errno on non-existent directory"; + } +} + +chdir $tmp or die "$tmp: $!"; + +1; |