1{-# LANGUAGE CPP #-}
2module LongPaths where
3#include "util.inl"
4import TestUtils
5import System.FilePath ((</>))
6
7main :: TestEnv -> IO ()
8main _t = do
9  let longName = mconcat (replicate 10 "its_very_long")
10  longDir <- makeAbsolute (longName </> longName)
11
12  supportsLongPaths <- do
13      -- create 2 dirs because 1 path segment by itself can't exceed MAX_PATH
14      -- tests: [createDirectory]
15      createDirectory =<< makeAbsolute longName
16      createDirectory longDir
17      return True
18    `catchIOError` \ _ ->
19      return False
20
21  -- skip tests on file systems that do not support long paths
22  when supportsLongPaths $ do
23
24    -- test relative paths
25    let relDir = longName </> mconcat (replicate 8 "yeah_its_long")
26    createDirectory relDir
27    T(expect) () =<< doesDirectoryExist relDir
28    T(expectEq) () [] =<< listDirectory relDir
29    setPermissions relDir emptyPermissions
30    T(expectEq) () False =<< writable <$> getPermissions relDir
31
32    writeFile "foobar.txt" "^.^" -- writeFile does not support long paths yet
33
34    -- tests: [renamePath], [copyFileWithMetadata]
35    renamePath "foobar.txt" (longDir </> "foobar_tmp.txt")
36    renamePath (longDir </> "foobar_tmp.txt") (longDir </> "foobar.txt")
37    copyFileWithMetadata (longDir </> "foobar.txt")
38                         (longDir </> "foobar_copy.txt")
39
40    -- tests: [doesDirectoryExist], [doesFileExist], [doesPathExist]
41    T(expect) () =<< doesDirectoryExist longDir
42    T(expect) () =<< doesFileExist (longDir </> "foobar.txt")
43    T(expect) () =<< doesPathExist longDir
44    T(expect) () =<< doesPathExist (longDir </> "foobar.txt")
45
46    -- tests: [getFileSize], [getModificationTime]
47    T(expectEq) () 3 =<< getFileSize (longDir </> "foobar.txt")
48    _ <- getModificationTime (longDir </> "foobar.txt")
49
50    supportsSymbolicLinks <- supportsSymlinks
51    when supportsSymbolicLinks $ do
52
53      -- tests: [createDirectoryLink], [getSymbolicLinkTarget], [listDirectory]
54      -- also tests expansion of "." and ".."
55      createDirectoryLink "." (longDir </> "link")
56      _ <- listDirectory (longDir </> ".." </> longName </> "link")
57      T(expectEq) () "." =<< getSymbolicLinkTarget (longDir </> "." </> "link")
58
59      return ()
60
61  -- [removeFile], [removeDirectory] are automatically tested by the cleanup
62