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
|
-- File created: 2008-10-16 16:16:06
module Tests.Matcher (tests) where
import Control.Monad (ap)
import Test.Framework
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck (Property, (==>))
import System.FilePath (isExtSeparator, isPathSeparator)
import System.FilePath.Glob.Base
import System.FilePath.Glob.Match
import Tests.Base
tests :: Test
tests = testGroup "Matcher"
[ testProperty "match-1" prop_match1
, testProperty "match-2" prop_match2
, testProperty "match-3" prop_match3
, testProperty "match-4" prop_match4
]
-- ./foo should be equivalent to foo in both path and pattern
-- ... but not when exactly one of the two starts with /
-- ... and when both start with /, not when adding ./ to only one of them
prop_match1 :: COpts -> PString -> Path -> Property
prop_match1 o p_ pth_ =
let p0 = unPS p_
pth0 = unP pth_
(p, pth) =
if (not (null p0) && isPathSeparator (head p0)) /=
(not (null pth0) && isPathSeparator (head pth0))
then (dropWhile isPathSeparator p0, dropWhile isPathSeparator pth0)
else (p0, pth0)
ep = tryCompileWith (unCOpts o) p
ep' = tryCompileWith (unCOpts o) ("./" ++ p)
pat = fromRight ep
pat' = fromRight ep'
pth' = "./" ++ pth
in not (null p) && isRight ep && isRight ep'
==> all (uncurry (==)) . (zip`ap`tail) $
if isPathSeparator (head p)
&& not (null pth) && isPathSeparator (head pth)
then [ match pat pth
, match pat' pth'
]
else [ match pat pth
, match pat pth'
, match pat' pth
, match pat' pth'
]
-- [/] shouldn't match anything
prop_match2 :: Path -> Bool
prop_match2 = not . match (compile "[/]") . take 1 . unP
-- [!/] is like ?
prop_match3 :: Path -> Property
prop_match3 p_ =
let p = unP p_
~(x:_) = p
in not (null p || isPathSeparator x || isExtSeparator x)
==> match (compile "[!/]") [x]
-- Anything should match itself, when compiled with everything disabled.
prop_match4 :: PString -> Bool
prop_match4 ps_ =
let ps = unPS ps_
noOpts = CompOptions { characterClasses = False
, characterRanges = False
, numberRanges = False
, wildcards = False
, recursiveWildcards = False
, pathSepInRanges = False
, errorRecovery = True
}
in match (compileWith noOpts ps) ps
|
