1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
module LinksSpec(linksSpec) where
import Control.Concurrent ( threadDelay )
import Control.Exception ( finally )
import qualified System.Directory as D
import System.Info ( os )
import System.IO.Error ( tryIOError )
import System.IO.Temp
import System.PosixCompat
import Test.Hspec
import Test.HUnit
isWindows :: Bool
isWindows = os == "mingw32"
linksSpec :: Spec
linksSpec = do
describe "createSymbolicLink" $ do
it "should error on Windows and succeed on other OSes" $ do
runInTempDir $ do
writeFile "file" ""
result <- tryIOError $ createSymbolicLink "file" "file_link"
case result of
Left _ | isWindows -> return ()
Right _ | isWindows -> do
assertFailure "Succeeded while expected to fail on Windows"
Left e -> assertFailure $ "Expected to succeed, but failed with " ++ show e
Right _ -> return ()
describe "getSymbolicLinkStatus" $ do
it "should detect symbolic link to a file" $ do
runFileLinkTest $ do
stat <- getSymbolicLinkStatus "file_link"
assert $ isSymbolicLink stat
it "should detect symbolic link to a directory" $ do
runDirLinkTest $ do
stat <- getSymbolicLinkStatus "dir_link"
assert $ isSymbolicLink stat
it "should give later time stamp than getFileStatus for link to file" $ do
runFileLinkTest $ do
lstat_mtime <- modificationTimeHiRes <$> getSymbolicLinkStatus "file_link"
stat_mtime <- modificationTimeHiRes <$> getFileStatus "file_link"
assert $ lstat_mtime > stat_mtime
it "should give later time stamp than getFileStatus for link to dir" $ do
runDirLinkTest $ do
lstat_mtime <- modificationTimeHiRes <$> getSymbolicLinkStatus "dir_link"
stat_mtime <- modificationTimeHiRes <$> getFileStatus "dir_link"
assert $ lstat_mtime > stat_mtime
it "should give a different fileID than getFileStatus for link to file" $ do
runFileLinkTest $ do
lstat_id <- fileID <$> getSymbolicLinkStatus "file_link"
fstat_id <- fileID <$> getFileStatus "file_link"
assert $ lstat_id /= fstat_id
it "should give a different fileID than getFileStatus for link to dir" $ do
runDirLinkTest $ do
lstat_id <- fileID <$> getSymbolicLinkStatus "dir_link"
fstat_id <- fileID <$> getFileStatus "dir_link"
assert $ lstat_id /= fstat_id
describe "getFileStatus" $ do
it "should detect that symbolic link target is a file" $ do
runFileLinkTest $ do
stat <- getFileStatus "file_link"
assert $ isRegularFile stat
it "should detect that symbolic link target is a directory" $ do
runDirLinkTest $ do
stat <- getFileStatus "dir_link"
assert $ isDirectory stat
it "should be equal for link and link target (except access time)" $ do
runFileLinkTest $ do
fstat <- getFileStatus "file"
flstat <- getFileStatus "file_link"
assert $ fstat `mostlyEq` flstat
runDirLinkTest $ do
fstat <- getFileStatus "dir"
flstat <- getFileStatus "dir_link"
assert $ fstat `mostlyEq` flstat
where
runFileLinkTest action =
runInTempDir $ do
writeFile "file" ""
threadDelay delay
D.createFileLink "file" "file_link"
action
runDirLinkTest action =
runInTempDir $ do
D.createDirectory "dir"
threadDelay delay
D.createDirectoryLink "dir" "dir_link"
action
runInTempDir action = do
orig <- D.getCurrentDirectory
withTempDirectory orig "xxxxxxx" $ \tmp -> do
D.setCurrentDirectory tmp
action `finally` D.setCurrentDirectory orig
-- We need to set the delay this high because otherwise the timestamp test
-- above fails on Linux and Windows, though not on MacOS. This seems to be
-- an artefact of the GHC runtime system which gives two subsequently
-- created files the same timestamp unless the delay is large enough.
delay = 10000
-- Test equality for all parts except accessTime
mostlyEq :: FileStatus -> FileStatus -> Bool
mostlyEq x y = tuple x == tuple y
where
tuple s =
( deviceID s
, fileID s
, fileMode s
, linkCount s
, fileOwner s
, fileGroup s
, specialDeviceID s
, fileSize s
, modificationTime s
, statusChangeTime s
, modificationTimeHiRes s
, statusChangeTimeHiRes s
)
|
