diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,9 @@ [Keep a Changelog]: http://keepachangelog.com/ [Semantic Versioning]: http://semver.org/ +- Added `--search-dir DIR` option +- Adds an `--in-place` flag to write the generated driver to the source file. + # 4.2.1 [2018-06-06] ## Changed diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -[![Build Status](https://travis-ci.org/lwm/tasty-discover.svg?branch=master)](https://travis-ci.org/lwm/tasty-discover) +[![CircleCI](https://circleci.com/gh/haskell-works/tasty-discover/tree/master.svg?style=svg)](https://circleci.com/gh/haskell-works/tasty-discover/tree/master) [![tasty-discover-nightly](http://stackage.org/package/tasty-discover/badge/nightly)](http://stackage.org/nightly/package/tasty-discover) [![tasty-discover-lts](http://stackage.org/package/tasty-discover/badge/lts)](http://stackage.org/lts/package/tasty-discover) [![Hackage Status](https://img.shields.io/hackage/v/tasty-discover.svg)](http://hackage.haskell.org/package/tasty-discover) @@ -27,7 +27,7 @@ Prefix your test case names and `tasty-discover` will discover, collect and run them. All popular Haskell test libraries are covered. Configure once then just -write your tests. Avoid forgetting to add test modules to your Cabal/Hpack +write your tests. Remember to add your test modules to your Cabal/Hpack files. Tasty ingredients are included along with various configuration options for different use cases. @@ -82,6 +82,16 @@ - "base" ``` +To ensure that `tasty-discover` is available even without installation, add this +to the test suite in your cabal file: + +``` + build-tool-depends: + tasty-discover:tasty-discover +``` + +See [`hpack` documentation](https://github.com/sol/hpack) for `stack` equivalent. + # Write Tests Create test modules and prefix the test function name with an identifier that @@ -115,7 +125,7 @@ prop_additionCommutative :: Int -> Int -> Bool prop_additionCommutative a b = a + b == b + a --- SmallSheck property +-- SmallCheck property scprop_sortReverse :: [Int] -> Bool scprop_sortReverse list = sort list == sort (reverse list) @@ -158,9 +168,13 @@ Example: `{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --modules="*CustomTest.hs" #-}` - **--modules**: Which test modules to discover (with glob pattern). + - **--search-dir**: Where to look for tests. This is a directory relative + to the location of the source file. By default, this is the directory + of the source file." - **--ignores**: Which test modules to ignore (with glob pattern). - **--generated-module**: The name of the generated test module. - **--ingredient**: Tasty ingredients to add to your test runner. + - **--inplace**: Has the generated code written to the source file. It is also possible to override [tasty test options] with `-optF`: @@ -210,7 +224,7 @@ # Maintenance -If you're interested in helping maintain this package, please let [@lwm] know! +If you're interested in helping maintain this package, please let [@newhoggy] know! It doesn't take much time (max ~3 hours a month) and all we need to do is: @@ -222,8 +236,8 @@ You can [create an issue] or drop him a line at **lukewm AT riseup DOT NET**. -[@lwm]: https://git.coop/lwm -[create an issue]: https://git.coop/lwm/tasty-discover/issues/new +[@newhoggy]: https://twitter.com/newhoggy +[create an issue]: https://github.com/haskell-works/tasty-discover/issues/new # Acknowledgements diff --git a/executable/Main.hs b/executable/Main.hs --- a/executable/Main.hs +++ b/executable/Main.hs @@ -6,7 +6,8 @@ import Data.Maybe (fromMaybe) import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) -import System.IO (hPutStrLn, stderr) +import System.FilePath (takeDirectory) +import System.IO (IOMode(ReadMode), hGetContents, hPutStrLn, withFile, stderr) import Test.Tasty.Config (Config (..), parseConfig) import Test.Tasty.Discover (findTests, generateTestDriver) @@ -17,17 +18,26 @@ name <- getProgName case args of src:_:dst:opts -> - case parseConfig name opts of + case parseConfig (takeDirectory src) name opts of Left err -> do hPutStrLn stderr err exitFailure Right config -> do - tests <- findTests src config + tests <- findTests config let ingredients = tastyIngredients config moduleName = fromMaybe "Main" (generatedModuleName config) - output = generateTestDriver config moduleName ingredients src tests + header <- readHeader src + let output = generateTestDriver config moduleName ingredients src tests when (debug config) $ hPutStrLn stderr output - writeFile dst output + when (inPlace config) $ writeFile src $ unlines $ header ++ [marker, output] + writeFile dst $ + "{-# LINE " ++ show (length header + 2) ++ " " ++ show src ++ " #-}\n" + ++ output _ -> do hPutStrLn stderr "Usage: tasty-discover src _ dst [OPTION...]" exitFailure + where + marker = "-- GENERATED BY tasty-discover" + readHeader src = withFile src ReadMode $ \h -> do + header <- takeWhile (marker /=) . lines <$> hGetContents h + seq (length header) (return header) diff --git a/library/Test/Tasty/Config.hs b/library/Test/Tasty/Config.hs --- a/library/Test/Tasty/Config.hs +++ b/library/Test/Tasty/Config.hs @@ -17,6 +17,7 @@ import Data.Maybe (isJust) import System.Console.GetOpt (ArgDescr (NoArg, ReqArg), ArgOrder (Permute), OptDescr (Option), getOpt') +import System.FilePath (()) -- | A tasty ingredient. type Ingredient = String @@ -28,19 +29,21 @@ data Config = Config { modules :: Maybe GlobPattern -- ^ Glob pattern for matching modules during test discovery. , moduleSuffix :: Maybe String -- ^ <<>>: Module suffix. + , searchDir :: FilePath -- ^ Directory where to look for tests. , generatedModuleName :: Maybe String -- ^ Name of the generated main module. , ignores :: Maybe GlobPattern -- ^ Glob pattern for ignoring modules during test discovery. , ignoredModules :: [FilePath] -- ^ <<>>: Ignored modules by full name. , tastyIngredients :: [Ingredient] -- ^ Tasty ingredients to use. , tastyOptions :: [String] -- ^ Options passed to tasty + , inPlace :: Bool -- ^ Whether the source file should be modified in-place. , noModuleSuffix :: Bool -- ^ <<>>: suffix and look in all modules. , debug :: Bool -- ^ Debug the generated module. , treeDisplay :: Bool -- ^ Tree display for the test results table. } deriving (Show) -- | The default configuration -defaultConfig :: Config -defaultConfig = Config Nothing Nothing Nothing Nothing [] [] [] False False False +defaultConfig :: FilePath -> Config +defaultConfig theSearchDir = Config Nothing Nothing theSearchDir Nothing Nothing [] [] [] False False False False -- | Deprecation message for old `--[no-]module-suffix` option. moduleSuffixDeprecationMessage :: String @@ -64,10 +67,10 @@ ] -- | Configuration options parser. -parseConfig :: String -> [String] -> Either String Config -parseConfig prog args = case getOpt' Permute options args of +parseConfig :: FilePath -> String -> [String] -> Either String Config +parseConfig srcDir prog args = case getOpt' Permute (options srcDir) args of (opts, rest, rest', []) -> - let config = foldl (flip id) defaultConfig { tastyOptions = rest ++ rest' } opts in + let config = foldl (flip id) (defaultConfig srcDir) { tastyOptions = rest ++ rest' } opts in if noModuleSuffix config || isJust (moduleSuffix config) then error moduleSuffixDeprecationMessage else if not $ null (ignoredModules config) @@ -77,14 +80,17 @@ where formatError err = Left (prog ++ ": " ++ err) -- | All configuration options. -options :: [OptDescr (Config -> Config)] -options = +options :: FilePath -> [OptDescr (Config -> Config)] +options srcDir = [ Option [] ["modules"] (ReqArg (\s c -> c {modules = Just s}) "GLOB-PATTERN") "Specify desired modules with a glob pattern (white-list)" , Option [] ["module-suffix"] (ReqArg (\s c -> c {moduleSuffix = Just s}) "SUFFIX") "<<>>: Specify desired test module suffix" + , Option [] ["search-dir"] + (ReqArg (\s c -> c {searchDir = srcDir s}) "DIR") + "Directory where to look for tests relative to the directory of src. By default, this is the directory of src." , Option [] ["generated-module"] (ReqArg (\s c -> c {generatedModuleName = Just s}) "MODULE") "Qualified generated module name" @@ -97,6 +103,9 @@ , Option [] ["ingredient"] (ReqArg (\s c -> c {tastyIngredients = s : tastyIngredients c}) "INGREDIENT") "Qualified tasty ingredient name" + , Option [] ["in-place"] + (NoArg $ \c -> c {inPlace = True}) + "Whether the source file should be modified in-place" , Option [] ["no-module-suffix"] (NoArg $ \c -> c {noModuleSuffix = True}) "<<>>: Ignore test module suffix and import them all" diff --git a/library/Test/Tasty/Discover.hs b/library/Test/Tasty/Discover.hs --- a/library/Test/Tasty/Discover.hs +++ b/library/Test/Tasty/Discover.hs @@ -12,11 +12,11 @@ , showTests ) where -import Data.List (dropWhileEnd, intercalate, isPrefixOf, nub, stripPrefix) +import Data.List (dropWhileEnd, intercalate, isPrefixOf, nub, sort, stripPrefix) import Data.Maybe (fromMaybe) -import System.FilePath (pathSeparator, takeDirectory) +import System.FilePath (pathSeparator) import System.FilePath.Glob (compile, globDir1, match) -import System.IO (IOMode (ReadMode), openFile) +import System.IO (IOMode (ReadMode), withFile) import Test.Tasty.Config (Config (..), GlobPattern) import Test.Tasty.Generator (Generator (..), Test (..), generators, getGenerators, mkTest, showSetup) @@ -37,15 +37,19 @@ let generators' = getGenerators tests testNumVars = map (("t"++) . show) [(0 :: Int)..] in concat - [ "{-# LINE 1 " ++ show src ++ " #-}\n" - , "{-# LANGUAGE FlexibleInstances #-}\n" + [ "{-# LANGUAGE FlexibleInstances #-}\n" + , "\n" , "module " ++ modname ++ " (main, ingredients, tests) where\n" + , "\n" , "import Prelude\n" + , "\n" , "import qualified System.Environment as E\n" , "import qualified Test.Tasty as T\n" , "import qualified Test.Tasty.Ingredients as T\n" , unlines $ map generatorImport generators' , showImports (map ingredientImport is ++ map testModule tests) + , "{- HLINT ignore \"Use let\" -}\n" + , "\n" , unlines $ map generatorClass generators' , "tests :: IO T.TestTree\n" , "tests = do\n" @@ -74,19 +78,23 @@ where pattern = compile ("**/" ++ ignoreGlob) -- | Discover the tests modules. -findTests :: FilePath -> Config -> IO [Test] -findTests src config = do - let directory = takeDirectory src +findTests :: Config -> IO [Test] +findTests config = do + let directory = searchDir config allModules <- filesByModuleGlob directory (modules config) let filtered = ignoreByModuleGlob allModules (ignores config) - concat <$> traverse (extract directory) filtered - where extract directory filePath = do - h <- openFile filePath ReadMode + -- The files to scan need to be sorted or otherwise the output of + -- findTests might not be deterministic + sortedFiltered = sort filtered + concat <$> traverse (extract directory) sortedFiltered + where extract directory filePath = + withFile filePath ReadMode $ \h -> do #if defined(mingw32_HOST_OS) -- Avoid internal error: hGetContents: invalid argument (invalid byte sequence)' non UTF-8 Windows - hSetEncoding h $ mkLocaleEncoding TransliterateCodingFailure + hSetEncoding h $ mkLocaleEncoding TransliterateCodingFailure #endif - extractTests (dropDirectory directory filePath) <$> hGetContents h + tests <- extractTests (dropDirectory directory filePath) <$> hGetContents h + seq (length tests) (return tests) dropDirectory directory filePath = fromMaybe filePath $ stripPrefix (directory ++ [pathSeparator]) filePath diff --git a/tasty-discover.cabal b/tasty-discover.cabal --- a/tasty-discover.cabal +++ b/tasty-discover.cabal @@ -1,32 +1,33 @@ cabal-version: 2.2 -name: tasty-discover -version: 4.2.2 -synopsis: Test discovery for the tasty framework. -description: Automatic test discovery and runner for the tasty framework. +name: tasty-discover +version: 4.2.3 +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. + 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. + 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. + Tasty ingredients are included along with various configuration options for different + use cases. - Please see the `README.md` below for how to get started. -category: Testing -stability: Experimental -homepage: https://github.com/haskell-works/tasty-discover -bug-reports: https://github.com/haskell-works/tasty-discover/issues -author: Luke Murphy -maintainer: John Ky -copyright: 2016 Luke Murphy - 2020 John Ky -license: MIT -license-file: LICENSE -build-type: Simple -extra-source-files: CHANGELOG.md - README.md + Please see the `README.md` below for how to get started. +category: Testing +stability: Experimental +homepage: https://github.com/haskell-works/tasty-discover +bug-reports: https://github.com/haskell-works/tasty-discover/issues +author: Luke Murphy +maintainer: John Ky +copyright: 2016 Luke Murphy + 2020-2021 John Ky +license: MIT +license-file: LICENSE +tested-with: GHC == 9.2.2, GHC == 9.0.2, GHC == 8.10.7, GHC == 8.8.4, GHC == 8.6.5 +build-type: Simple +extra-source-files: CHANGELOG.md + README.md source-repository head type: git @@ -38,14 +39,16 @@ common directory { build-depends: directory >= 1.1 && < 2.0 } common filepath { build-depends: filepath >= 1.3 && < 2.0 } common Glob { build-depends: Glob >= 0.8 && < 1.0 } -common hedgehog { build-depends: hedgehog } -common tasty { build-depends: tasty } -common tasty-discover { build-depends: tasty-discover } -common tasty-hedgehog { build-depends: tasty-hedgehog } -common tasty-hspec { build-depends: tasty-hspec } -common tasty-hunit { build-depends: tasty-hunit } -common tasty-quickcheck { build-depends: tasty-quickcheck } -common tasty-smallcheck { build-depends: tasty-smallcheck } +common hedgehog { build-depends: hedgehog >= 1.0 && < 2.0 } +common hspec { build-depends: hspec >= 2.7 && < 2.9 } +common hspec-core { build-depends: hspec-core >= 2.7.10 && < 2.11 } +common tasty { build-depends: tasty >= 1.3 && < 2.0 } +common tasty-discover { build-depends: tasty-discover >= 4.0 && < 5.0 } +common tasty-hedgehog { build-depends: tasty-hedgehog >= 1.1 && < 2.0 } +common tasty-hspec { build-depends: tasty-hspec >= 1.1 && < 1.3 } +common tasty-hunit { build-depends: tasty-hunit >= 0.10 && < 0.11 } +common tasty-quickcheck { build-depends: tasty-quickcheck >= 0.10 && < 0.11 } +common tasty-smallcheck { build-depends: tasty-smallcheck >= 0.8 && < 1.0 } library exposed-modules: Test.Tasty.Config @@ -82,6 +85,8 @@ , directory , filepath , hedgehog + , hspec + , hspec-core , tasty , tasty-hedgehog , tasty-hspec diff --git a/test/ConfigTest.hs b/test/ConfigTest.hs --- a/test/ConfigTest.hs +++ b/test/ConfigTest.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -8,10 +9,13 @@ import Test.Tasty.Config import Test.Tasty.Discover (ModuleTree (..), findTests, generateTestDriver, mkModuleTree, showTests) import Test.Tasty.Generator (Test (..), mkTest) -import Test.Tasty.Hspec + import Test.Tasty.HUnit import Test.Tasty.QuickCheck +import Test.Hspec.Core.Spec (Spec, describe, it) +import Test.Hspec (shouldBe, shouldSatisfy) + import qualified Data.Map.Strict as M spec_modules :: Spec @@ -20,41 +24,42 @@ let expectedTests = [ mkTest "PropTest.hs" "prop_additionAssociative" , mkTest "SubSubMod/PropTest.hs" "prop_additionCommutative" ] - config = defaultConfig { modules = Just "*Test.hs" } - discoveredTests <- findTests "test/SubMod/" config + config = (defaultConfig "test/SubMod") { modules = Just "*Test.hs" } + discoveredTests <- findTests config sort discoveredTests `shouldBe` sort expectedTests spec_ignores :: Spec spec_ignores = describe "Module ignore configuration" $ do it "Ignores tests in modules with the specified suffix" $ do - let ignoreModuleConfig = defaultConfig { ignores = Just "*.hs" } - discoveredTests <- findTests "test/SubMod/" ignoreModuleConfig + let ignoreModuleConfig = (defaultConfig "test/SubMod") { ignores = Just "*.hs" } + discoveredTests <- findTests ignoreModuleConfig discoveredTests `shouldBe` [] spec_badModuleGlob :: Spec spec_badModuleGlob = describe "Module suffix configuration" $ do it "Filters discovered tests by specified suffix" $ do - let badGlobConfig = defaultConfig { modules = Just "DoesntExist*.hs" } - discoveredTests <- findTests "test/SubMod/" badGlobConfig + let badGlobConfig = (defaultConfig "test/SubMod") { modules = Just "DoesntExist*.hs" } + discoveredTests <- findTests badGlobConfig discoveredTests `shouldBe` [] spec_customModuleName :: Spec spec_customModuleName = describe "Module name configuration" $ do it "Creates a generated main function with the specified name" $ do - let generatedModule = generateTestDriver defaultConfig "FunkyModuleName" [] "test/" [] + let generatedModule = generateTestDriver (defaultConfig "test/") "FunkyModuleName" [] "test/" [] "FunkyModuleName" `shouldSatisfy` (`isInfixOf` generatedModule) unit_noTreeDisplayDefault :: IO () unit_noTreeDisplayDefault = do - tests <- findTests "test/SubMod/" defaultConfig + let config = defaultConfig "test/SubMod" + tests <- findTests config let testNumVars = map (('t' :) . show) [(0::Int)..] - trees = showTests defaultConfig tests testNumVars + trees = showTests config tests testNumVars length trees @?= 4 unit_treeDisplay :: IO () unit_treeDisplay = do - let config = defaultConfig { treeDisplay = True } - tests <- findTests "test/SubMod/" config + let config = (defaultConfig "test/SubMod") { treeDisplay = True } + tests <- findTests config let testNumVars = map (('t' :) . show) [(0::Int)..] trees = showTests config tests testNumVars length trees @?= 3 diff --git a/test/DiscoverTest.hs b/test/DiscoverTest.hs --- a/test/DiscoverTest.hs +++ b/test/DiscoverTest.hs @@ -1,12 +1,16 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module DiscoverTest where import Data.List import Test.Tasty -import Test.Tasty.Hspec import Test.Tasty.HUnit import Test.Tasty.QuickCheck +import Test.Hspec.Core.Spec (Spec, describe, it) +import Test.Hspec (shouldBe) import qualified Hedgehog as H import qualified Hedgehog.Gen as G @@ -43,7 +47,7 @@ test_generateTrees :: IO [TestTree] test_generateTrees = pure (map (\s -> testCase s $ pure ()) ["First input", "Second input"]) -{-# ANN hprop_reverse "HLint: ignore Avoid reverse" #-} +{- HLINT ignore "Avoid reverse" -} hprop_reverse :: H.Property hprop_reverse = H.property $ do xs <- H.forAll $ G.list (R.linear 0 100) G.alpha diff --git a/test/Driver.hs b/test/Driver.hs --- a/test/Driver.hs +++ b/test/Driver.hs @@ -1,1 +1,99 @@ -{-# OPTIONS_GHC -F -pgmF tasty-discover #-} +{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --in-place #-} +-- GENERATED BY tasty-discover +{-# LANGUAGE FlexibleInstances #-} + +module Main (main, ingredients, tests) where + +import Prelude + +import qualified System.Environment as E +import qualified Test.Tasty as T +import qualified Test.Tasty.Ingredients as T +import qualified Test.Tasty.Hedgehog as H + +import qualified Test.Tasty.QuickCheck as QC + +import qualified Test.Tasty.SmallCheck as SC + +import qualified Test.Tasty.Hspec as HS + + +import qualified Test.Tasty.HUnit as HU + +import qualified ConfigTest + +import qualified DiscoverTest + +import qualified SubMod.FooBaz + +import qualified SubMod.PropTest + +import qualified SubMod.SubSubMod.PropTest + +{- HLINT ignore "Use let" -} + + + + + +class TestGroup a where testGroup :: String -> a -> IO T.TestTree +instance TestGroup T.TestTree where testGroup _ a = pure a +instance TestGroup [T.TestTree] where testGroup n a = pure $ T.testGroup n a +instance TestGroup (IO T.TestTree) where testGroup _ a = a +instance TestGroup (IO [T.TestTree]) where testGroup n a = T.testGroup n <$> a + +class TestCase a where testCase :: String -> a -> IO T.TestTree +instance TestCase (IO ()) where testCase n = pure . HU.testCase n +instance TestCase (IO String) where testCase n = pure . HU.testCaseInfo n +instance TestCase ((String -> IO ()) -> IO ()) where testCase n = pure . HU.testCaseSteps n + +tests :: IO T.TestTree +tests = do + t0 <- HS.testSpec "modules" ConfigTest.spec_modules + + t1 <- HS.testSpec "ignores" ConfigTest.spec_ignores + + t2 <- HS.testSpec "badModuleGlob" ConfigTest.spec_badModuleGlob + + t3 <- HS.testSpec "customModuleName" ConfigTest.spec_customModuleName + + t4 <- testCase "noTreeDisplayDefault" ConfigTest.unit_noTreeDisplayDefault + + t5 <- testCase "treeDisplay" ConfigTest.unit_treeDisplay + + t6 <- pure $ QC.testProperty "mkModuleTree" ConfigTest.prop_mkModuleTree + + t7 <- testCase "listCompare" DiscoverTest.unit_listCompare + + t8 <- pure $ QC.testProperty "additionCommutative" DiscoverTest.prop_additionCommutative + + t9 <- pure $ SC.testProperty "sortReverse" DiscoverTest.scprop_sortReverse + + t10 <- HS.testSpec "prelude" DiscoverTest.spec_prelude + + t11 <- testGroup "addition" DiscoverTest.test_addition + + t12 <- testGroup "multiplication" DiscoverTest.test_multiplication + + t13 <- testGroup "generateTree" DiscoverTest.test_generateTree + + t14 <- testGroup "generateTrees" DiscoverTest.test_generateTrees + + t15 <- pure $ H.testProperty "reverse" DiscoverTest.hprop_reverse + + t16 <- pure $ QC.testProperty "additionCommutative" SubMod.FooBaz.prop_additionCommutative + + t17 <- pure $ QC.testProperty "multiplationDistributiveOverAddition" SubMod.FooBaz.prop_multiplationDistributiveOverAddition + + t18 <- pure $ QC.testProperty "additionAssociative" SubMod.PropTest.prop_additionAssociative + + t19 <- pure $ QC.testProperty "additionCommutative" SubMod.SubSubMod.PropTest.prop_additionCommutative + + pure $ T.testGroup "test/Driver.hs" [t0,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,t17,t18,t19] +ingredients :: [T.Ingredient] +ingredients = T.defaultIngredients +main :: IO () +main = do + args <- E.getArgs + E.withArgs ([] ++ args) $ tests >>= T.defaultMainWithIngredients ingredients +