diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,35 @@ +# 1.1.20 + +* Append the base name of the calling executable to the name of the default log file. +* Use `System.IO.readFile'` to read the state. + +# 1.1.19 + +* Support tasty 1.5. + +# 1.1.18 + +* Support tasty 1.4. + +# 1.1.17 + +* Add `defaultMainWithRerun`, + a drop-in replacement for `defaultMain`. + +# 1.1.16 + +* New command-line option `--rerun-all-on-success`. +* New command-line shortcut `--rerun`. + +# 1.1.15 + +* Bump upper bound of base. +* Restore missing -j command-line option. + +# 1.1.14 + +* Support tasty 1.2. + # 1.1.13 * Bump upper bound of base. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,67 @@ +# tasty-rerun + +This `Ingredient` for [`tasty`](https://hackage.haskell.org/package/tasty) testing framework +allows to filter a test tree depending +on an outcome of the previous run. +This may be useful in many scenarios, +especially when a test suite grows large. + +For example, `tasty-rerun` allows: + +* Rerun only tests, which failed during the last run (`--rerun`). + Combined with live reloading (e. g., using `ghcid` or `stack test --file-watch`), + it gives an ultimate power to focus on broken parts + and put them back in shape, enjoying a tight feedback loop. +* Rerun only tests, which have beed added since the last saved test run. + This comes handy when writing a new module, which does not affect other + parts of the system, or adding new test cases. +* Rerun only tests, which passed during the last saved test run. + Sometimes a part of the test suite is consistently failing + (e. g., an external service is temporarily down), but you want be sure + that you are not breaking anything else in course of your work. + +To add it to your test suite just replace `Test.Tasty.defaultMain` +with `Test.Tasty.Ingredients.Rerun.defaultMainWithRerun`: + +```haskell +import Test.Tasty +import Test.Tasty.Ingredients.Rerun + +main :: IO () +main = defaultMainWithRerun tests + +tests :: TestTree +tests = undefined +``` + +Use `--help` to list command-line options: + +* `--rerun` + + Rerun only tests, which failed during the last run. + If the last run was successful, execute a full test + suite afresh. A shortcut for `--rerun-update + --rerun-filter failures,exceptions + --rerun-all-on-success`. + +* `--rerun-update` + + Update the log file to reflect latest test outcomes. + +* `--rerun-filter CATEGORIES` + + Read the log file and rerun only tests from a given + comma-separated list of categories: `failures`, + `exceptions`, `new`, `successful`. If this option is + omitted or the log file is missing, rerun everything. + +* `--rerun-all-on-success` + + If according to the log file and `--rerun-filter` there + is nothing left to rerun, run all tests. This comes + especially handy in `stack test --file-watch` or + `ghcid` scenarios. + +* `--rerun-log-file FILE` + + Location of the log file (default: `.tasty-rerun-log`). diff --git a/src/Test/Tasty/Ingredients/Rerun.hs b/src/Test/Tasty/Ingredients/Rerun.hs --- a/src/Test/Tasty/Ingredients/Rerun.hs +++ b/src/Test/Tasty/Ingredients/Rerun.hs @@ -1,23 +1,83 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} -module Test.Tasty.Ingredients.Rerun (rerunningTests) where +-- | +-- Module: Test.Tasty.Ingredients.Rerun +-- Copyright: Oliver Charles (c) 2014, Andrew Lelechenko (c) 2019 +-- Licence: BSD3 +-- +-- This ingredient +-- for testing framework +-- allows to filter a test tree depending +-- on an outcome of the previous run. +-- This may be useful in many scenarios, +-- especially when a test suite grows large. +-- +-- The behaviour is controlled by command-line options: +-- +-- * @--rerun@ @ @ +-- +-- Rerun only tests, which failed during the last run. +-- If the last run was successful, execute a full test +-- suite afresh. A shortcut for @--rerun-update@ +-- @--rerun-filter failures,exceptions@ +-- @--rerun-all-on-success@. +-- +-- * @--rerun-update@ @ @ +-- +-- Update the log file to reflect latest test outcomes. +-- +-- * @--rerun-filter@ @CATEGORIES@ +-- +-- Read the log file and rerun only tests from a given +-- comma-separated list of categories: @failures@, +-- @exceptions@, @new@, @successful@. If this option is +-- omitted or the log file is missing, rerun everything. +-- +-- * @--rerun-all-on-success@ @ @ +-- +-- If according to the log file and @--rerun-filter@ there +-- is nothing left to rerun, run all tests. This comes +-- especially handy in @stack test --file-watch@ or +-- @ghcid@ scenarios. +-- +-- * @--rerun-log-file@ @FILE@ +-- +-- Location of the log file (default: @.tasty-rerun-log@). +-- +-- To add it to your test suite just replace +-- 'Tasty.defaultMain' with +-- 'defaultMainWithRerun' or wrap arguments +-- of 'Tasty.defaultMainWithIngredients' +-- into 'rerunningTests'. -import Prelude hiding (filter) +module Test.Tasty.Ingredients.Rerun + ( defaultMainWithRerun + , rerunningTests + ) where -import Control.Applicative +import Prelude (Enum, Bounded, minBound, maxBound, error, (+)) + +import Control.Applicative (Const(..), (<$>), pure, (<$)) import Control.Arrow ((>>>)) -import Control.Monad (when) +import Control.Monad (when, return, fmap, mapM, (>>=)) import Control.Monad.Trans.Class (lift) -import Data.Char (isSpace) +import Data.Bool (Bool (..), otherwise, not, (&&)) +import Data.Char (isSpace, toLower) +import Data.Eq (Eq) import Data.Foldable (asum) +import Data.Function ((.), ($), flip, const) +import Data.Int (Int) +import Data.List (intercalate, lookup, map, (++), reverse, dropWhile) import Data.List.Split (endBy) -import Data.Maybe (fromMaybe) -import Data.Monoid (mconcat) +import Data.Maybe (fromMaybe, Maybe(..), maybe) +import Data.Monoid (Any(..), Monoid(..)) +import Data.Ord (Ord) import Data.Proxy (Proxy(..)) -import Data.Semigroup.Applicative (Traversal(..)) -import Data.Tagged (Tagged(..), untag) -import Data.Typeable (Typeable) -import System.IO.Error (catchIOError, isDoesNotExistError) +import Data.String (String) +import System.FilePath ((<.>), takeBaseName) +import System.IO (FilePath, IO, readFile', writeFile) +import System.IO.Error (catchIOError, isDoesNotExistError, ioError) +import System.IO.Unsafe (unsafePerformIO) +import Text.Read (Read, read) +import Text.Show (Show, show) import qualified Control.Concurrent.STM as STM import qualified Control.Monad.State as State @@ -26,98 +86,138 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Options.Applicative as OptParse +import qualified System.Environment import qualified Test.Tasty.Options as Tasty import qualified Test.Tasty.Runners as Tasty -------------------------------------------------------------------------------- -newtype RerunLogFile = RerunLogFile FilePath - deriving (Typeable) +data RerunLogFile + = DefaultRerunLogFile + | CustomRerunLogFile FilePath instance Tasty.IsOption RerunLogFile where - optionName = Tagged "rerun-log-file" - optionHelp = Tagged "The path to which rerun's state file should be saved" - defaultValue = RerunLogFile ".tasty-rerun-log" - parseValue = Just . RerunLogFile - + optionName = return "rerun-log-file" + optionHelp = return + ( "Location of the log file (default: " ++ + show (unsafePerformIO getDefaultLogfileName) ++ ")" + ) + defaultValue = DefaultRerunLogFile + parseValue = Just . CustomRerunLogFile + optionCLParser = Tasty.mkOptionCLParser (OptParse.metavar "FILE") -------------------------------------------------------------------------------- newtype UpdateLog = UpdateLog Bool - deriving (Typeable) instance Tasty.IsOption UpdateLog where - optionName = Tagged "rerun-update" - - optionHelp = Tagged "If present the log file will be updated, otherwise it \ - \will be left unchanged" - + optionName = return "rerun-update" + optionHelp = return "Update the log file to reflect latest test outcomes" defaultValue = UpdateLog False - - parseValue = Just . UpdateLog . const True - - optionCLParser = fmap UpdateLog $ OptParse.switch $ mconcat - [ OptParse.long name - , OptParse.help helpString - ] - where - name = untag (Tasty.optionName :: Tagged UpdateLog String) - helpString = untag (Tasty.optionHelp :: Tagged UpdateLog String) + parseValue = fmap UpdateLog . Tasty.safeReadBool + optionCLParser = Tasty.mkFlagCLParser mempty (UpdateLog True) -------------------------------------------------------------------------------- data Filter = Failures | Exceptions | New | Successful - deriving (Eq, Ord) + deriving (Eq, Ord, Enum, Bounded, Show) parseFilter :: String -> Maybe Filter -parseFilter "failures" = Just Failures -parseFilter "exceptions" = Just Exceptions -parseFilter "new" = Just New -parseFilter "successful" = Just Successful -parseFilter _ = Nothing +parseFilter s = lookup s (map (\x -> (map toLower (show x), x)) everything) -------------------------------------------------------------------------------- everything :: [Filter] -everything = [Failures, Exceptions, New, Successful] +everything = [minBound..maxBound] -------------------------------------------------------------------------------- newtype FilterOption = FilterOption (Set.Set Filter) - deriving (Typeable) instance Tasty.IsOption FilterOption where - optionName = Tagged "rerun-filter" - - optionHelp = Tagged "A comma separated list to specify which tests to run when\ - \ comparing against previous test runs. Valid options \ - \are: everything, failures, exceptions, new" - + optionName = return "rerun-filter" + optionHelp = return + $ "Read the log file and rerun only tests from a given comma-separated list of categories: " + ++ map toLower (intercalate ", " (map show everything)) + ++ ". If this option is omitted or the log file is missing, rerun everything." defaultValue = FilterOption (Set.fromList everything) - parseValue = fmap (FilterOption . Set.fromList) . mapM (parseFilter . trim) . endBy "," where trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace + optionCLParser = Tasty.mkOptionCLParser (OptParse.metavar "CATEGORIES") -------------------------------------------------------------------------------- +newtype AllOnSuccess = AllOnSuccess Bool + +instance Tasty.IsOption AllOnSuccess where + optionName = return "rerun-all-on-success" + optionHelp = return "If according to the log file and --rerun-filter there is nothing left to rerun, run all tests. This comes especially handy in `stack test --file-watch` or `ghcid` scenarios." + defaultValue = AllOnSuccess False + parseValue = fmap AllOnSuccess . Tasty.safeReadBool + optionCLParser = Tasty.mkFlagCLParser mempty (AllOnSuccess True) + +-------------------------------------------------------------------------------- +newtype Rerun = Rerun { unRerun :: Bool } + +instance Tasty.IsOption Rerun where + optionName = return "rerun" + optionHelp = return "Rerun only tests, which failed during the last run. If the last run was successful, execute a full test suite afresh. A shortcut for --rerun-update --rerun-filter failures,exceptions --rerun-all-on-success" + defaultValue = Rerun False + parseValue = fmap Rerun . Tasty.safeReadBool + optionCLParser = Tasty.mkFlagCLParser mempty (Rerun True) + +rerunMeaning :: (UpdateLog, AllOnSuccess, FilterOption) +rerunMeaning = (UpdateLog True, AllOnSuccess True, FilterOption (Set.fromList [Failures, Exceptions])) + +-------------------------------------------------------------------------------- data TestResult = Completed Bool | ThrewException deriving (Read, Show) -------------------------------------------------------------------------------- --- | This 'Tasty.Ingredient' transformer adds various @--rerun@ options to your --- test program. These flags add stateful execution of your test suite, allowing --- you to rerun only tests that are failing from the previous run, or tests that --- that have been added since the last test ran, once the 'Tasty.TestTree' has --- been filtered. + +-- | Drop-in replacement for 'Tasty.defaultMain'. -- --- The input list of 'Tasty.Ingredient's specifies the 'Tasty.Ingredients's that --- will actually work with the filtered 'Tasty.TestTree'. Normally, you'll want --- at least 'Tasty.Test.Runners.consoleTestReporter'. +-- > import Test.Tasty +-- > import Test.Tasty.Ingredients.Rerun +-- > +-- > main :: IO () +-- > main = defaultMainWithRerun tests +-- > +-- > tests :: TestTree +-- > tests = undefined +defaultMainWithRerun :: Tasty.TestTree -> IO () +defaultMainWithRerun = + Tasty.defaultMainWithIngredients + [ rerunningTests [ Tasty.listingTests, Tasty.consoleTestReporter ] ] + +-- | Ingredient transformer, to use with +-- 'Tasty.defaultMainWithIngredients'. +-- +-- > import Test.Tasty +-- > import Test.Tasty.Runners +-- > import Test.Tasty.Ingredients.Rerun +-- > +-- > main :: IO () +-- > main = +-- > defaultMainWithIngredients +-- > [ rerunningTests [ listingTests, consoleTestReporter ] ] +-- > tests +-- > +-- > tests :: TestTree +-- > tests = undefined rerunningTests :: [Tasty.Ingredient] -> Tasty.Ingredient rerunningTests ingredients = - Tasty.TestManager (rerunOptions ++ existingOptions) $ + Tasty.TestManager (rerunOptions ++ Tasty.ingredientsOptions ingredients) $ \options testTree -> Just $ do - let RerunLogFile stateFile = Tasty.lookupOption options - UpdateLog updateLog = Tasty.lookupOption options - FilterOption filter = Tasty.lookupOption options + stateFile <- case Tasty.lookupOption options of + DefaultRerunLogFile -> getDefaultLogfileName + CustomRerunLogFile stateFile -> return stateFile - filteredTestTree <- maybe testTree (filterTestTree testTree filter) + let (UpdateLog updateLog, AllOnSuccess allOnSuccess, FilterOption filter) + | unRerun (Tasty.lookupOption options) = rerunMeaning + | otherwise = (Tasty.lookupOption options, Tasty.lookupOption options, Tasty.lookupOption options) + + let nonEmptyFold = Tasty.trivialFold { Tasty.foldSingle = \_ _ _ -> Any True } + nullTestTree = not . getAny . Tasty.foldTestTree nonEmptyFold options + recoverFromEmpty t = if allOnSuccess && nullTestTree t then testTree else t + + filteredTestTree <- maybe testTree (recoverFromEmpty . filterTestTree testTree filter) <$> tryLoadStateFrom stateFile let tryAndRun (Tasty.TestReporter _ f) = do @@ -132,7 +232,7 @@ fmap getConst $ flip State.evalStateT 0 $ Functor.getCompose $ - getTraversal $ + Tasty.getTraversal $ Tasty.foldTestTree (observeResults statusMap) options filteredTestTree @@ -151,17 +251,15 @@ -- simply run the above constructed IO action. Just e -> e where - existingOptions = flip concatMap ingredients $ \ingredient -> - case ingredient of - Tasty.TestReporter options _ -> options - Tasty.TestManager options _ -> options - - rerunOptions = [ Tasty.Option (Proxy :: Proxy RerunLogFile) + rerunOptions = [ Tasty.Option (Proxy :: Proxy Rerun) , Tasty.Option (Proxy :: Proxy UpdateLog) , Tasty.Option (Proxy :: Proxy FilterOption) + , Tasty.Option (Proxy :: Proxy AllOnSuccess) + , Tasty.Option (Proxy :: Proxy RerunLogFile) ] ------------------------------------------------------------------------------ + filterTestTree :: Tasty.TestTree -> Set.Set Filter -> Map.Map [String] TestResult -> Tasty.TestTree filterTestTree testTree filter lastRecord = let go prefix (Tasty.SingleTest name t) = let requiredFilter = case Map.lookup (prefix ++ [name]) lastRecord of @@ -185,22 +283,30 @@ go prefix (Tasty.AskOptions k) = Tasty.AskOptions (go prefix <$> k) + go prefix (Tasty.After a b c) = + Tasty.After a b (go prefix c) + in go [] testTree + tryLoadStateFrom :: FilePath -> IO (Maybe (Map.Map [String] TestResult)) tryLoadStateFrom filePath = do - fileContents <- (Just <$> readFile filePath) + fileContents <- (Just <$> readFile' filePath) `catchIOError` (\e -> if isDoesNotExistError e then return Nothing else ioError e) return (read <$> fileContents) ------------------------------------------------------------------------------ + saveStateTo :: FilePath -> IO (Map.Map [String] TestResult) -> IO () saveStateTo filePath getTestResults = getTestResults >>= (show >>> writeFile filePath) ------------------------------------------------------------------------------ + observeResults + :: IntMap.IntMap (STM.TVar Tasty.Status) + -> Tasty.TreeFold (Tasty.Traversal (Functor.Compose (State.StateT Int IO) (Const (Map.Map [String] TestResult)))) observeResults statusMap = - let foldSingle _ name _ = Traversal $ Functor.Compose $ do + let foldSingle _ name _ = Tasty.Traversal $ Functor.Compose $ do i <- State.get status <- lift $ STM.atomically $ do @@ -215,16 +321,37 @@ Const (Map.singleton [name] status) <$ State.modify (+ 1) - foldGroup name children = Traversal $ Functor.Compose $ do - Const soFar <- Functor.getCompose $ getTraversal children + foldGroup name children = Tasty.Traversal $ Functor.Compose $ do + Const soFar <- Functor.getCompose $ Tasty.getTraversal children pure $ Const (Map.mapKeys (name :) soFar) in Tasty.trivialFold { Tasty.foldSingle = foldSingle - , Tasty.foldGroup = foldGroup + , Tasty.foldGroup = const (\name -> foldGroup name . mconcat) } where lookupStatus i = STM.readTVar $ fromMaybe (error "Attempted to lookup test by index outside bounds") (IntMap.lookup i statusMap) + +-- | Get the default log file name. +-- Whether a package-wide or a per-component log file name is returned depends +-- on the possibility to determine the path to the test executable reliably; See +-- 'System.Environment.executablePath'. +getDefaultLogfileName :: IO FilePath +getDefaultLogfileName = + logfileName <$> + fromMaybe (return Nothing) System.Environment.executablePath + +-- | Returns the default log file name. +-- The argument passed should be the file path of the test executable, if that +-- path is available. If @Nothing@ is passed, then a package-wide log file name +-- is returned, which may lead to problems; See +-- https://github.com/ocharles/tasty-rerun/issues/22 . +logfileName + :: Maybe FilePath -- ^ The file path of the test executable. + -> String -- ^ The Tasty Rerun log file name. +logfileName Nothing = ".tasty-rerun-log" +logfileName (Just executablePath) = + logfileName Nothing <.> takeBaseName executablePath diff --git a/tasty-rerun.cabal b/tasty-rerun.cabal --- a/tasty-rerun.cabal +++ b/tasty-rerun.cabal @@ -1,87 +1,50 @@ -name: tasty-rerun -version: 1.1.13 -homepage: http://github.com/ocharles/tasty-rerun -license: BSD3 -license-file: LICENSE -author: Oliver Charles -maintainer: ollie@ocharles.org.uk -copyright: Oliver Charles (c) 2014 -category: Testing -build-type: Simple -cabal-version: >=1.10 -extra-source-files: - Changelog.md +cabal-version: 2.2 +name: tasty-rerun +version: 1.1.20 +license: BSD-3-Clause +license-file: LICENSE +copyright: + Oliver Charles (c) 2014, + Andrew Lelechenko (c) 2019 -synopsis: - Run tests by filtering the test tree depending on the result of previous test - runs +maintainer: ollie@ocharles.org.uk +author: Oliver Charles +tested-with: + ghc ==9.12.1 ghc ==9.10.1 ghc ==9.8.4 ghc ==9.6.6 ghc ==9.4.8 +homepage: http://github.com/ocharles/tasty-rerun +synopsis: Rerun only tests which failed in a previous test run description: - This ingredient adds the ability to run tests by first filtering the test tree - based on the result of a previous test run. For example, you can use this to - run only those tests that failed in the last run, or to run only tests that - have been added since tests were last ran. - . - This ingredient is specifically an ingredient *transformer* - given a list of - 'Tasty.Ingredient's, 'rerunningTests' adds the ability for all of these - ingredients to run against a filtered test tree. This transformer can be - applied as follows: - . - > import Test.Tasty - > import Test.Tasty.Runners - > - > main :: IO () - > main = - > defaultMainWithIngredients - > [ rerunningTests [ listingTests, consoleTestReporter ] ] - > tests - > - > tests :: TestTree - > tests = undefined - . - This ingredient adds three command line parameters: - . - [@--rerun-update@] If specified the results of this test run will be saved to - the log file at @--rerun-log-file@. If the ingredient does not execute tests - (for example, @--list-tests@ is used) then the log file will not be - updated. This option is not enabled by default. This option does not require - a value. - . - [@--rerun-log-file@] The path to the log file to read previous test - information from, and where to write new information to (if @--rerun-update@ - is specified). This option defaults to @.tasty-rerun-log@. - . - [@--rerun-filter@] Which filters to apply to the 'Tasty.TestTree' based on - previous test runs. The value of this option is a comma separated list of the - following options: - . - * @failures@: Only run tests that failed on the previous run. - . - * @exceptions@: Only run tests that threw an exception on the previous run. - . - * @new@: Only run tests that are new since the previous test run. - . - * @successful@: Only run tests that were successful in the previous run. - . - Multiple options can be combined and will be taken under disjunction - so - @--rerun-filter=failures,exceptions@ will run only tests that failed *or* - threw an exception on the last run. - . - Defaults to all filters, which means all tests will be ran. + This ingredient + for the testing framework + allows filtering a test tree depending + on the outcome of the previous run. + This may be useful in many scenarios, + especially when a test suite grows large. +category: Testing +build-type: Simple +extra-doc-files: + Changelog.md + README.md + +source-repository head + type: git + location: https://github.com/ocharles/tasty-rerun + library - exposed-modules: Test.Tasty.Ingredients.Rerun - build-depends: - base >=4.6 && <4.13, - containers >= 0.5.0.0, - mtl >= 2.1.2, - optparse-applicative >= 0.6, - reducers >= 3.10.1, - split >= 0.1 && < 0.3, - stm >= 2.4.2, - tagged >= 0.7 && <0.9, - tasty >=0.10 && <1.2, - transformers >= 0.3.0.0 - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall + exposed-modules: Test.Tasty.Ingredients.Rerun + hs-source-dirs: src + default-language: GHC2021 + ghc-options: -Wall -Wcompat + build-depends: + base >=4.17 && <4.22, + containers >=0.5.0.0 && <0.9, + filepath <1.6, + mtl >=2.1.2 && <2.4, + optparse-applicative >=0.6 && <0.19, + split >=0.1 && <0.3, + stm >=2.4.2 && <2.6, + tagged >=0.7 && <0.9, + tasty >=1.5 && <1.6, + transformers >=0.3.0.0 && <0.7