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].

diff --git a/MANIFEST b/MANIFEST
index c702237..e69efd8 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3632,6 +3632,7 @@ dist/PathTools/Makefile.PL                        makefile writer for Cwd
 dist/PathTools/t/abs2rel.t             See if File::Spec->abs2rel works
 dist/PathTools/t/crossplatform.t               See if File::Spec works crossplatform
 dist/PathTools/t/cwd.t                 See if Cwd works
+dist/PathTools/t/cwd_enoent.t                  See if getcwd errors correctly
 dist/PathTools/t/Functions.t                   See if File::Spec::Functions works
 dist/PathTools/t/rel2abs2rel.t         See if File::Spec->rel2abs/abs2rel works
 dist/PathTools/t/Spec.t                        See if File::Spec works

diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm
index 1f94997..d6c65e9 100644 (file)
--- 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 5a53413..ca90b9e 100644 (file)
--- 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 63a9050..a9bdefc 100644 (file)
--- 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 955af23..e0b9abb 100644 (file)
--- 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 0e58185..dba67a7 100644 (file)
--- 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 6e3e6d3..ad0f1f4 100644 (file)
--- 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 ed30f1a..105c2b7 100644 (file)
--- 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 f2a05f6..c57cfd8 100644 (file)
--- 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 f2412e1..ff140a6 100644 (file)
--- 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 e67ff8e..2ed7e0c 100644 (file)
--- 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 d9693ff..708a238 100644 (file)
--- 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 (file)
index 0000000..59e3612
--- /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;