[commit: packages/directory] master: Add tests for long path support (b580ff4)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/b580ff43d570595a155b67964b882ef02c3f491f/directory

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

commit b580ff43d570595a155b67964b882ef02c3f491f
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Mon Mar 6 02:05:12 2017 -0500

    Add tests for long path support


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

b580ff43d570595a155b67964b882ef02c3f491f
 directory.cabal    |  1 +
 tests/LongPaths.hs | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 tests/Main.hs      |  2 ++
 3 files changed, 56 insertions(+)

diff --git a/directory.cabal b/directory.cabal
index 6847b71..c1df9af 100644
--- a/directory.cabal
+++ b/directory.cabal
@@ -98,6 +98,7 @@ test-suite test
         GetFileSize
         GetHomeDirectory001
         GetPermissions001
+        LongPaths
         MakeAbsolute
         PathIsSymbolicLink
         RemoveDirectoryRecursive001
diff --git a/tests/LongPaths.hs b/tests/LongPaths.hs
new file mode 100644
index 0000000..cfec3ee
--- /dev/null
+++ b/tests/LongPaths.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE CPP #-}
+module LongPaths where
+#include "util.inl"
+import TestUtils
+import System.FilePath ((</>))
+
+main :: TestEnv -> IO ()
+main _t = do
+  let longName = mconcat (replicate 5 "thisisaverylongdirectoryname")
+  longDir <- makeAbsolute (longName </> longName)
+
+  supportsLongPaths <- do
+      -- create 2 dirs because 1 path segment by itself can't exceed MAX_PATH
+      -- tests: [createDirectory]
+      createDirectory =<< makeAbsolute longName
+      createDirectory longDir
+      return True
+    `catchIOError` \ _ ->
+      return False
+
+  -- skip tests on file systems that do not support long paths
+  when supportsLongPaths $ do
+
+    writeFile "foobar.txt" "^.^" -- writeFile does not support long paths yet
+
+    -- tests: [renamePath], [copyFileWithMetadata]
+    renamePath "foobar.txt" (longDir </> "foobar_tmp.txt")
+    renamePath (longDir </> "foobar_tmp.txt") (longDir </> "foobar.txt")
+    copyFileWithMetadata (longDir </> "foobar.txt")
+                         (longDir </> "foobar_copy.txt")
+
+    -- tests: [doesDirectoryExist], [doesFileExist], [doesPathExist]
+    T(expect) () =<< doesDirectoryExist longDir
+    T(expect) () =<< doesFileExist (longDir </> "foobar.txt")
+    T(expect) () =<< doesPathExist longDir
+    T(expect) () =<< doesPathExist (longDir </> "foobar.txt")
+
+    -- tests: [getFileSize], [getModificationTime]
+    T(expectEq) () 3 =<< getFileSize (longDir </> "foobar.txt")
+    _ <- getModificationTime (longDir </> "foobar.txt")
+
+    supportsSymbolicLinks <- supportsSymlinks
+    when supportsSymbolicLinks $ do
+
+      -- tests: [createDirectoryLink], [getSymbolicLinkTarget]
+      -- also tests expansion of "." and ".."
+      createDirectoryLink "." (longDir </> "link")
+      _ <- listDirectory (longDir </> ".." </> longName </> "link")
+      T(expectEq) () "." =<< getSymbolicLinkTarget (longDir </> "." </> "link")
+
+      return ()
+
+  -- [removeFile], [removeDirectory] are automatically tested by the cleanup
diff --git a/tests/Main.hs b/tests/Main.hs
index 1e17b68..52cf0fb 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -17,6 +17,7 @@ import qualified GetDirContents002
 import qualified GetFileSize
 import qualified GetHomeDirectory001
 import qualified GetPermissions001
+import qualified LongPaths
 import qualified MakeAbsolute
 import qualified PathIsSymbolicLink
 import qualified RemoveDirectoryRecursive001
@@ -47,6 +48,7 @@ main = T.testMain $ \ _t -> do
   T.isolatedRun _t "GetFileSize" GetFileSize.main
   T.isolatedRun _t "GetHomeDirectory001" GetHomeDirectory001.main
   T.isolatedRun _t "GetPermissions001" GetPermissions001.main
+  T.isolatedRun _t "LongPaths" LongPaths.main
   T.isolatedRun _t "MakeAbsolute" MakeAbsolute.main
   T.isolatedRun _t "PathIsSymbolicLink" PathIsSymbolicLink.main
   T.isolatedRun _t "RemoveDirectoryRecursive001" RemoveDirectoryRecursive001.main