packages feed

Glob-0.4: tests/Tests/Matcher.hs

-- File created: 2008-10-16 16:16:06

module Tests.Matcher (tests) where

import Control.Monad (ap)
import Test.Framework
import Test.Framework.Providers.QuickCheck
import Test.QuickCheck ((==>))

import System.FilePath (isExtSeparator, isPathSeparator)
import System.FilePath.Glob.Base
import System.FilePath.Glob.Match

import Tests.Base

tests = testGroup "Matcher"
   [ testProperty "match-1" prop_match1
   , testProperty "match-2" prop_match2
   , testProperty "match-3" prop_match3
   ]

-- ./foo should be equivalent to foo in both path and pattern
-- ... but not for the pattern if it starts with /
prop_match1 o p_ s =
   let p    = dropWhile isPathSeparator (unPS p_)
       ep   = tryCompileWith (unCOpts o) p
       ep'  = tryCompileWith (unCOpts o) ("./" ++ p)
       pat  = fromRight ep
       pat' = fromRight ep'
       pth  = unP s
       pth' = "./" ++ pth
    in and [ isRight ep, isRight ep'
           , ( all (uncurry (==)) . (zip`ap`tail) $
                  [ match pat  pth
                  , match pat  pth'
                  , match pat' pth
                  , match pat' pth'
                  ]
             ) || null p
           ]

-- [/] shouldn't match anything
prop_match2 = not . match (compile "[/]")  . take 1 . unP

-- [!/] is like ?
prop_match3 p_ =
   let p = unP p_
       ~(x:_) = p
    in not (null p || isPathSeparator x || isExtSeparator x)
       ==> match (compile "[!/]") [x]