Subject: | Comparing cwd is not safe |
Comparing directories between File::Spec and Cwd is not safe because they may use different methods of determining the Cwd depending on version and phase of the moon. If the directory is under a symlink you may get different results. If the build directory of Path::Class is under a symlink (like /tmp on OS X and many systems) the test will fail.
not ok 41
Show quoted text
The most cross-platform way to resolve this is to walk the path and resolve any symlinks. The attached patch puts code into the tests to do this. This would probably be a handy Path::Class method given that its nontrivial to do correctly. $path->resolve_symlinks()?
not ok 41
Show quoted text
# Test 41 got: "/private/tmp/build/Path-Class" (t/01-basic.t at line 82)
# Expected: "/tmp/build/Path-Class"
# t/01-basic.t line 82 is: ok dir()->absolute, dir(Cwd::cwd())->cleanup;
# Expected: "/tmp/build/Path-Class"
# t/01-basic.t line 82 is: ok dir()->absolute, dir(Cwd::cwd())->cleanup;
The most cross-platform way to resolve this is to walk the path and resolve any symlinks. The attached patch puts code into the tests to do this. This would probably be a handy Path::Class method given that its nontrivial to do correctly. $path->resolve_symlinks()?
Subject: | 0001-Safely-compare-directoires-under-symlinks.patch |
From 4a01baaa4554e176977bc7bf0a434ba310d86da3 Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Sun, 27 Dec 2009 17:05:54 -0800
Subject: [PATCH] Safely compare directoires under symlinks.
---
t/01-basic.t | 35 ++++++++++++++++++++++++++++++++++-
1 files changed, 34 insertions(+), 1 deletions(-)
diff --git a/t/01-basic.t b/t/01-basic.t
index 68fb337..15bbec5 100644
--- a/t/01-basic.t
+++ b/t/01-basic.t
@@ -7,6 +7,39 @@ use strict;
use Path::Class;
use Cwd;
+# File::Spec and Cwd might return different values for a
+# symlinked directory, so we need to be careful.
+sub paths_are_same {
+ my($have, $want, $name) = @_;
+
+ $have = _resolve_symlinks($have);
+ $want = _resolve_symlinks($want);
+
+ ok( $have, $want, $name );
+}
+
+# Resolve any symlinks in a path
+sub _resolve_symlinks {
+ my $path = shift;
+ my($vol, $dirs, $file) = File::Spec->splitpath($path);
+
+ my $resolved = File::Spec->catpath( $vol, "", "" );
+
+ for my $dir (File::Spec->splitdir($dirs)) {
+ # Resolve the next part of the path
+ my $next = File::Spec->catdir( $resolved, $dir );
+ $next = eval { readlink $next } || $next;
+
+ # If its absolute, use it.
+ # Otherwise tack it onto the end of the previous path.
+ $resolved = File::Spec->file_name_is_absolute($next)
+ ? $next
+ : File::Spec->catdir( $resolved, $next );
+ }
+
+ return File::Spec->catfile($resolved, $file);
+}
+
plan tests => 66;
ok(1);
@@ -79,7 +112,7 @@ ok $file->parent, '/foo/baz';
ok dir(''), '/';
ok dir(), '.';
ok dir('', 'var', 'tmp'), '/var/tmp';
- ok dir()->absolute, dir(Cwd::cwd())->cleanup;
+ paths_are_same( dir()->absolute, dir(Cwd::cwd())->cleanup );
ok dir(undef), undef;
}
--
1.6.5.3