1-- File created: 2008-10-16 16:16:06 2 3module Tests.Matcher (tests) where 4 5import Control.Monad (ap) 6import Test.Framework 7import Test.Framework.Providers.QuickCheck2 8import Test.QuickCheck (Property, (==>)) 9 10import System.FilePath (isExtSeparator, isPathSeparator) 11import System.FilePath.Glob.Base 12import System.FilePath.Glob.Match 13 14import Tests.Base 15 16tests :: Test 17tests = testGroup "Matcher" 18 [ testProperty "match-1" prop_match1 19 , testProperty "match-2" prop_match2 20 , testProperty "match-3" prop_match3 21 , testProperty "match-4" prop_match4 22 ] 23 24-- ./foo should be equivalent to foo in both path and pattern 25-- ... but not when exactly one of the two starts with / 26-- ... and when both start with /, not when adding ./ to only one of them 27prop_match1 :: COpts -> PString -> Path -> Property 28prop_match1 o p_ pth_ = 29 let p0 = unPS p_ 30 pth0 = unP pth_ 31 (p, pth) = 32 if (not (null p0) && isPathSeparator (head p0)) /= 33 (not (null pth0) && isPathSeparator (head pth0)) 34 then (dropWhile isPathSeparator p0, dropWhile isPathSeparator pth0) 35 else (p0, pth0) 36 ep = tryCompileWith (unCOpts o) p 37 ep' = tryCompileWith (unCOpts o) ("./" ++ p) 38 pat = fromRight ep 39 pat' = fromRight ep' 40 pth' = "./" ++ pth 41 in not (null p) && isRight ep && isRight ep' 42 ==> all (uncurry (==)) . (zip`ap`tail) $ 43 if isPathSeparator (head p) 44 && not (null pth) && isPathSeparator (head pth) 45 then [ match pat pth 46 , match pat' pth' 47 ] 48 else [ match pat pth 49 , match pat pth' 50 , match pat' pth 51 , match pat' pth' 52 ] 53 54-- [/] shouldn't match anything 55prop_match2 :: Path -> Bool 56prop_match2 = not . match (compile "[/]") . take 1 . unP 57 58-- [!/] is like ? 59prop_match3 :: Path -> Property 60prop_match3 p_ = 61 let p = unP p_ 62 ~(x:_) = p 63 in not (null p || isPathSeparator x || isExtSeparator x) 64 ==> match (compile "[!/]") [x] 65 66-- Anything should match itself, when compiled with everything disabled. 67prop_match4 :: PString -> Bool 68prop_match4 ps_ = 69 let ps = unPS ps_ 70 noOpts = CompOptions { characterClasses = False 71 , characterRanges = False 72 , numberRanges = False 73 , wildcards = False 74 , recursiveWildcards = False 75 , pathSepInRanges = False 76 , errorRecovery = True 77 } 78 in match (compileWith noOpts ps) ps 79