1{-# LANGUAGE CPP #-} 2module Tests.Directory where 3 4import Test.Framework 5import Test.Framework.Providers.HUnit 6import Test.Framework.Providers.QuickCheck2 7import Test.QuickCheck (Property, (===)) 8import Test.HUnit.Base hiding (Test) 9import Data.Function (on) 10#if !MIN_VERSION_base(4,8,0) 11import Data.Monoid (mappend) 12#endif 13import Data.List ((\\), sort) 14import qualified Data.DList as DList 15 16import System.FilePath.Glob.Base 17import System.FilePath.Glob.Directory 18import System.FilePath.Glob.Primitive 19import System.FilePath.Glob.Utils 20import Tests.Base (PString, unPS) 21 22tests :: Test 23tests = testGroup "Directory" 24 [ testCase "includeUnmatched" caseIncludeUnmatched 25 , testCase "onlyMatched" caseOnlyMatched 26 , testGroup "commonDirectory" 27 [ testGroup "edge-cases" testsCommonDirectoryEdgeCases 28 , testProperty "property" prop_commonDirectory 29 ] 30 , testCase "globDir1" caseGlobDir1 31 , testGroup "repeated-path-separators" testsRepeatedPathSeparators 32 ] 33 34caseIncludeUnmatched :: Assertion 35caseIncludeUnmatched = do 36 let pats = ["**/D*.hs", "**/[MU]*.hs"] 37 everything <- getRecursiveContentsDir "System" 38 let expectedMatches = 39 [ [ "System/FilePath/Glob/Directory.hs" ] 40 , [ "System/FilePath/Glob/Match.hs" 41 , "System/FilePath/Glob/Utils.hs" 42 ] 43 ] 44 let everythingElse = everything \\ concat expectedMatches 45 46 result <- globDirWith (GlobOptions matchDefault True) 47 (map compile pats) 48 "System" 49 mapM_ (uncurry assertEqualUnordered) (zip expectedMatches (fst result)) 50 51 case snd result of 52 Nothing -> assertFailure "Expected Just a list of unmatched files" 53 Just unmatched -> assertEqualUnordered everythingElse unmatched 54 55caseOnlyMatched :: Assertion 56caseOnlyMatched = do 57 let pats = ["**/D*.hs", "**/[MU]*.hs"] 58 let expectedMatches = 59 [ [ "System/FilePath/Glob/Directory.hs" ] 60 , [ "System/FilePath/Glob/Match.hs" 61 , "System/FilePath/Glob/Utils.hs" 62 ] 63 ] 64 65 result <- globDirWith globDefault 66 (map compile pats) 67 "System" 68 69 mapM_ (uncurry assertEqualUnordered) (zip expectedMatches (fst result)) 70 assertEqual "" Nothing (snd result) 71 72caseGlobDir1 :: Assertion 73caseGlobDir1 = do 74 -- this is little a bit of a hack; we pass the same pattern twice to ensure 75 -- that the optimization in the single pattern case is bypassed 76 let naiveGlobDir1 p = fmap head . globDir [p, p] 77 let pat = compile "FilePath/*/*.hs" 78 let dir = "System" 79 80 actual <- globDir1 pat dir 81 expected <- naiveGlobDir1 pat dir 82 assertEqual "" expected actual 83 84assertEqualUnordered :: (Ord a, Show a) => [a] -> [a] -> Assertion 85assertEqualUnordered = assertEqual "" `on` sort 86 87-- Like 'getRecursiveContents', except this function removes the root directory 88-- from the returned list, so that it should match* the union of matched and 89-- unmatched files returned from 'globDirWith', where the same directory was 90-- given as the directory argument. 91-- 92-- * to be a little more precise, these files will only match up to 93-- normalisation of paths e.g. some patterns will cause the list of matched 94-- files to contain repeated slashes, whereas the list returned by this 95-- function will not have repeated slashes. 96getRecursiveContentsDir :: FilePath -> IO [FilePath] 97getRecursiveContentsDir root = 98 fmap (filter (/= root) . DList.toList) (getRecursiveContents root) 99 100-- These two patterns should always be equal 101prop_commonDirectory' :: String -> (Pattern, Pattern) 102prop_commonDirectory' str = 103 let pat = compile str 104 (a, b) = commonDirectory pat 105 in (pat, literal a `mappend` b) 106 107prop_commonDirectory :: PString -> Property 108prop_commonDirectory = uncurry (===) . prop_commonDirectory' . unPS 109 110testsCommonDirectoryEdgeCases :: [Test] 111testsCommonDirectoryEdgeCases = zipWith mkTest [1 :: Int ..] testData 112 where 113 mkTest i (input, expected) = 114 testCase (show i) $ do 115 assertEqual "" expected (commonDirectory (compile input)) 116 uncurry (assertEqual "") (prop_commonDirectory' input) 117 118 testData = 119 [ ("[.]/*", ("", compile "[.]")) 120 , ("foo/[.]bar/*", ("", compile "[.]")) 121 , ("[.]foo/bar/*", ("", compile "[.]foo/bar/*")) 122 , ("foo.bar/baz/*", ("foo.bar/baz/", compile "*")) 123 , ("[f]oo[.]/bar/*", ("foo./bar/", compile "*")) 124 , ("foo[.]bar/baz/*", ("foo.bar/baz/", compile "*")) 125 , (".[.]/foo/*", ("../foo/", compile "*")) 126 ] 127 128-- see #16 129testsRepeatedPathSeparators :: [Test] 130testsRepeatedPathSeparators = zipWith mkTest [1 :: Int ..] testData 131 where 132 mkTest i (dir, pat, expected) = 133 testCase (show i) $ do 134 actual <- globDir1 (compile pat) dir 135 assertEqualUnordered expected actual 136 137 testData = 138 [ ( "System" 139 , "*//Glob///[U]*.hs" 140 , [ "System/FilePath//Glob///Utils.hs" 141 ] 142 ) 143 , ( "System" 144 , "**//[GU]*.hs" 145 , [ "System/FilePath//Glob.hs" 146 , "System/FilePath/Glob//Utils.hs" 147 ] 148 ) 149 , ( "System" 150 , "File**/" 151 , [ "System/FilePath/" 152 ] 153 ) 154 , ( "System" 155 , "File**//" 156 , [ "System/FilePath//" 157 ] 158 ) 159 , ( "System" 160 , "File**///" 161 , [ "System/FilePath///" 162 ] 163 ) 164 , ( "System/FilePath" 165 , "**//Glob.hs" 166 , [ "System/FilePath//Glob.hs" 167 ] 168 ) 169 , ( "System" 170 , "**Path/Glob//Utils.hs" 171 , [ "System/FilePath/Glob//Utils.hs" 172 ] 173 ) 174 ] 175