Subject: | [PATCH] _perl_abs_path doesn't handle the case of a non-existent file in an existing dir |
As can be seen here:
http://www.nntp.perl.org/group/perl.cpan.testers/2008/09/msg2204098.html
There's an incompatibility between the XS abs_path() and
_perl_abs_path(): if one references a non-existent filename of an
existing directory, then the XS abs_path will return a correct results
and _perl_abs_path will warn and return nothing.
This patch adds a testcase for the problem, and patches Cwd.pm to fix
it.
Regards,
-- Shlomi Fish
Subject: | non-exist-file.patch |
--- ./t/cwd.t.orig 2008-09-14 10:34:33.618286763 +0300
+++ ./t/cwd.t 2008-09-14 10:50:34.037037599 +0300
@@ -18,11 +18,11 @@
use Test::More;
require VMS::Filespec if $^O eq 'VMS';
-my $tests = 30;
+my $tests = 31;
# _perl_abs_path() currently only works when the directory separator
# is '/', so don't test it when it won't work.
my $EXTRA_ABSPATH_TESTS = ($Config{prefix} =~ m/\//) && $^O ne 'cygwin';
-$tests += 4 if $EXTRA_ABSPATH_TESTS;
+$tests += 5 if $EXTRA_ABSPATH_TESTS;
plan tests => $tests;
SKIP: {
@@ -197,7 +197,27 @@
path_ends_with(Cwd::_perl_abs_path($path), 'cwd.t', '_perl_abs_path() can be invoked on a file')
if $EXTRA_ABSPATH_TESTS;
+{
+ mkdir("existing-dir", 0777);
+ my $path = File::Spec->catfile(
+ File::Spec->curdir(), 'existing-dir', "non-existent-file.txt"
+ );
+ path_ends_with(
+ Cwd::abs_path($path),
+ 'non-existent-file.txt',
+ 'abs_path() can be invoked on a non-exist file in an existing dir'
+ );
+ if ($EXTRA_ABSPATH_TESTS)
+ {
+ path_ends_with(
+ Cwd::_perl_abs_path($path),
+ 'non-existent-file.txt',
+ '_perl_abs_path() can be invoked on a non-exist file in an existing dir'
+ );
+ }
+ rmdir("existing-dir");
+}
SKIP: {
my $file;
--- ./Cwd.pm.orig 2008-09-14 10:49:27.443037749 +0300
+++ ./Cwd.pm 2008-09-14 11:08:21.863636314 +0300
@@ -502,19 +502,26 @@
sub _perl_abs_path
{
my $start = @_ ? shift : '.';
- my($dotdots, $cwd, @pst, @cst, $dir, @tst);
+ my($dotdots, $cwd, @pst, @cst, $dir, @tst, $file);
unless (@cst = stat( $start ))
{
- _carp("stat($start): $!");
+ my $err = $!;
+ # Check for a non-existent file inside an existing directory.
+ if (($dir, $file) = $start =~ m{^(.*)/(.+)$}) {
+ if (-d $dir) {
+ return abs_path($dir) . "/$file";
+ }
+ }
+ _carp("stat($start): $err");
return '';
}
unless (-d _) {
# Make sure we can be invoked on plain files, not just directories.
# NOTE that this routine assumes that '/' is the only directory separator.
-
- my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
+
+ ($dir, $file) = $start =~ m{^(.*)/(.+)$}
or return cwd() . '/' . $start;
# Can't use "-l _" here, because the previous stat was a stat(), not an lstat().