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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
{-# LANGUAGE CPP #-}
module Tests.Directory where
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck (Property, (===))
import Test.HUnit.Base hiding (Test)
import Data.Function (on)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mappend)
#endif
import Data.List ((\\), sort)
import qualified Data.DList as DList
import System.FilePath.Glob.Base
import System.FilePath.Glob.Directory
import System.FilePath.Glob.Primitive
import System.FilePath.Glob.Utils
import Tests.Base (PString, unPS)
tests :: Test
tests = testGroup "Directory"
[ testCase "includeUnmatched" caseIncludeUnmatched
, testCase "onlyMatched" caseOnlyMatched
, testGroup "commonDirectory"
[ testGroup "edge-cases" testsCommonDirectoryEdgeCases
, testProperty "property" prop_commonDirectory
]
, testCase "globDir1" caseGlobDir1
, testGroup "repeated-path-separators" testsRepeatedPathSeparators
]
caseIncludeUnmatched :: Assertion
caseIncludeUnmatched = do
let pats = ["**/D*.hs", "**/[MU]*.hs"]
everything <- getRecursiveContentsDir "System"
let expectedMatches =
[ [ "System/FilePath/Glob/Directory.hs" ]
, [ "System/FilePath/Glob/Match.hs"
, "System/FilePath/Glob/Utils.hs"
]
]
let everythingElse = everything \\ concat expectedMatches
result <- globDirWith (GlobOptions matchDefault True)
(map compile pats)
"System"
mapM_ (uncurry assertEqualUnordered) (zip expectedMatches (fst result))
case snd result of
Nothing -> assertFailure "Expected Just a list of unmatched files"
Just unmatched -> assertEqualUnordered everythingElse unmatched
caseOnlyMatched :: Assertion
caseOnlyMatched = do
let pats = ["**/D*.hs", "**/[MU]*.hs"]
let expectedMatches =
[ [ "System/FilePath/Glob/Directory.hs" ]
, [ "System/FilePath/Glob/Match.hs"
, "System/FilePath/Glob/Utils.hs"
]
]
result <- globDirWith globDefault
(map compile pats)
"System"
mapM_ (uncurry assertEqualUnordered) (zip expectedMatches (fst result))
assertEqual "" Nothing (snd result)
caseGlobDir1 :: Assertion
caseGlobDir1 = do
-- this is little a bit of a hack; we pass the same pattern twice to ensure
-- that the optimization in the single pattern case is bypassed
let naiveGlobDir1 p = fmap head . globDir [p, p]
let pat = compile "FilePath/*/*.hs"
let dir = "System"
actual <- globDir1 pat dir
expected <- naiveGlobDir1 pat dir
assertEqual "" expected actual
assertEqualUnordered :: (Ord a, Show a) => [a] -> [a] -> Assertion
assertEqualUnordered = assertEqual "" `on` sort
-- Like 'getRecursiveContents', except this function removes the root directory
-- from the returned list, so that it should match* the union of matched and
-- unmatched files returned from 'globDirWith', where the same directory was
-- given as the directory argument.
--
-- * to be a little more precise, these files will only match up to
-- normalisation of paths e.g. some patterns will cause the list of matched
-- files to contain repeated slashes, whereas the list returned by this
-- function will not have repeated slashes.
getRecursiveContentsDir :: FilePath -> IO [FilePath]
getRecursiveContentsDir root =
fmap (filter (/= root) . DList.toList) (getRecursiveContents root)
-- These two patterns should always be equal
prop_commonDirectory' :: String -> (Pattern, Pattern)
prop_commonDirectory' str =
let pat = compile str
(a, b) = commonDirectory pat
in (pat, literal a `mappend` b)
prop_commonDirectory :: PString -> Property
prop_commonDirectory = uncurry (===) . prop_commonDirectory' . unPS
testsCommonDirectoryEdgeCases :: [Test]
testsCommonDirectoryEdgeCases = zipWith mkTest [1 :: Int ..] testData
where
mkTest i (input, expected) =
testCase (show i) $ do
assertEqual "" expected (commonDirectory (compile input))
uncurry (assertEqual "") (prop_commonDirectory' input)
testData =
[ ("[.]/*", ("", compile "[.]"))
, ("foo/[.]bar/*", ("", compile "[.]"))
, ("[.]foo/bar/*", ("", compile "[.]foo/bar/*"))
, ("foo.bar/baz/*", ("foo.bar/baz/", compile "*"))
, ("[f]oo[.]/bar/*", ("foo./bar/", compile "*"))
, ("foo[.]bar/baz/*", ("foo.bar/baz/", compile "*"))
, (".[.]/foo/*", ("../foo/", compile "*"))
]
-- see #16
testsRepeatedPathSeparators :: [Test]
testsRepeatedPathSeparators = zipWith mkTest [1 :: Int ..] testData
where
mkTest i (dir, pat, expected) =
testCase (show i) $ do
actual <- globDir1 (compile pat) dir
assertEqualUnordered expected actual
testData =
[ ( "System"
, "*//Glob///[U]*.hs"
, [ "System/FilePath//Glob///Utils.hs"
]
)
, ( "System"
, "**//[GU]*.hs"
, [ "System/FilePath//Glob.hs"
, "System/FilePath/Glob//Utils.hs"
]
)
, ( "System"
, "File**/"
, [ "System/FilePath/"
]
)
, ( "System"
, "File**//"
, [ "System/FilePath//"
]
)
, ( "System"
, "File**///"
, [ "System/FilePath///"
]
)
, ( "System/FilePath"
, "**//Glob.hs"
, [ "System/FilePath//Glob.hs"
]
)
, ( "System"
, "**Path/Glob//Utils.hs"
, [ "System/FilePath/Glob//Utils.hs"
]
)
]
|
