git.iko.soy/streamly
on ed37c19 help sign in
streamly/test/Streamly/Test/FileSystem/Event/Linux.hs
163 lines 6.3 kB history raw
1-- |
2-- Module : Streamly.Test.FileSystem.Event.Linux
3-- Copyright : (c) 2020 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
8--
9module Streamly.Test.FileSystem.Event.Linux (main) where
11import Streamly.Internal.FileSystem.Event.Linux (Event)
12import qualified Streamly.Internal.FileSystem.Event.Linux as Event
14import Streamly.Test.FileSystem.Event.Common
16moduleName :: String
17moduleName = "FileSystem.Event.Linux"
19dirTouchEvents :: String -> [([Char], Event -> Bool)]
20dirTouchEvents dir =
21 [ (dir, dirEvent Event.isOpened)
22 , (dir, dirEvent Event.isAccessed)
23 , (dir, dirEvent Event.isNonWriteClosed)
24 ]
26dirDelEvents :: String -> [([Char], Event -> Bool)]
27dirDelEvents dir =
28 (dir, dirEvent Event.isDeleted)
29 : (dir, dirEvent Event.isAttrsModified)
30 : dirTouchEvents dir
32rootDirDelEvents :: String -> [([Char], Event -> Bool)]
33rootDirDelEvents root =
34 (root, Event.isRootUnwatched)
35 : (root, Event.isRootDeleted)
36 : (root, dirEvent Event.isAttrsModified)
37 : dirTouchEvents root
39dirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
40dirMoveEvents src dst =
41 [ (src, dirEvent Event.isMoved)
42 , (src, dirEvent Event.isMovedFrom)
43 , (dst, dirEvent Event.isMoved)
44 , (dst, dirEvent Event.isMovedTo)
45 ]
47#ifdef DEVBUILD
48-- In recursive mode all subdirectories are roots therefore they will generate
49-- isRootMoved.
50rootDirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
51rootDirMoveEvents root _ =
52 (root, Event.isRootMoved)
53 : dirTouchEvents root
55recDirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
56recDirMoveEvents src dst = dirMoveEvents src dst ++ rootDirMoveEvents src dst
57#endif
59fileTouchEvents :: String -> [([Char], Event -> Bool)]
60fileTouchEvents file =
61 [ (file, fileEvent Event.isOpened)
62 , (file, fileEvent Event.isModified)
63 , (file, fileEvent Event.isWriteClosed)
64 ]
66fileMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]
67fileMoveEvents src dst =
68 [ (src, fileEvent Event.isMoved)
69 , (src, fileEvent Event.isMovedFrom)
70 , (dst, fileEvent Event.isMoved)
71 , (dst, fileEvent Event.isMovedTo)
72 ]
74-- TODO: add fileRoot tests from macOS test suite
76main :: IO ()
77main = do
78 -- We ignore the events on root/parent dir during regular non-root dir/file
79 -- tests.
81 -- Tests common to regular root and symlink root cases
82 let regSymTests =
83 fileCreate "file" fileTouchEvents
84 : fileMove "file1" "file2" fileMoveEvents
85 : dirMove "dir1" "dir2" dirMoveEvents
86 : dirDelete "dir" dirDelEvents
87 : commonTests
89 let regTests =
90 dirDelete "" rootDirDelEvents
91 : rootDirMove "moved" (\src -> [(src, Event.isRootMoved)])
92 : regSymTests
94 let symTests =
95 -- when root is a symlinked dir, it does not recv touch, isDeleted
96 -- or rootDeleted, rootUnwatched events.
97 dirDelete "" (\dir -> [(dir, dirEvent Event.isAttrsModified)])
98 -- No events occur when a symlink root is moved
99 : regSymTests
101 let w = Event.watchWith (Event.setAllEvents True)
102 run = runTests moduleName "non-recursive" w
104 run DirType regTests
105 run SymLinkOrigPath symTests
107 let fileRootTests =
108 [ fileDelete "" (\path ->
109 [ (path, Event.isAttrsModified)
110 , (path, Event.isRootDeleted)
111 , (path, Event.isRootUnwatched)
112 ])
113 , rootFileMove "moved" (\path -> [(path, Event.isRootMoved)])
114 , fileModify "" (\path -> [(path, Event.isOpened)])
115 ]
117 run FileType fileRootTests
119 let recw = Event.watchWith
120 (Event.setAllEvents True . Event.setRecursiveMode True)
121 runRec = runTests moduleName "recursive" recw
123#ifdef DEVBUILD
124 -- In recursive mode all subdirectories are roots therefore they will
125 -- generate isRootDeleted/isRootUnwatched. Also, for subdirectories
126 -- multiple events are generated, once in the parent watch and once in the
127 -- self watch as a root of the watch. Therefore, additional touchEvents are
128 -- generated in this case.
129 --
130 -- XXX We can possibly filter out the duplicate events either from the
131 -- parent or self.
132 let regSymRecTests =
133 -- XXX Nested file create misses the create event due to a race
134 -- : fileCreateWithParent "subdir/file" fileTouchEvents
135 fileCreate "subdir/file" fileTouchEvents
136 : fileMove "subdir/file1" "subdir/file2" fileMoveEvents
137 : dirMove "dir1" "dir2" recDirMoveEvents
138 : dirMove "subdir/dir1" "subdir/dir2" recDirMoveEvents
139 : dirDelete "dir" (\d -> rootDirDelEvents d ++ dirDelEvents d)
140 : dirDelete "subdir/dir" (\d -> rootDirDelEvents d ++ dirDelEvents d)
141 -- XXX Nested dir create misses the create event due to a race
142 -- : dirCreateWithParent "subdir/dir" dirTouchEvents
143 : dirCreate "subdir/dir"
144 (\dir -> (dir, dirEvent Event.isCreated) : dirTouchEvents dir)
145 : dirCreate "dir"
146 (\dir -> (dir, dirEvent Event.isCreated) : dirTouchEvents dir)
147 : commonRecTests
148 recRegTests = regTests ++ regSymRecTests
149 recSymTests = symTests ++ regSymRecTests
151 -- XXX these tests fails intermittently for recursive case
152 -- FileSystem.Event.Linux.recursive, Root type SymLinkOrigPath, File deleted (subdir/file1)
153 -- FileSystem.Event.Linux.recursive, Root type SymLinkOrigPath, File modified (subdir/file1)
154 -- FileSystem.Event.Linux.recursive, Root type SymLinkOrigPath, File moved (subdir/file1 subdir/file2)
155 -- FileSystem.Event.Linux.recursive, Root type DirType, File moved (file1 file2)
156 -- FileSystem.Event.Linux.recursive, Root type DirType, File created (file)
157 -- uncaught exception: IOException of type ResourceBusy
158 -- /tmp/fsevent_dir-a5bd0df64c44ab27/watch-root/file: openFile: resource busy (file is locked)
160 runRec DirType recRegTests
161 runRec SymLinkOrigPath recSymTests
162#endif
163 runRec FileType fileRootTests