[commit: packages/directory] Mistuke-bump-win32-version-bounds, bgamari-patch-1, master: canonicalizePath: Deref file symlinks even if not last segment (c2e17be)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/directory

On branches: Mistuke-bump-win32-version-bounds,bgamari-patch-1,master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c2e17befd6afc7bcddc460776004b9f602fe1ee4/directory

>---------------------------------------------------------------

commit c2e17befd6afc7bcddc460776004b9f602fe1ee4
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Tue Dec 6 06:55:02 2016 -0500

    canonicalizePath: Deref file symlinks even if not last segment
    
    Due to the use of splitPath instead of splitDirectories, this means that
    if a symbolic link segment in the middle of the path points to a file,
    doesPathExist will report that it does not exist, thus the symbolic link
    will not be dereferenced.  The behavior is now changed to dereference as
    much as possible.


>---------------------------------------------------------------

c2e17befd6afc7bcddc460776004b9f602fe1ee4
 System/Directory.hs       | 11 +++++++----
 changelog.md              |  3 +++
 tests/CanonicalizePath.hs | 28 ++++++++++++++++++++++++++++
 3 files changed, 38 insertions(+), 4 deletions(-)

diff --git a/System/Directory.hs b/System/Directory.hs
index 7dc9435..11cd56a 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -994,14 +994,17 @@ copyFileTimesFromStatus st dst = do
 -- current directory.  The function drops trailing path separators where
 -- possible (via 'dropTrailingPathSeparator').
 --
--- /Known bug(s)/: on Windows, the function does not resolve symbolic links
--- and the letter case of filenames is not canonicalized.
+-- /Known bugs/: When the path contains an existing symbolic link, but the
+-- target of the link does not exist, then the path is not dereferenced (bug
+-- #64).  On Windows, the function does not resolve symbolic links and the
+-- letter case of filenames is not canonicalized.
 --
 -- /Changes since 1.2.3.0:/ The function has been altered to be more robust
 -- and has the same exception behavior as 'makeAbsolute'.
 --
 -- /Changes since 1.3.0.0:/ The function no longer preserves the trailing path
--- separator.
+-- separator.  File symbolic links that appear in the middle of a path are
+-- properly dereferenced.
 --
 canonicalizePath :: FilePath -> IO FilePath
 canonicalizePath = \ path ->
@@ -1018,7 +1021,7 @@ canonicalizePath = \ path ->
     transform path = do
       encoding <- getFileSystemEncoding
       realpathPrefix encoding (reverse (zip prefixes suffixes)) path
-      where segments = splitPath path
+      where segments = splitDirectories path
             prefixes = scanl1 (</>) segments
             suffixes = tail (scanr (</>) "" segments)
 
diff --git a/changelog.md b/changelog.md
index 823f225..ba288fa 100644
--- a/changelog.md
+++ b/changelog.md
@@ -10,6 +10,9 @@ Changelog for the [`directory`][1] package
     available but may be removed in the next major release.
     ([#52](https://github.com/haskell/directory/issues/52))
 
+  * Changed `canonicalizePath` to dereference symbolic links even if it points
+    to a file and is not the last path segment
+
 ## 1.2.7.1 (November 2016)
 
   * Don't abort `removePathForcibly` if files or directories go missing.
diff --git a/tests/CanonicalizePath.hs b/tests/CanonicalizePath.hs
index 895fa49..0f3ea2e 100644
--- a/tests/CanonicalizePath.hs
+++ b/tests/CanonicalizePath.hs
@@ -2,6 +2,7 @@
 module CanonicalizePath where
 #include "util.inl"
 import System.FilePath ((</>), dropTrailingPathSeparator, normalise)
+import TestUtils
 
 main :: TestEnv -> IO ()
 main _t = do
@@ -61,3 +62,30 @@ main _t = do
   T(expectEq) () fooNon fooNon6
   T(expectEq) () fooNon fooNon7
   T(expectEq) () fooNon fooNon8
+
+  supportsSymbolicLinks <- do
+#ifdef mingw32_HOST_OS
+    -- FIXME: canonicalizePath doesn't yet support symlinks on Windows
+    pure False
+#else
+    pure True
+#endif
+
+  when supportsSymbolicLinks $ do
+
+    let barQux = dot </> "bar" </> "qux"
+
+    createSymbolicLink "../bar" "foo/bar"
+    T(expectEq) () bar =<< canonicalizePath "foo/bar"
+    T(expectEq) () barQux =<< canonicalizePath "foo/bar/qux"
+
+    createSymbolicLink "foo" "lfoo"
+    T(expectEq) () foo =<< canonicalizePath "lfoo"
+    T(expectEq) () foo =<< canonicalizePath "lfoo/"
+    T(expectEq) () bar =<< canonicalizePath "lfoo/bar"
+    T(expectEq) () barQux =<< canonicalizePath "lfoo/bar/qux"
+
+    -- FIXME: uncomment this test once #64 is fixed
+    -- createSymbolicLink "../foo/non-existent" "foo/qux"
+    -- qux <- canonicalizePath "foo/qux"
+    -- T(expectEq) () qux (dot </> "../foo/non-existent")