tasty-discover 2.0.3 → 3.0.0

raw patch · 10 files changed

+183/−42 lines, 10 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• README.md +16/−7
• executable/Main.hs +1/−1
• library/Test/Tasty/Config.hs +5/−1
• library/Test/Tasty/Discover.hs +47/−15
• library/Test/Tasty/Generator.hs +31/−4
• tasty-discover.cabal +4/−1
• test/ConfigTest.hs +59/−11
• test/DiscoverTest.hs +2/−2
• test/SubMod/FooBaz.hs +3/−0

@@ -8,6 +8,21 @@ [Keep a Changelog]: http://keepachangelog.com/ [Semantic Versioning]: http://semver.org/ +# 3.0.0 2017-05-03++### Added+- [#103]: Added `--tree-display` configuration option.++### Changed+- [#97]: `case_` is deprecated in favour of `unit_` for HUnit test cases.++### Fixed+- [#102]: `--no-module-suffix` incorrectly handling directories.++[#97]: https://github.com/lwm/tasty-discover/pull/97+[#102]: https://github.com/lwm/tasty-discover/pull/102+[#103]: https://github.com/lwm/tasty-discover/pull/103+ # 2.0.3 [2017-04-13]  ### Fixed

@@ -1,6 +1,6 @@ [![Build Status](https://travis-ci.org/lwm/tasty-discover.svg?branch=master)](https://travis-ci.org/lwm/tasty-discover)-[![Hackage Status](https://img.shields.io/badge/Hackage-2.0.1-brightgreen.svg)](http://hackage.haskell.org/package/tasty-discover)-[![Stackage Status](https://img.shields.io/badge/Stackage-2.0.1-brightgreen.svg)](https://www.stackage.org/package/tasty-discover/)+[![Hackage Status](https://img.shields.io/badge/Hackage-2.0.3-brightgreen.svg)](http://hackage.haskell.org/package/tasty-discover)+[![Stackage Status](https://img.shields.io/badge/Stackage-2.0.3-brightgreen.svg)](https://www.stackage.org/package/tasty-discover/) [![GitHub license](https://img.shields.io/badge/license-MIT-brightgreen.svg)](https://raw.githubusercontent.com/lwm/tasty-discover/master/LICENSE)  # tasty-discover@@ -9,6 +9,15 @@  [tasty framework]: https://github.com/feuerbach/tasty +### Table Of Contents++- [Getting Started](#getting-started)+- [Examples](#examples)+- [Configuration](#configuration)+- [Change Log](#change-log)+- [Contributing](#contributing)+- [Acknowledgements](#acknowledgements)+ # Getting Started  ![Usage GIF](http://i.imgur.com/gpdHc6x.gif)@@ -20,7 +29,7 @@   - Write your tests with the following prefixes:     - `prop_`: [QuickCheck](http://hackage.haskell.org/package/tasty-quickcheck) properties.     - `scprop_`: [SmallCheck](http://hackage.haskell.org/package/tasty-smallcheck) properties.-    - `case_`: [HUnit](http://hackage.haskell.org/package/tasty-hunit) test cases.+    - `unit_`: [HUnit](http://hackage.haskell.org/package/tasty-hunit) test cases.     - `spec_`: [Hspec](http://hackage.haskell.org/package/tasty-hspec) specifications.     - `test_`: [Tasty](http://hackage.haskell.org/package/tasty) TestTrees. @@ -37,8 +46,8 @@ import Test.Tasty.QuickCheck  -- HUnit test case-case_listCompare :: IO ()-case_listCompare = [1, 2, 3] `compare` [1,2] @?= GT+unit_listCompare :: IO ()+unit_listCompare = [1, 2, 3] `compare` [1,2] @?= GT  -- QuickCheck property prop_additionCommutative :: Int -> Int -> Bool@@ -99,9 +108,9 @@   - `--ingredient`: Tasty ingredients to add to your test runner.  # Change Log-See the [Change log] for the latest changes.+See the [change log] for the latest changes. -[Change log]: https://github.com/lwm/tasty-discover/blob/master/CHANGELOG.md+[change log]: https://github.com/lwm/tasty-discover/blob/master/CHANGELOG.md  # Contributing All contributions welcome!

@@ -24,7 +24,7 @@           tests <- findTests src config           let ingredients = tastyIngredients config               moduleName  = fromMaybe "Main" (generatedModuleName config)-              output      = generateTestDriver moduleName ingredients src tests+              output      = generateTestDriver config moduleName ingredients src tests           when (debug config) $ hPutStrLn stderr output           writeFile dst output     _ -> do

@@ -19,11 +19,12 @@   , tastyIngredients    :: [Ingredient]   , noModuleSuffix      :: Bool   , debug               :: Bool+  , treeDisplay         :: Bool   } deriving (Show)  -- | The default configuration defaultConfig :: Config-defaultConfig = Config Nothing Nothing [] [] False False+defaultConfig = Config Nothing Nothing [] [] False False False  -- | Configuration options parser. parseConfig :: String -> [String] -> Either String Config@@ -61,4 +62,7 @@   , Option [] ["debug"]       (NoArg $ \c -> c {debug = True})       "Debug output of generated test module"+  , Option [] ["tree-display"]+      (NoArg $ \c -> c {treeDisplay = True})+      "Display test output hierarchically"   ]

@@ -3,6 +3,7 @@  import           Data.List            (dropWhileEnd, intercalate, isPrefixOf,                                        isSuffixOf, nub)+import qualified Data.Map.Strict      as M import           Data.Traversable     (for) import           System.Directory     (doesDirectoryExist, getDirectoryContents) import           System.FilePath      (takeDirectory, (</>))@@ -10,8 +11,8 @@ import           Test.Tasty.Generator (Generator (..), Test (..), generators,                                        getGenerators, mkTest, showSetup) -generateTestDriver :: String -> [String] -> FilePath -> [Test] -> String-generateTestDriver modname is src tests =+generateTestDriver :: Config -> String -> [String] -> FilePath -> [Test] -> String+generateTestDriver config modname is src tests =   let generators' = getGenerators tests       testNumVars = map (("t"++) . show) [(0 :: Int)..]   in@@ -29,7 +30,7 @@       , "tests = do\n"       , unlines $ zipWith showSetup tests testNumVars       , "  pure $ T.testGroup \"" ++ src ++ "\" ["-      , intercalate "," $ zipWith (curry snd) tests testNumVars+      , intercalate "," $ showTests config tests testNumVars       , "]\n"       , concat         [ "ingredients :: [T.Ingredient]\n"@@ -48,14 +49,15 @@ filesBySuffix :: FilePath -> [String] -> IO [FilePath] filesBySuffix dir suffixes = do   entries <- filter isHidden <$> getDirectoryContents dir-  found <- for entries $ \entry -> do+  fmap concat $ for entries $ \entry -> do     let dir' = dir </> entry     dirExists <- doesDirectoryExist dir'     if dirExists then       map (entry </>) <$> filesBySuffix dir' suffixes+    else if any (`isSuffixOf` entry) suffixes then+      pure [entry]     else       pure []-  pure $ filter (\x -> any (`isSuffixOf` x) suffixes) entries ++ concat found  isIgnored :: [FilePath] -> String -> Bool isIgnored ignores filename = filename `notElem` addSuffixes ignores@@ -63,14 +65,10 @@ findTests :: FilePath -> Config -> IO [Test] findTests src config = do   let dir      = takeDirectory src-      suffixes = testFileSuffixes (moduleSuffix config)+      suffixes = testFileSuffixes config       ignores  = ignoredModules config-  files <--    if noModuleSuffix config-    then filter isHidden <$> getDirectoryContents dir-    else filesBySuffix dir suffixes-  let files' = filter (isIgnored ignores) files-  concat <$> traverse (extract dir) files'+  files <- filter (isIgnored ignores) <$> filesBySuffix dir suffixes+  concat <$> traverse (extract dir) files   where     extract dir file = extractTests file <$> readFile (dir </> file) @@ -82,10 +80,12 @@     checkPrefix g = (`isPrefixOf` g) . generatorPrefix     parseTest     = map fst . concatMap lex . lines -testFileSuffixes :: Maybe String -> [String]-testFileSuffixes suffix = addSuffixes suffixes+testFileSuffixes :: Config -> [String]+testFileSuffixes config = if noModuleSuffix config+    then [""]+    else addSuffixes suffixes   where-    suffixes = case suffix of+    suffixes = case moduleSuffix config of       Just suffix' -> [suffix']       Nothing      -> ["Spec", "Test"] @@ -97,3 +97,35 @@  ingredients :: [String] -> String ingredients is = concat $ map (++":") is ++ ["T.defaultIngredients"]++showTests :: Config -> [Test] -> [String] -> [String]+showTests config tests testNumVars = if treeDisplay config+  then showModuleTree $ mkModuleTree tests testNumVars+  else zipWith (curry snd) tests testNumVars++newtype ModuleTree = ModuleTree (M.Map String (ModuleTree, [String]))+  deriving (Eq, Show)++showModuleTree :: ModuleTree -> [String]+showModuleTree (ModuleTree mdls) = map showModule $ M.assocs mdls+  where+    -- special case, collapse to mdl.submdl+    showModule (mdl, (ModuleTree subMdls, [])) | M.size subMdls == 1 =+      let [(subMdl, (subSubTree, testVars))] = M.assocs subMdls+      in showModule (mdl ++ '.' : subMdl, (subSubTree, testVars))+    showModule (mdl, (subTree, testVars)) = concat+      [ "T.testGroup \"", mdl+      , "\" [", intercalate "," (showModuleTree subTree ++ testVars), "]" ]++mkModuleTree :: [Test] -> [String] -> ModuleTree+mkModuleTree tests testVars = ModuleTree $+    foldr go M.empty $ zipWith (\t tVar -> (testModule t, tVar)) tests testVars+  where+    go (mdl, tVar) mdls = M.insertWith merge key val mdls+      where+        (key, val) = case break (== '.') mdl of+          (_, []) -> (mdl, (ModuleTree M.empty, [tVar]))+          (topMdl, '.':subMdl) -> (topMdl, (ModuleTree $ go (subMdl, tVar) M.empty, []))+          _ -> error "impossible case in mkModuleTree.go.key"+    merge (ModuleTree mdls1, tVars1) (ModuleTree mdls2, tVars2) =+      (ModuleTree $ M.unionWith merge mdls1 mdls2, tVars1 ++ tVars2)

@@ -37,17 +37,24 @@   where chooser c1 c2 = map $ \c3 -> if c3 == c1 then c2 else c3  getGenerator :: Test -> Generator-getGenerator t = fromJust $ find ((`isPrefixOf` testFunction t) . generatorPrefix) generators+getGenerator t = fromJust $ getPrefix generators+  where getPrefix = find ((`isPrefixOf` testFunction t) . generatorPrefix)  getGenerators :: [Test] -> [Generator]-getGenerators = map head . groupBy  ((==) `on` generatorPrefix) . sortOn generatorPrefix . map getGenerator+getGenerators =+  map head .+  groupBy  ((==) `on` generatorPrefix) .+  sortOn generatorPrefix .+  map getGenerator  showSetup :: Test -> String -> String-showSetup t var = "  " ++ var ++ " <- " ++ generatorSetup (getGenerator t) t ++ "\n"+showSetup t var = "  " ++ var ++ " <- " ++ setup ++ "\n"+  where setup = generatorSetup (getGenerator t) t  generators :: [Generator] generators =   [ quickCheckPropertyGenerator+  , hunitTestCaseGeneratorDeprecated   , hunitTestCaseGenerator   , hspecTestCaseGenerator   , tastyTestGroupGenerator@@ -61,9 +68,29 @@   , generatorSetup  = \t -> "pure $ QC.testProperty \"" ++ name t ++ "\" " ++ qualifyFunction t   } +deprecationMessage :: String+deprecationMessage =+  error $ concat+    [ "\n\n"+    , "----------------------------------------------------------\n"+    , "DEPRECATION NOTICE: The `case_` prefix is deprecated.\n"+    , "Please use the `unit_` prefix instead.\n"+    , "Please see https://github.com/lwm/tasty-discover/issues/95.\n"+    , "----------------------------------------------------------\n"+    ]++-- DEPRECATED: Use `unit_` instead (below)+hunitTestCaseGeneratorDeprecated :: Generator+hunitTestCaseGeneratorDeprecated = Generator+  { generatorPrefix = "case_"+  , generatorImport = deprecationMessage+  , generatorClass  = deprecationMessage+  , generatorSetup  = const deprecationMessage+  }+ hunitTestCaseGenerator :: Generator hunitTestCaseGenerator = Generator-  { generatorPrefix = "case_"+  { generatorPrefix = "unit_"   , generatorImport = "import qualified Test.Tasty.HUnit as HU\n"   , generatorClass  = concat     [ "class TestCase a where testCase :: String -> a -> IO T.TestTree\n"

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           tasty-discover-version:        2.0.3+version:        3.0.0 synopsis:       Test discovery for the tasty framework. description:    Automatic test discovery and runner for the tasty framework.                 Prefix your test case names and tasty-discover will discover, collect and run them. All popular test libraries are covered. Configure once and then just write your tests. Avoid forgetting to add test modules to your Cabal/Hpack files. Tasty ingredients are included along with various configuration options for different use cases. Please see the `README.md` below for how to get started.@@ -33,6 +33,7 @@   ghc-options: -Wall   build-depends:       base       >= 4.8 && < 5+    , containers >= 0.4     , directory  >= 1.1 && < 1.4     , filepath   >= 1.3 && < 1.5   exposed-modules:@@ -46,6 +47,7 @@   ghc-options: -Wall   build-depends:       base       >= 4.8 && < 5+    , containers >= 0.4     , directory  >= 1.1 && < 1.4     , filepath   >= 1.3 && < 1.5     , tasty-discover@@ -59,6 +61,7 @@   ghc-options: -Wall   build-depends:       base       >= 4.8 && < 5+    , containers >= 0.4     , directory  >= 1.1 && < 1.4     , filepath   >= 1.3 && < 1.5     , base

@@ -1,31 +1,79 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} module ConfigTest where  import           Data.List            (isInfixOf)+import qualified Data.Map.Strict      as M import           Test.Tasty.Config-import           Test.Tasty.Discover  (findTests, generateTestDriver)-import           Test.Tasty.Generator (mkTest)+import           Test.Tasty.Discover  (findTests, generateTestDriver, showTests,+                                       ModuleTree(..), mkModuleTree)+import           Test.Tasty.Generator (Test(..), mkTest) import           Test.Tasty.HUnit+import           Test.Tasty.QuickCheck -case_noModuleSuffixEmptyList :: IO ()-case_noModuleSuffixEmptyList = do+unit_noModuleSuffixEmptyList :: IO ()+unit_noModuleSuffixEmptyList = do   actual <- findTests "test/SubMod/" (defaultConfig { moduleSuffix = Just "DoesntExist"})   actual @?= [] -case_differentGeneratedModule :: Assertion-case_differentGeneratedModule = assertBool "" ("FunkyModuleName" `isInfixOf` generatedModule)-  where generatedModule = generateTestDriver "FunkyModuleName" [] "test/" []+unit_differentGeneratedModule :: Assertion+unit_differentGeneratedModule = assertBool "" ("FunkyModuleName" `isInfixOf` generatedModule)+  where generatedModule = generateTestDriver defaultConfig "FunkyModuleName" [] "test/" [] -case_ignoreAModule :: IO ()-case_ignoreAModule = do+unit_ignoreAModule :: IO ()+unit_ignoreAModule = do   actual <- findTests "test/SubMod/" (defaultConfig { ignoredModules = ["PropTest"] })   actual @?= [] -case_noModuleSuffix :: IO ()-case_noModuleSuffix  = do+unit_noModuleSuffix :: IO ()+unit_noModuleSuffix  = do   actual1 <- findTests "test/SubMod/" defaultConfig   actual1 @?= [mkTest "PropTest" "prop_additionAssociative"]    actual2 <- findTests "test/SubMod/" (defaultConfig { noModuleSuffix = True })   let expected = [ mkTest "FooBaz" "prop_additionCommutative"+                 , mkTest "FooBaz" "prop_multiplationDistributiveOverAddition"                  , mkTest "PropTest" "prop_additionAssociative" ]   assertBool "" $ all (`elem` expected) actual2++unit_noModuleSuffixRecurseDirs :: IO ()+unit_noModuleSuffixRecurseDirs = do+  tests <- findTests "test/" (defaultConfig { noModuleSuffix = True })+  assertBool "" $ elem (mkTest "SubMod/FooBaz" "prop_additionCommutative") tests++unit_noTreeDisplayDefault :: IO ()+unit_noTreeDisplayDefault = do+  let config = defaultConfig { noModuleSuffix = True }+  tests <- findTests "test/SubMod/" config+  let testNumVars = map (('t' :) . show) [(0::Int)..]+      trees = showTests config tests testNumVars+  length trees @?= 3++unit_treeDisplay :: IO ()+unit_treeDisplay = do+  let config = defaultConfig { noModuleSuffix = True, treeDisplay = True }+  tests <- findTests "test/SubMod/" config+  let testNumVars = map (('t' :) . show) [(0::Int)..]+      trees = showTests config tests testNumVars+  length trees @?= 2++prop_mkModuleTree :: ModuleTree -> Property+prop_mkModuleTree mtree =+    let (tests, testVars) = unzip $ flattenTree mtree+    in mkModuleTree tests testVars === mtree+  where+    flattenTree (ModuleTree mp) = M.assocs mp >>= flattenModule+    flattenModule (mdl, (subTree, testVars)) = concat+      [ map (\(Test subMdl _, tVar) -> (Test (mdl ++ '.':subMdl) "-", tVar)) (flattenTree subTree)+      , map (\tVar -> (Test mdl "-", tVar)) testVars ]++instance Arbitrary ModuleTree where+  arbitrary = sized $ \size ->+      resize (min size 12) (ModuleTree . M.fromList <$> listOf1 mdlGen)+    where+      mdlGen = sized $ \size -> do+        mdl <- listOf1 (elements ['a'..'z'])+        subTree <- if size == 0+          then pure $ ModuleTree M.empty+          else resize (size `div` 2) arbitrary+        tVars <- listOf1 (listOf1 arbitrary)+        pure (mdl, (subTree, tVars))

@@ -8,8 +8,8 @@ import           Test.Tasty.HUnit import           Test.Tasty.QuickCheck -case_listCompare :: IO ()-case_listCompare = [1 :: Int, 2, 3] `compare` [1,2] @?= GT+unit_listCompare :: IO ()+unit_listCompare = [1 :: Int, 2, 3] `compare` [1,2] @?= GT  prop_additionCommutative :: Int -> Int -> Bool prop_additionCommutative a b = a + b == b + a

@@ -2,3 +2,6 @@  prop_additionCommutative :: Int -> Int -> Bool prop_additionCommutative a b = a + b == b + a++prop_multiplationDistributiveOverAddition :: Integer -> Integer -> Integer -> Bool+prop_multiplationDistributiveOverAddition a b c = a * (b + c) == a * b + a * c