tasty-0.11.0.4/Test/0000755000000000000000000000000012712711333012204 5ustar0000000000000000tasty-0.11.0.4/Test/Tasty/0000755000000000000000000000000012757050475013324 5ustar0000000000000000tasty-0.11.0.4/Test/Tasty/Ingredients/0000755000000000000000000000000012620434424015564 5ustar0000000000000000tasty-0.11.0.4/Test/Tasty/Options/0000755000000000000000000000000012757050475014757 5ustar0000000000000000tasty-0.11.0.4/Test/Tasty/Runners/0000755000000000000000000000000012515644713014754 5ustar0000000000000000tasty-0.11.0.4/Test/Tasty.hs0000644000000000000000000000637012712335540013654 0ustar0000000000000000-- | This module defines the main data types and functions needed to use -- Tasty. module Test.Tasty ( -- * Organizing tests TestName , TestTree , testGroup -- * Running tests , defaultMain , defaultMainWithIngredients , defaultIngredients , includingOptions -- * Adjusting and querying options -- | Normally options are specified on the command line. But you can -- also have different options for different subtrees in the same tree, -- using the functions below. -- -- Note that /ingredient options/ (number of threads, hide successes -- etc.) set in this way will not have any effect. This is for modifying -- per-test options, such as timeout, number of generated tests etc. , adjustOption , localOption , askOption -- ** Standard options , Timeout(..) , mkTimeout -- * Resources -- | Sometimes several tests need to access the same resource — say, -- a file or a socket. We want to create or grab the resource before -- the tests are run, and destroy or release afterwards. , withResource ) where import Test.Tasty.Core import Test.Tasty.Runners import Test.Tasty.Options import Test.Tasty.Options.Core import Test.Tasty.Ingredients.Basic -- | List of the default ingredients. This is what 'defaultMain' uses. -- -- At the moment it consists of 'listingTests' and 'consoleTestReporter'. defaultIngredients :: [Ingredient] defaultIngredients = [listingTests, consoleTestReporter] -- | Parse the command line arguments and run the tests. -- -- When the tests finish, this function calls 'exitWith' with the exit code -- that indicates whether any tests have failed. Most external systems -- (stack, cabal, travis-ci, jenkins etc.) rely on the exit code to detect -- whether the tests pass. If you want to do something else after -- `defaultMain` returns, you need to catch the exception and then re-throw -- it. Example: -- -- >import Test.Tasty -- >import Test.Tasty.HUnit -- >import System.Exit -- >import Control.Exception -- > -- >test = testCase "Test 1" (2 @?= 3) -- > -- >main = defaultMain test -- > `catch` (\e -> do -- > if e == ExitSuccess -- > then putStrLn "Yea" -- > else putStrLn "Nay" -- > throwIO e) defaultMain :: TestTree -> IO () defaultMain = defaultMainWithIngredients defaultIngredients -- | Locally adjust the option value for the given test subtree adjustOption :: IsOption v => (v -> v) -> TestTree -> TestTree adjustOption f = PlusTestOptions $ \opts -> setOption (f $ lookupOption opts) opts -- | Locally set the option value for the given test subtree localOption :: IsOption v => v -> TestTree -> TestTree localOption v = PlusTestOptions (setOption v) -- | Customize the test tree based on the run-time options askOption :: IsOption v => (v -> TestTree) -> TestTree askOption f = AskOptions $ f . lookupOption -- | Acquire the resource to run this test (sub)tree and release it -- afterwards withResource :: IO a -- ^ initialize the resource -> (a -> IO ()) -- ^ free the resource -> (IO a -> TestTree) -- ^ @'IO' a@ is an action which returns the acquired resource. -- Despite it being an 'IO' action, the resource it returns will be -- acquired only once and shared across all the tests in the tree. -> TestTree withResource acq rel = WithResource (ResourceSpec acq rel) tasty-0.11.0.4/Test/Tasty/Options.hs0000644000000000000000000001076212457221174015312 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, ExistentialQuantification, GADTs, OverlappingInstances, FlexibleInstances, UndecidableInstances, TypeOperators #-} -- | Extensible options. They are used for provider-specific settings, -- ingredient-specific settings and core settings (such as the test name pattern). module Test.Tasty.Options ( -- * IsOption class IsOption(..) -- * Option sets and operations , OptionSet , setOption , changeOption , lookupOption , singleOption , OptionDescription(..) -- * Utilities , flagCLParser , safeRead ) where import Data.Typeable import qualified Data.Map as Map import Data.Map (Map) import Data.Tagged import Data.Proxy import Data.Monoid import Data.Foldable import Options.Applicative -- | An option is a data type that inhabits the `IsOption` type class. class Typeable v => IsOption v where -- | The value to use if the option was not supplied explicitly defaultValue :: v -- | Try to parse an option value from a string parseValue :: String -> Maybe v -- | The option name. It is used to form the command line option name, for -- instance. Therefore, it had better not contain spaces or other fancy -- characters. It is recommended to use dashes instead of spaces. optionName :: Tagged v String -- | The option description or help string. This can be an arbitrary -- string. optionHelp :: Tagged v String -- | A command-line option parser. -- -- It has a default implementation in terms of the other methods. -- You may want to override it in some cases (e.g. add a short flag). -- -- Even if you override this, you still should implement all the methods -- above, to allow alternative interfaces. -- -- Do not supply a default value here for this parser! -- This is because if no value was provided on the command line we may -- lookup the option e.g. in the environment. But if the parser always -- succeeds, we have no way to tell whether the user really provided the -- option on the command line. -- (If we don't specify a default, the option becomes mandatory. -- So, when we build the complete parser for OptionSet, we turn a -- failing parser into an always-succeeding one that may return an empty -- OptionSet.) optionCLParser :: Parser v optionCLParser = option parse ( long name <> help helpString ) where name = untag (optionName :: Tagged v String) helpString = untag (optionHelp :: Tagged v String) parse = str >>= maybe (readerError $ "Could not parse " ++ name) pure <$> parseValue data OptionValue = forall v . IsOption v => OptionValue v -- | A set of options. Only one option of each type can be kept. -- -- If some option has not been explicitly set, the default value is used. newtype OptionSet = OptionSet (Map TypeRep OptionValue) -- | Later options override earlier ones instance Monoid OptionSet where mempty = OptionSet mempty OptionSet a `mappend` OptionSet b = OptionSet $ Map.unionWith (flip const) a b -- | Set the option value setOption :: IsOption v => v -> OptionSet -> OptionSet setOption v (OptionSet s) = OptionSet $ Map.insert (typeOf v) (OptionValue v) s -- | Query the option value lookupOption :: forall v . IsOption v => OptionSet -> v lookupOption (OptionSet s) = case Map.lookup (typeOf (undefined :: v)) s of Just (OptionValue x) | Just v <- cast x -> v Just {} -> error "OptionSet: broken invariant (shouldn't happen)" Nothing -> defaultValue -- | Change the option value changeOption :: forall v . IsOption v => (v -> v) -> OptionSet -> OptionSet changeOption f s = setOption (f $ lookupOption s) s -- | Create a singleton 'OptionSet' singleOption :: IsOption v => v -> OptionSet singleOption v = setOption v mempty -- | The purpose of this data type is to capture the dictionary -- corresponding to a particular option. data OptionDescription where Option :: IsOption v => Proxy v -> OptionDescription -- | Command-line parser to use with flags flagCLParser :: forall v . IsOption v => Maybe Char -- ^ optional short flag -> v -- ^ non-default value (when the flag is supplied) -> Parser v flagCLParser mbShort v = flag' v ( foldMap short mbShort <> long (untag (optionName :: Tagged v String)) <> help (untag (optionHelp :: Tagged v String)) ) -- | Safe read function. Defined here for convenience to use for -- 'parseValue'. safeRead :: Read a => String -> Maybe a safeRead s | [(x, "")] <- reads s = Just x | otherwise = Nothing tasty-0.11.0.4/Test/Tasty/Providers.hs0000644000000000000000000000144512573536673015646 0ustar0000000000000000-- | API for test providers module Test.Tasty.Providers ( IsTest(..) , testPassed , testFailed , Result , Progress(..) , TestName , TestTree , singleTest ) where import Test.Tasty.Core -- | Convert a test to a leaf of the 'TestTree' singleTest :: IsTest t => TestName -> t -> TestTree singleTest = SingleTest -- | 'Result' of a passed test testPassed :: String -- ^ description (may be empty) -> Result testPassed desc = Result { resultOutcome = Success , resultDescription = desc , resultShortDescription = "OK" , resultTime = 0 } -- | 'Result' of a failed test testFailed :: String -- ^ description -> Result testFailed desc = Result { resultOutcome = Failure TestFailed , resultDescription = desc , resultShortDescription = "FAIL" , resultTime = 0 } tasty-0.11.0.4/Test/Tasty/Runners.hs0000644000000000000000000000254412457221174015312 0ustar0000000000000000-- | API for test runners module Test.Tasty.Runners ( -- * Working with the test tree TestTree(..) , foldTestTree , TreeFold(..) , trivialFold , ResourceSpec(..) , module Test.Tasty.Runners.Reducers -- * Ingredients , Ingredient(..) , Time , tryIngredients , ingredientOptions , ingredientsOptions -- * Standard console ingredients -- | NOTE: the exports in this section are deprecated and will be -- removed in the future. Please import "Test.Tasty.Ingredients.Basic" -- if you need them. -- ** Console test reporter , consoleTestReporter -- ** Tests list , listingTests , ListTests(..) , testsNames -- * Command line handling , optionParser , suiteOptionParser , defaultMainWithIngredients -- * Running tests , Status(..) , Result(..) , Outcome(..) , FailureReason(..) , resultSuccessful , Progress(..) , StatusMap , launchTestTree , NumThreads(..) -- * Options , suiteOptions , coreOptions -- ** Patterns , module Test.Tasty.Patterns -- * Utilities , module Test.Tasty.Runners.Utils ) where import Test.Tasty.Core import Test.Tasty.Run import Test.Tasty.Ingredients import Test.Tasty.Options.Core import Test.Tasty.Patterns import Test.Tasty.CmdLine import Test.Tasty.Ingredients.Basic import Test.Tasty.Runners.Reducers import Test.Tasty.Runners.Utils tasty-0.11.0.4/Test/Tasty/Ingredients.hs0000644000000000000000000001143212520473257016127 0ustar0000000000000000-- | This module contains the core definitions related to ingredients. -- -- Ingredients themselves are provided by other modules (usually under -- the @Test.Tasty.Ingredients.*@ hierarchy). module Test.Tasty.Ingredients ( Ingredient(..) , tryIngredients , ingredientOptions , ingredientsOptions , suiteOptions ) where import Control.Monad import Data.Proxy import qualified Data.Foldable as F import Test.Tasty.Core import Test.Tasty.Run import Test.Tasty.Options import Test.Tasty.Options.Core -- | 'Ingredient's make your test suite tasty. -- -- Ingredients represent different actions that you can perform on your -- test suite. One obvious ingredient that you want to include is -- one that runs tests and reports the progress and results. -- -- Another standard ingredient is one that simply prints the names of all -- tests. -- -- Similar to test providers (see 'IsTest'), every ingredient may specify -- which options it cares about, so that those options are presented to -- the user if the ingredient is included in the test suite. -- -- An ingredient can choose, typically based on the 'OptionSet', whether to -- run. That's what the 'Maybe' is for. The first ingredient that agreed to -- run does its work, and the remaining ingredients are ignored. Thus, the -- order in which you arrange the ingredients may matter. -- -- Usually, the ingredient which runs the tests is unconditional and thus -- should be placed last in the list. Other ingredients usually run only -- if explicitly requested via an option. Their relative order thus doesn't -- matter. -- -- That's all you need to know from an (advanced) user perspective. Read -- on if you want to create a new ingredient. -- -- There are two kinds of ingredients. -- -- The first kind is 'TestReporter'. If the ingredient that agrees to run -- is a 'TestReporter', then tasty will automatically launch the tests and -- pass a 'StatusMap' to the ingredient. All the ingredient needs to do -- then is to process the test results and probably report them to the user -- in some way (hence the name). -- -- 'TestManager' is the second kind of ingredient. It is typically used for -- test management purposes (such as listing the test names), although it -- can also be used for running tests (but, unlike 'TestReporter', it has -- to launch the tests manually if it wants them to be run). It is -- therefore more general than 'TestReporter'. 'TestReporter' is provided -- just for convenience. -- -- The function's result should indicate whether all the tests passed. -- -- In the 'TestManager' case, it's up to the ingredient author to decide -- what the result should be. When no tests are run, the result should -- probably be 'True'. Sometimes, even if some tests run and fail, it still -- makes sense to return 'True'. data Ingredient = TestReporter [OptionDescription] (OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool))) -- ^ For the explanation on how the callback works, see the -- documentation for 'launchTestTree'. | TestManager [OptionDescription] (OptionSet -> TestTree -> Maybe (IO Bool)) -- | Try to run an 'Ingredient'. -- -- If the ingredient refuses to run (usually based on the 'OptionSet'), -- the function returns 'Nothing'. -- -- For a 'TestReporter', this function automatically starts running the -- tests in the background. tryIngredient :: Ingredient -> OptionSet -> TestTree -> Maybe (IO Bool) tryIngredient (TestReporter _ report) opts testTree = do -- Maybe monad reportFn <- report opts testTree return $ launchTestTree opts testTree $ \smap -> reportFn smap tryIngredient (TestManager _ manage) opts testTree = manage opts testTree -- | Run the first 'Ingredient' that agrees to be run. -- -- If no one accepts the task, return 'Nothing'. This is usually a sign of -- misconfiguration. tryIngredients :: [Ingredient] -> OptionSet -> TestTree -> Maybe (IO Bool) tryIngredients ins opts tree = msum $ map (\i -> tryIngredient i opts tree) ins -- | Return the options which are relevant for the given ingredient. -- -- Note that this isn't the same as simply pattern-matching on -- 'Ingredient'. E.g. options for a 'TestReporter' automatically include -- 'NumThreads'. ingredientOptions :: Ingredient -> [OptionDescription] ingredientOptions (TestReporter opts _) = Option (Proxy :: Proxy NumThreads) : opts ingredientOptions (TestManager opts _) = opts -- | Like 'ingredientOption', but folds over multiple ingredients. ingredientsOptions :: [Ingredient] -> [OptionDescription] ingredientsOptions = F.foldMap ingredientOptions -- | All the options relevant for this test suite. This includes the -- options for the test tree and ingredients, and the core options. suiteOptions :: [Ingredient] -> TestTree -> [OptionDescription] suiteOptions ins tree = coreOptions ++ ingredientsOptions ins ++ treeOptions tree tasty-0.11.0.4/Test/Tasty/Ingredients/Basic.hs0000644000000000000000000000113312457221174017143 0ustar0000000000000000-- | This module exports the basic ingredients defined in the 'tasty' -- packages. -- -- Note that if @defaultIngredients@ from "Test.Tasty" suits your needs, -- use that instead of importing this module. module Test.Tasty.Ingredients.Basic ( -- ** Console test reporter consoleTestReporter , Quiet(..) , HideSuccesses(..) -- ** Listing tests , listingTests , ListTests(..) , testsNames -- ** Adding options , includingOptions ) where import Test.Tasty.Ingredients.ConsoleReporter import Test.Tasty.Ingredients.ListTests import Test.Tasty.Ingredients.IncludingOptions tasty-0.11.0.4/Test/Tasty/Parallel.hs0000644000000000000000000001171212457221174015407 0ustar0000000000000000-- | A helper module which takes care of parallelism {-# LANGUAGE DeriveDataTypeable #-} module Test.Tasty.Parallel (runInParallel) where import Control.Monad import Control.Concurrent import Control.Concurrent.STM import Control.Exception import Foreign.StablePtr import Data.Typeable import GHC.Conc (labelThread) data Interrupt = Interrupt deriving Typeable instance Show Interrupt where show Interrupt = "interrupted" instance Exception Interrupt data ParThreadKilled = ParThreadKilled SomeException deriving Typeable instance Show ParThreadKilled where show (ParThreadKilled exn) = "tasty: one of the test running threads was killed by: " ++ show exn instance Exception ParThreadKilled shutdown :: ThreadId -> IO () shutdown = flip throwTo Interrupt -- | Take a list of actions and execute them in parallel, no more than @n@ -- at the same time. -- -- The action itself is asynchronous, ie. it returns immediately and does -- the work in new threads. It returns an action which aborts tests and -- cleans up. runInParallel :: Int -- ^ maximum number of parallel threads -> [IO ()] -- ^ list of actions to execute -> IO (IO ()) -- This implementation tries its best to ensure that exceptions are -- properly propagated to the caller and threads are not left running. -- -- Note that exceptions inside tests are already caught by the test -- actions themselves. Any exceptions that reach this function or its -- threads are by definition unexpected. runInParallel nthreads actions = do callingThread <- myThreadId -- Don't let the main thread be garbage-collected -- Otherwise we may get a "thread blocked indefinitely in an STM -- transaction" exception when a child thread is blocked and GC'd. -- (See e.g. https://github.com/feuerbach/tasty/issues/15) _ <- newStablePtr callingThread -- A variable containing all ThreadIds of forked threads. -- -- These are the threads we'll need to kill if something wrong happens. pidsVar <- atomically $ newTVar [] -- If an unexpected exception has been thrown and we started killing all -- the spawned threads, this flag will be set to False, so that any -- freshly spawned threads will know to terminate, even if their pids -- didn't make it to the "kill list" yet. aliveVar <- atomically $ newTVar True let -- Kill all threads. shutdownAll :: IO () shutdownAll = do pids <- atomically $ do writeTVar aliveVar False readTVar pidsVar -- be sure not to kill myself! me <- myThreadId mapM_ shutdown $ filter (/= me) pids cleanup :: Either SomeException () -> IO () cleanup Right {} = return () cleanup (Left exn) | Just Interrupt <- fromException exn -- I'm being shut down either by a fellow thread (which caught an -- exception), or by the main thread which decided to stop running -- tests. In any case, just end silently. = return () | otherwise = do -- Wow, I caught an exception (most probably an async one, -- although it doesn't really matter). Shut down all other -- threads, and re-throw my exception to the calling thread. shutdownAll throwTo callingThread $ ParThreadKilled exn forkCarefully :: IO () -> IO ThreadId forkCarefully action = flip myForkFinally cleanup $ do -- We cannot check liveness and update the pidsVar in one -- transaction before forking, because we don't know the new pid yet. -- -- So we fork and then check/update. If something has happened in -- the meantime, it's not a big deal — we just cancel. OTOH, if -- we're alive at the time of the transaction, then we add our pid -- and will be killed when something happens. newPid <- myThreadId join . atomically $ do alive <- readTVar aliveVar if alive then do modifyTVar pidsVar (newPid :) return action else return (return ()) capsVar <- atomically $ newTVar nthreads let go a cont = join . atomically $ do caps <- readTVar capsVar if caps > 0 then do writeTVar capsVar $! caps - 1 let release = atomically $ modifyTVar' capsVar (+1) -- Thanks to our exception handling, we won't deadlock even if -- an exception strikes before we 'release'. Everything will be -- killed, so why bother. return $ do pid <- forkCarefully (do a; release) labelThread pid "tasty_test_thread" cont else retry -- fork here as well, so that we can move to the UI without waiting -- untill all tests have finished pid <- forkCarefully $ foldr go (return ()) actions labelThread pid "tasty_thread_manager" return shutdownAll -- Copied from base to stay compatible with GHC 7.4. myForkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId myForkFinally action and_then = mask $ \restore -> forkIO $ try (restore action) >>= and_then tasty-0.11.0.4/Test/Tasty/Core.hs0000644000000000000000000002131312622727256014547 0ustar0000000000000000-- | Core types and definitions {-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts, ExistentialQuantification, RankNTypes, DeriveDataTypeable, DeriveGeneric #-} module Test.Tasty.Core where import Control.Exception import Test.Tasty.Options import Test.Tasty.Patterns import Data.Foldable import Data.Monoid import Data.Typeable import qualified Data.Map as Map import Data.Tagged import GHC.Generics import Text.Printf -- | If a test failed, 'FailureReason' describes why data FailureReason = TestFailed -- ^ test provider indicated failure of the code to test, either because -- the tested code returned wrong results, or raised an exception | TestThrewException SomeException -- ^ the test code itself raised an exception. Typical cases include missing -- example input or output files. -- -- Usually, providers do not have to implement this, as their 'run' method -- may simply raise an exception. | TestTimedOut Integer -- ^ test didn't complete in allotted time deriving Show -- | Outcome of a test run -- -- Note: this is isomorphic to @'Maybe' 'FailureReason'@. You can use the -- @generic-maybe@ package to exploit that. data Outcome = Success -- ^ test succeeded | Failure FailureReason -- ^ test failed because of the 'FailureReason' deriving (Show, Generic) -- | Time in seconds. Used to measure how long the tests took to run. type Time = Double -- | A test result data Result = Result { resultOutcome :: Outcome -- ^ Did the test fail? If so, why? , resultDescription :: String -- ^ -- 'resultDescription' may contain some details about the test. For -- a passed test it's ok to leave it empty. Providers like SmallCheck and -- QuickCheck use it to provide information about how many tests were -- generated. -- -- For a failed test, 'resultDescription' should typically provide more -- information about the failure. , resultShortDescription :: String -- ^ The short description printed in the test run summary, usually @OK@ or -- @FAIL@. , resultTime :: Time -- ^ How long it took to run the test, in seconds. } -- | 'True' for a passed test, 'False' for a failed one. resultSuccessful :: Result -> Bool resultSuccessful r = case resultOutcome r of Success -> True Failure {} -> False -- | Shortcut for creating a 'Result' that indicates exception exceptionResult :: SomeException -> Result exceptionResult e = Result { resultOutcome = Failure $ TestThrewException e , resultDescription = "Exception: " ++ show e , resultShortDescription = "FAIL" , resultTime = 0 } -- | Test progress information. -- -- This may be used by a runner to provide some feedback to the user while -- a long-running test is executing. data Progress = Progress { progressText :: String -- ^ textual information about the test's progress , progressPercent :: Float -- ^ -- 'progressPercent' should be a value between 0 and 1. If it's impossible -- to compute the estimate, use 0. } -- | The interface to be implemented by a test provider. -- -- The type @t@ is the concrete representation of the test which is used by -- the provider. class Typeable t => IsTest t where -- | Run the test -- -- This method should cleanly catch any exceptions in the code to test, and -- return them as part of the 'Result', see 'FailureReason' for an -- explanation. It is ok for 'run' to raise an exception if there is a -- problem with the test suite code itself (for example, if a file that -- should contain example data or expected output is not found). run :: OptionSet -- ^ options -> t -- ^ the test to run -> (Progress -> IO ()) -- ^ a callback to report progress -> IO Result -- | The list of options that affect execution of tests of this type testOptions :: Tagged t [OptionDescription] -- | The name of a test or a group of tests type TestName = String -- | 'ResourceSpec' describes how to acquire a resource (the first field) -- and how to release it (the second field). data ResourceSpec a = ResourceSpec (IO a) (a -> IO ()) -- | A resources-related exception data ResourceError = NotRunningTests | UnexpectedState String String | UseOutsideOfTest deriving Typeable instance Show ResourceError where show NotRunningTests = "Unhandled resource. Probably a bug in the runner you're using." show (UnexpectedState where_ what) = printf "Unexpected state of the resource (%s) in %s. Report as a tasty bug." what where_ show UseOutsideOfTest = "It looks like you're attempting to use a resource outside of its test. Don't do that!" instance Exception ResourceError -- | The main data structure defining a test suite. -- -- It consists of individual test cases and properties, organized in named -- groups which form a tree-like hierarchy. -- -- There is no generic way to create a test case. Instead, every test -- provider (tasty-hunit, tasty-smallcheck etc.) provides a function to -- turn a test case into a 'TestTree'. -- -- Groups can be created using 'testGroup'. data TestTree = forall t . IsTest t => SingleTest TestName t -- ^ A single test of some particular type | TestGroup TestName [TestTree] -- ^ Assemble a number of tests into a cohesive group | PlusTestOptions (OptionSet -> OptionSet) TestTree -- ^ Add some options to child tests | forall a . WithResource (ResourceSpec a) (IO a -> TestTree) -- ^ Acquire the resource before the tests in the inner tree start and -- release it after they finish. The tree gets an `IO` action which -- yields the resource, although the resource is shared across all the -- tests. | AskOptions (OptionSet -> TestTree) -- ^ Ask for the options and customize the tests based on them -- | Create a named group of test cases or other groups testGroup :: TestName -> [TestTree] -> TestTree testGroup = TestGroup -- | An algebra for folding a `TestTree`. -- -- Instead of constructing fresh records, build upon `trivialFold` -- instead. This way your code won't break when new nodes/fields are -- indroduced. data TreeFold b = TreeFold { foldSingle :: forall t . IsTest t => OptionSet -> TestName -> t -> b , foldGroup :: TestName -> b -> b , foldResource :: forall a . ResourceSpec a -> (IO a -> b) -> b } -- | 'trivialFold' can serve as the basis for custom folds. Just override -- the fields you need. -- -- Here's what it does: -- -- * single tests are mapped to `mempty` (you probably do want to override that) -- -- * test groups are returned unmodified -- -- * for a resource, an IO action that throws an exception is passed (you -- want to override this for runners/ingredients that execute tests) trivialFold :: Monoid b => TreeFold b trivialFold = TreeFold { foldSingle = \_ _ _ -> mempty , foldGroup = const id , foldResource = \_ f -> f $ throwIO NotRunningTests } -- | Fold a test tree into a single value. -- -- The fold result type should be a monoid. This is used to fold multiple -- results in a test group. In particular, empty groups get folded into 'mempty'. -- -- Apart from pure convenience, this function also does the following -- useful things: -- -- 1. Keeping track of the current options (which may change due to -- `PlusTestOptions` nodes) -- -- 2. Filtering out the tests which do not match the patterns -- -- Thus, it is preferred to an explicit recursive traversal of the tree. -- -- Note: right now, the patterns are looked up only once, and won't be -- affected by the subsequent option changes. This shouldn't be a problem -- in practice; OTOH, this behaviour may be changed later. foldTestTree :: Monoid b => TreeFold b -- ^ the algebra (i.e. how to fold a tree) -> OptionSet -- ^ initial options -> TestTree -- ^ the tree to fold -> b foldTestTree (TreeFold fTest fGroup fResource) opts tree = let pat = lookupOption opts in go pat [] opts tree where go pat path opts tree = case tree of SingleTest name test | testPatternMatches pat (path ++ [name]) -> fTest opts name test | otherwise -> mempty TestGroup name trees -> fGroup name $ foldMap (go pat (path ++ [name]) opts) trees PlusTestOptions f tree -> go pat path (f opts) tree WithResource res tree -> fResource res $ \res -> go pat path opts (tree res) AskOptions f -> go pat path opts (f opts) -- | Get the list of options that are relevant for a given test tree treeOptions :: TestTree -> [OptionDescription] treeOptions = Prelude.concat . Map.elems . foldTestTree trivialFold { foldSingle = \_ _ -> getTestOptions } mempty where getTestOptions :: forall t . IsTest t => t -> Map.Map TypeRep [OptionDescription] getTestOptions t = Map.singleton (typeOf t) $ witness testOptions t tasty-0.11.0.4/Test/Tasty/Options/Core.hs0000644000000000000000000000657712757050475016222 0ustar0000000000000000-- | Core options, i.e. the options used by tasty itself {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- for (^) module Test.Tasty.Options.Core ( NumThreads(..) , Timeout(..) , mkTimeout , coreOptions ) where import Control.Monad (mfilter) import Data.Typeable import Data.Proxy import Data.Tagged import Data.Fixed import Data.Monoid import Options.Applicative import GHC.Conc import Test.Tasty.Options import Test.Tasty.Patterns -- | Number of parallel threads to use for running tests. -- -- Note that this is /not/ included in 'coreOptions'. -- Instead, it's automatically included in the options for any -- 'TestReporter' ingredient by 'ingredientOptions', because the way test -- reporters are handled already involves parallelism. Other ingredients -- may also choose to include this option. newtype NumThreads = NumThreads { getNumThreads :: Int } deriving (Eq, Ord, Num, Typeable) instance IsOption NumThreads where defaultValue = NumThreads numCapabilities parseValue = mfilter onlyPositive . fmap NumThreads . safeRead optionName = return "num-threads" optionHelp = return "Number of threads to use for tests execution" optionCLParser = option parse ( short 'j' <> long name <> help (untag (optionHelp :: Tagged NumThreads String)) ) where name = untag (optionName :: Tagged NumThreads String) parse = str >>= maybe (readerError $ "Could not parse " ++ name) pure <$> parseValue -- | Filtering function to prevent non-positive number of threads onlyPositive :: NumThreads -> Bool onlyPositive (NumThreads x) = x > 0 -- | Timeout to be applied to individual tests data Timeout = Timeout Integer String -- ^ 'String' is the original representation of the timeout (such as -- @\"0.5m\"@), so that we can print it back. 'Integer' is the number of -- microseconds. | NoTimeout deriving (Show, Typeable) instance IsOption Timeout where defaultValue = NoTimeout parseValue str = Timeout <$> parseTimeout str <*> pure str optionName = return "timeout" optionHelp = return "Timeout for individual tests (suffixes: ms,s,m,h; default: s)" optionCLParser = option parse ( short 't' <> long name <> help (untag (optionHelp :: Tagged Timeout String)) ) where name = untag (optionName :: Tagged Timeout String) parse = str >>= maybe (readerError $ "Could not parse " ++ name) pure <$> parseValue parseTimeout :: String -> Maybe Integer parseTimeout str = -- it sucks that there's no more direct way to convert to a number of -- microseconds (round :: Micro -> Integer) . (* 10^6) <$> case reads str of [(n, suffix)] -> case suffix of "ms" -> Just (n / 10^3) "" -> Just n "s" -> Just n "m" -> Just (n * 60) "h" -> Just (n * 60^2) _ -> Nothing _ -> Nothing -- | A shortcut for creating 'Timeout' values mkTimeout :: Integer -- ^ microseconds -> Timeout mkTimeout n = Timeout n $ showFixed True (fromInteger n / (10^6) :: Micro) ++ "s" -- | The list of all core options, i.e. the options not specific to any -- provider or ingredient, but to tasty itself. Currently contains -- 'TestPattern' and 'Timeout'. coreOptions :: [OptionDescription] coreOptions = [ Option (Proxy :: Proxy TestPattern) , Option (Proxy :: Proxy Timeout) ] tasty-0.11.0.4/Test/Tasty/Options/Env.hs0000644000000000000000000000355112457221174016040 0ustar0000000000000000-- | Get options from the environment {-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-} module Test.Tasty.Options.Env (getEnvOptions, suiteEnvOptions) where import Test.Tasty.Options import Test.Tasty.Core import Test.Tasty.Ingredients import Test.Tasty.Runners.Reducers import System.Environment import Data.Foldable import Data.Tagged import Data.Proxy import Data.Char import Data.Typeable import Control.Exception import Control.Applicative import Text.Printf data EnvOptionException = BadOption String -- option name String -- variable name String -- value deriving (Typeable) instance Show EnvOptionException where show (BadOption optName varName value) = printf "Bad environment variable %s='%s' (parsed as option %s)" varName value optName instance Exception EnvOptionException -- | Search the environment for given options getEnvOptions :: [OptionDescription] -> IO OptionSet getEnvOptions = getApp . foldMap lookupOpt where lookupOpt (Option (px :: Proxy v)) = do let name = proxy optionName px envName = ("TASTY_" ++) . flip map name $ \c -> if c == '-' then '_' else toUpper c mbValueStr <- Ap $ myLookupEnv envName flip foldMap mbValueStr $ \valueStr -> let mbValue :: Maybe v mbValue = parseValue valueStr err = throwIO $ BadOption name envName valueStr in Ap $ maybe err (return . singleOption) mbValue -- | Search the environment for all options relevant for this suite suiteEnvOptions :: [Ingredient] -> TestTree -> IO OptionSet suiteEnvOptions ins tree = getEnvOptions $ suiteOptions ins tree -- note: switch to lookupEnv once we no longer support 7.4 myLookupEnv :: String -> IO (Maybe String) myLookupEnv name = either (const Nothing) Just <$> (try (getEnv name) :: IO (Either IOException String)) tasty-0.11.0.4/Test/Tasty/Patterns.hs0000644000000000000000000001333612757047771015473 0ustar0000000000000000-- This code is largely borrowed from test-framework {- Copyright (c) 2008, Maximilian Bolingbroke All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} -- | Test patterns -- -- (Most of the code borrowed from the test-framework) {-# LANGUAGE DeriveDataTypeable #-} module Test.Tasty.Patterns ( TestPattern , parseTestPattern , noPattern , testPatternMatches ) where import Test.Tasty.Options import Text.Regex.TDFA import Text.Regex.TDFA.String() import Data.List import Data.Typeable import Data.Tagged import Options.Applicative import Data.Monoid data Token = SlashToken | WildcardToken | DoubleWildcardToken | LiteralToken Char deriving (Eq, Show) tokenize :: String -> [Token] tokenize ('/':rest) = SlashToken : tokenize rest tokenize ('*':'*':rest) = DoubleWildcardToken : tokenize rest tokenize ('*':rest) = WildcardToken : tokenize rest tokenize (c:rest) = LiteralToken c : tokenize rest tokenize [] = [] data TestPatternMatchMode = TestMatchMode | PathMatchMode deriving Show -- | A pattern to filter tests. For the syntax description, see -- data TestPattern = TestPattern { tp_categories_only :: Bool, tp_negated :: Bool, tp_match_mode :: TestPatternMatchMode, tp_tokens :: [Token] } | NoPattern deriving (Typeable, Show) -- | A pattern that matches anything. noPattern :: TestPattern noPattern = NoPattern instance Read TestPattern where readsPrec _ string = [(parseTestPattern string, "")] instance IsOption TestPattern where defaultValue = noPattern parseValue = Just . parseTestPattern optionName = return "pattern" optionHelp = return "Select only tests that match pattern" optionCLParser = option (fmap parseTestPattern str) ( short 'p' <> long (untag (optionName :: Tagged TestPattern String)) <> help (untag (optionHelp :: Tagged TestPattern String)) ) -- | Parse a pattern parseTestPattern :: String -> TestPattern parseTestPattern string = TestPattern { tp_categories_only = categories_only, tp_negated = negated, tp_match_mode = match_mode, tp_tokens = tokens'' } where tokens = tokenize string (negated, tokens') | (LiteralToken '!'):rest <- tokens = (True, rest) | otherwise = (False, tokens) (categories_only, tokens'') | (prefix, [SlashToken]) <- splitAt (length tokens' - 1) tokens' = (True, prefix) | otherwise = (False, tokens') match_mode | SlashToken `elem` tokens = PathMatchMode | otherwise = TestMatchMode -- | Test a path (which is the sequence of group titles, possibly followed -- by the test title) against a pattern testPatternMatches :: TestPattern -> [String] -> Bool testPatternMatches NoPattern _ = True testPatternMatches test_pattern path = not_maybe $ any (=~ tokens_regex) things_to_match where not_maybe | tp_negated test_pattern = not | otherwise = id path_to_consider | tp_categories_only test_pattern = dropLast 1 path | otherwise = path tokens_regex = buildTokenRegex (tp_tokens test_pattern) things_to_match = case tp_match_mode test_pattern of -- See if the tokens match any single path component TestMatchMode -> path_to_consider -- See if the tokens match any prefix of the path PathMatchMode -> map pathToString $ inits path_to_consider buildTokenRegex :: [Token] -> String buildTokenRegex [] = [] buildTokenRegex (token:tokens) = concat (firstTokenToRegex token : map tokenToRegex tokens) where firstTokenToRegex SlashToken = "^" firstTokenToRegex other = tokenToRegex other tokenToRegex SlashToken = "/" tokenToRegex WildcardToken = "[^/]*" tokenToRegex DoubleWildcardToken = ".*" tokenToRegex (LiteralToken lit) = regexEscapeChar lit regexEscapeChar :: Char -> String regexEscapeChar c | c `elem` "\\*+?|{}[]()^$." = '\\' : [c] | otherwise = [c] pathToString :: [String] -> String pathToString path = concat (intersperse "/" path) dropLast :: Int -> [a] -> [a] dropLast n = reverse . drop n . reverse tasty-0.11.0.4/Test/Tasty/Run.hs0000644000000000000000000002514512603745536014432 0ustar0000000000000000-- | Running tests {-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, RankNTypes, FlexibleContexts, BangPatterns #-} module Test.Tasty.Run ( Status(..) , StatusMap , launchTestTree ) where import qualified Data.IntMap as IntMap import qualified Data.Sequence as Seq import qualified Data.Foldable as F import Data.Maybe import Control.Monad.State import Control.Monad.Writer import Control.Monad.Reader import Control.Concurrent.STM import Control.Concurrent.Timeout import Control.Concurrent.Async import Control.Exception as E import Control.Applicative import Control.Arrow import GHC.Conc (labelThread) import qualified System.Clock as Clock import Test.Tasty.Core import Test.Tasty.Parallel import Test.Tasty.Options import Test.Tasty.Options.Core import Test.Tasty.Runners.Reducers -- | Current status of a test data Status = NotStarted -- ^ test has not started running yet | Executing Progress -- ^ test is being run | Done Result -- ^ test finished with a given result -- | Mapping from test numbers (starting from 0) to their status variables. -- -- This is what an ingredient uses to analyse and display progress, and to -- detect when tests finish. type StatusMap = IntMap.IntMap (TVar Status) data Resource r = NotCreated | BeingCreated | FailedToCreate SomeException | Created r | Destroyed instance Show (Resource r) where show r = case r of NotCreated -> "NotCreated" BeingCreated -> "BeingCreated" FailedToCreate exn -> "FailedToCreate " ++ show exn Created {} -> "Created" Destroyed -> "Destroyed" data ResourceVar = forall r . ResourceVar (TVar (Resource r)) data Initializer = forall res . Initializer (IO res) (TVar (Resource res)) data Finalizer = forall res . Finalizer (res -> IO ()) (TVar (Resource res)) (TVar Int) -- | Execute a test taking care of resources executeTest :: ((Progress -> IO ()) -> IO Result) -- ^ the action to execute the test, which takes a progress callback as -- a parameter -> TVar Status -- ^ variable to write status to -> Timeout -- ^ optional timeout to apply -> Seq.Seq Initializer -- ^ initializers (to be executed in this order) -> Seq.Seq Finalizer -- ^ finalizers (to be executed in this order) -> IO () executeTest action statusVar timeoutOpt inits fins = mask $ \restore -> do resultOrExn <- try $ restore $ do -- N.B. this can (re-)throw an exception. It's okay. By design, the -- actual test will not be run, then. We still run all the -- finalizers. -- -- There's no point to transform these exceptions to something like -- EitherT, because an async exception (cancellation) can strike -- anyway. initResources -- If all initializers ran successfully, actually run the test. -- We run it in a separate thread, so that the test's exception -- handler doesn't interfere with our timeout. withAsync (action yieldProgress) $ \asy -> do labelThread (asyncThreadId asy) "tasty_test_execution_thread" timed $ applyTimeout timeoutOpt $ wait asy -- no matter what, try to run each finalizer mbExn <- destroyResources restore atomically . writeTVar statusVar $ Done $ case resultOrExn <* maybe (Right ()) Left mbExn of Left ex -> exceptionResult ex Right (t,r) -> r { resultTime = t } where initResources :: IO () initResources = F.forM_ inits $ \(Initializer doInit initVar) -> do join $ atomically $ do resStatus <- readTVar initVar case resStatus of NotCreated -> do -- signal to others that we're taking care of the resource -- initialization writeTVar initVar BeingCreated return $ (do res <- doInit atomically $ writeTVar initVar $ Created res ) `E.catch` \exn -> do atomically $ writeTVar initVar $ FailedToCreate exn throwIO exn BeingCreated -> retry Created {} -> return $ return () FailedToCreate exn -> return $ throwIO exn _ -> return $ throwIO $ unexpectedState "initResources" resStatus applyTimeout :: Timeout -> IO Result -> IO Result applyTimeout NoTimeout a = a applyTimeout (Timeout t tstr) a = do let timeoutResult = Result { resultOutcome = Failure $ TestTimedOut t , resultDescription = "Timed out after " ++ tstr , resultShortDescription = "TIMEOUT" , resultTime = fromIntegral t } fromMaybe timeoutResult <$> timeout t a -- destroyResources should not be interrupted by an exception -- Here's how we ensure this: -- -- * the finalizer is wrapped in 'try' -- * async exceptions are masked by the caller -- * we don't use any interruptible operations here (outside of 'try') destroyResources :: (forall a . IO a -> IO a) -> IO (Maybe SomeException) destroyResources restore = do -- remember the first exception that occurred liftM getFirst . execWriterT . getTraversal $ flip F.foldMap fins $ \(Finalizer doRelease initVar finishVar) -> Traversal $ do iAmLast <- liftIO $ atomically $ do nUsers <- readTVar finishVar let nUsers' = nUsers - 1 writeTVar finishVar nUsers' return $ nUsers' == 0 mbExcn <- liftIO $ if iAmLast then join $ atomically $ do resStatus <- readTVar initVar case resStatus of Created res -> do -- Don't worry about double destroy — only one thread -- receives iAmLast return $ (either Just (const Nothing) <$> try (restore $ doRelease res)) <* atomically (writeTVar initVar Destroyed) FailedToCreate {} -> return $ return Nothing _ -> return $ return $ Just $ unexpectedState "destroyResources" resStatus else return Nothing tell $ First mbExcn -- The callback -- Since this is not used yet anyway, disable for now. -- I'm not sure whether we should get rid of this altogether. For most -- providers this is either difficult to implement or doesn't make -- sense at all. -- See also https://github.com/feuerbach/tasty/issues/33 yieldProgress _ = return () type InitFinPair = (Seq.Seq Initializer, Seq.Seq Finalizer) -- | Turn a test tree into a list of actions to run tests coupled with -- variables to watch them createTestActions :: OptionSet -> TestTree -> IO ([(IO (), TVar Status)], [ResourceVar]) createTestActions opts tree = do let traversal :: Traversal (WriterT ([(InitFinPair -> IO (), TVar Status)], [ResourceVar]) IO) traversal = foldTestTree trivialFold { foldSingle = runSingleTest , foldResource = addInitAndRelease } opts tree (tests, rvars) <- unwrap traversal let tests' = map (first ($ (Seq.empty, Seq.empty))) tests return (tests', rvars) where runSingleTest opts _ test = Traversal $ do statusVar <- liftIO $ atomically $ newTVar NotStarted let act (inits, fins) = executeTest (run opts test) statusVar (lookupOption opts) inits fins tell ([(act, statusVar)], mempty) addInitAndRelease (ResourceSpec doInit doRelease) a = wrap $ do initVar <- atomically $ newTVar NotCreated (tests, rvars) <- unwrap $ a (getResource initVar) let ntests = length tests finishVar <- atomically $ newTVar ntests let ini = Initializer doInit initVar fin = Finalizer doRelease initVar finishVar tests' = map (first $ local $ (Seq.|> ini) *** (fin Seq.<|)) tests return (tests', ResourceVar initVar : rvars) wrap = Traversal . WriterT . fmap ((,) ()) unwrap = execWriterT . getTraversal -- | Used to create the IO action which is passed in a WithResource node getResource :: TVar (Resource r) -> IO r getResource var = atomically $ do rState <- readTVar var case rState of Created r -> return r Destroyed -> throwSTM UseOutsideOfTest _ -> throwSTM $ unexpectedState "getResource" rState -- | Start running all the tests in a test tree in parallel, without -- blocking the current thread. The number of test running threads is -- determined by the 'NumThreads' option. launchTestTree :: OptionSet -> TestTree -> (StatusMap -> IO (Time -> IO a)) -- ^ A callback. First, it receives the 'StatusMap' through which it -- can observe the execution of tests in real time. Typically (but not -- necessarily), it waits until all the tests are finished. -- -- After this callback returns, the test-running threads (if any) are -- terminated and all resources acquired by tests are released. -- -- The callback must return another callback (of type @'Time' -> 'IO' -- a@) which additionally can report and/or record the total time -- taken by the test suite. This time includes the time taken to run -- all resource initializers and finalizers, which is why it is more -- accurate than what could be measured from inside the first callback. -> IO a launchTestTree opts tree k = do (testActions, rvars) <- createTestActions opts tree let NumThreads numTheads = lookupOption opts (t,k) <- timed $ do abortTests <- runInParallel numTheads (fst <$> testActions) (do let smap = IntMap.fromList $ zip [0..] (snd <$> testActions) k smap) `finally` do abortTests waitForResources rvars k t where alive :: Resource r -> Bool alive r = case r of NotCreated -> False BeingCreated -> True FailedToCreate {} -> False Created {} -> True Destroyed -> False waitForResources rvars = atomically $ forM_ rvars $ \(ResourceVar rvar) -> do res <- readTVar rvar check $ not $ alive res unexpectedState :: String -> Resource r -> SomeException unexpectedState where_ r = toException $ UnexpectedState where_ (show r) -- | Measure the time taken by an 'IO' action to run timed :: IO a -> IO (Time, a) timed t = do start <- getTime !r <- t end <- getTime return (end-start, r) -- | Get monotonic time -- -- Warning: This is not the system time, but a monotonically increasing time -- that facilitates reliable measurement of time differences. getTime :: IO Time getTime = do t <- Clock.getTime Clock.Monotonic let ns = realToFrac $ Clock.timeSpecAsNanoSecs t return $ ns / 10^9 tasty-0.11.0.4/Test/Tasty/Runners/Reducers.hs0000644000000000000000000000435712457221174017072 0ustar0000000000000000-- | Monoidal wrappers for applicative functors. Useful to define tree -- folds. -- These are the same as in the 'reducers' package. We do not use -- 'reducers' to avoid its dependencies. {- License for the 'reducers' package Copyright 2008-2011 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Tasty.Runners.Reducers where import Data.Monoid import Control.Applicative -- | Monoid generated by '*>' newtype Traversal f = Traversal { getTraversal :: f () } instance Applicative f => Monoid (Traversal f) where mempty = Traversal $ pure () Traversal f1 `mappend` Traversal f2 = Traversal $ f1 *> f2 -- | Monoid generated by @'liftA2' ('<>')@ newtype Ap f a = Ap { getApp :: f a } deriving (Functor, Applicative, Monad) instance (Applicative f, Monoid a) => Monoid (Ap f a) where mempty = pure mempty mappend = liftA2 mappend tasty-0.11.0.4/Test/Tasty/Runners/Utils.hs0000644000000000000000000000174012457221174016407 0ustar0000000000000000-- | Note: this module is re-exported as a whole from "Test.Tasty.Runners" module Test.Tasty.Runners.Utils where import Control.Exception import Control.DeepSeq import Control.Applicative import Text.Printf -- | Catch possible exceptions that may arise when evaluating a string. -- For normal (total) strings, this is a no-op. -- -- This function should be used to display messages generated by the test -- suite (such as test result descriptions). -- -- See e.g. formatMessage :: String -> IO String formatMessage msg = go 3 msg where -- to avoid infinite recursion, we introduce the recursion limit go :: Int -> String -> IO String go 0 _ = return "exceptions keep throwing other exceptions!" go recLimit msg = do mbStr <- try $ evaluate $ force msg case mbStr of Right str -> return str Left e' -> printf "message threw an exception: %s" <$> go (recLimit-1) (show (e' :: SomeException)) tasty-0.11.0.4/Test/Tasty/CmdLine.hs0000644000000000000000000000352512712335464015173 0ustar0000000000000000-- | Parsing options supplied on the command line {-# LANGUAGE ScopedTypeVariables #-} module Test.Tasty.CmdLine ( optionParser , suiteOptions , suiteOptionParser , defaultMainWithIngredients ) where import Options.Applicative import Data.Monoid import Data.Proxy import Data.Foldable import System.Exit import System.IO import Test.Tasty.Core import Test.Tasty.Ingredients import Test.Tasty.Options import Test.Tasty.Options.Env import Test.Tasty.Runners.Reducers -- | Generate a command line parser from a list of option descriptions optionParser :: [OptionDescription] -> Parser OptionSet optionParser = getApp . foldMap toSet where toSet :: OptionDescription -> Ap Parser OptionSet toSet (Option (Proxy :: Proxy v)) = Ap $ (singleOption <$> (optionCLParser :: Parser v)) <|> pure mempty -- | The command line parser for the test suite suiteOptionParser :: [Ingredient] -> TestTree -> Parser OptionSet suiteOptionParser ins tree = optionParser $ suiteOptions ins tree -- | Parse the command line arguments and run the tests using the provided -- ingredient list. -- -- When the tests finish, this function calls 'exitWith' with the exit code -- that indicates whether any tests have failed. See 'defaultMain' for -- details. defaultMainWithIngredients :: [Ingredient] -> TestTree -> IO () defaultMainWithIngredients ins testTree = do cmdlineOpts <- execParser $ info (helper <*> suiteOptionParser ins testTree) ( fullDesc <> header "Mmm... tasty test suite" ) envOpts <- suiteEnvOptions ins testTree let opts = envOpts <> cmdlineOpts case tryIngredients ins opts testTree of Nothing -> do hPutStrLn stderr "No ingredients agreed to run. Something is wrong either with your ingredient set or the options." exitFailure Just act -> do ok <- act if ok then exitSuccess else exitFailure tasty-0.11.0.4/Test/Tasty/Ingredients/ConsoleReporter.hs0000644000000000000000000003246112573536673021273 0ustar0000000000000000-- vim:fdm=marker:foldtext=foldtext() {-# LANGUAGE BangPatterns, ImplicitParams, MultiParamTypeClasses, DeriveDataTypeable, FlexibleContexts #-} -- | Console reporter ingredient module Test.Tasty.Ingredients.ConsoleReporter ( consoleTestReporter , Quiet(..) , HideSuccesses(..) ) where import Prelude hiding (fail) import Control.Monad.State hiding (fail) import Control.Monad.Reader hiding (fail,reader) import Control.Concurrent.STM import Control.Exception import Control.Applicative import Test.Tasty.Core import Test.Tasty.Run import Test.Tasty.Ingredients import Test.Tasty.Options import Test.Tasty.Runners.Reducers import Test.Tasty.Runners.Utils import Text.Printf import qualified Data.IntMap as IntMap import Data.Char import Data.Maybe import Data.Monoid import Data.Proxy import Data.Tagged import Data.Typeable import Data.Foldable (foldMap) import Options.Applicative import System.IO import System.Console.ANSI -------------------------------------------------- -- TestOutput base definitions -------------------------------------------------- -- {{{ -- | 'TestOutput' is an intermediary between output formatting and output -- printing. It lets us have several different printing modes (normal; print -- failures only; quiet). data TestOutput = PrintTest {- print test name -} (IO ()) {- print test result -} (Result -> IO ()) | PrintHeading (IO ()) TestOutput | Skip | Seq TestOutput TestOutput -- The monoid laws should hold observationally w.r.t. the semantics defined -- in this module instance Monoid TestOutput where mempty = Skip mappend = Seq type Level = Int produceOutput :: (?colors :: Bool) => OptionSet -> TestTree -> TestOutput produceOutput opts tree = let -- Do not retain the reference to the tree more than necessary !alignment = computeAlignment opts tree runSingleTest :: (IsTest t, ?colors :: Bool) => OptionSet -> TestName -> t -> Ap (Reader Level) TestOutput runSingleTest _opts name _test = Ap $ do level <- ask let printTestName = do printf "%s%s: %s" (indent level) name (replicate (alignment - indentSize * level - length name) ' ') hFlush stdout printTestResult result = do rDesc <- formatMessage $ resultDescription result -- use an appropriate printing function let printFn = if resultSuccessful result then ok else fail time = resultTime result printFn (resultShortDescription result) -- print time only if it's significant when (time >= 0.01) $ printFn (printf " (%.2fs)" time) printFn "\n" when (not $ null rDesc) $ (if resultSuccessful result then infoOk else infoFail) $ printf "%s%s\n" (indent $ level + 1) (formatDesc (level+1) rDesc) return $ PrintTest printTestName printTestResult runGroup :: TestName -> Ap (Reader Level) TestOutput -> Ap (Reader Level) TestOutput runGroup name grp = Ap $ do level <- ask let printHeading = printf "%s%s\n" (indent level) name printBody = runReader (getApp grp) (level + 1) return $ PrintHeading printHeading printBody in flip runReader 0 $ getApp $ foldTestTree trivialFold { foldSingle = runSingleTest , foldGroup = runGroup } opts tree foldTestOutput :: (?colors :: Bool, Monoid b) => (IO () -> IO Result -> (Result -> IO ()) -> b) -> (IO () -> b -> b) -> TestOutput -> StatusMap -> b foldTestOutput foldTest foldHeading outputTree smap = flip evalState 0 $ getApp $ go outputTree where go (PrintTest printName printResult) = Ap $ do ix <- get put $! ix + 1 let statusVar = fromMaybe (error "internal error: index out of bounds") $ IntMap.lookup ix smap readStatusVar = getResultFromTVar statusVar return $ foldTest printName readStatusVar printResult go (PrintHeading printName printBody) = Ap $ foldHeading printName <$> getApp (go printBody) go (Seq a b) = mappend (go a) (go b) go Skip = mempty -- }}} -------------------------------------------------- -- TestOutput modes -------------------------------------------------- -- {{{ consoleOutput :: (?colors :: Bool) => TestOutput -> StatusMap -> IO () consoleOutput output smap = getTraversal . fst $ foldTestOutput foldTest foldHeading output smap where foldTest printName getResult printResult = ( Traversal $ do printName r <- getResult printResult r , Any True) foldHeading printHeading (printBody, Any nonempty) = ( Traversal $ do when nonempty $ do printHeading; getTraversal printBody , Any nonempty ) consoleOutputHidingSuccesses :: (?colors :: Bool) => TestOutput -> StatusMap -> IO () consoleOutputHidingSuccesses output smap = void . getApp $ foldTestOutput foldTest foldHeading output smap where foldTest printName getResult printResult = Ap $ do printName r <- getResult if resultSuccessful r then do clearThisLine; return $ Any False else do printResult r; return $ Any True foldHeading printHeading printBody = Ap $ do printHeading Any failed <- getApp printBody unless failed clearAboveLine return $ Any failed clearAboveLine = do cursorUpLine 1; clearThisLine clearThisLine = do clearLine; setCursorColumn 0 streamOutputHidingSuccesses :: (?colors :: Bool) => TestOutput -> StatusMap -> IO () streamOutputHidingSuccesses output smap = void . flip evalStateT [] . getApp $ foldTestOutput foldTest foldHeading output smap where foldTest printName getResult printResult = Ap $ do r <- liftIO $ getResult if resultSuccessful r then return $ Any False else do stack <- get put [] liftIO $ do sequence_ $ reverse stack printName printResult r return $ Any True foldHeading printHeading printBody = Ap $ do modify (printHeading :) Any failed <- getApp printBody unless failed $ modify $ \stack -> case stack of _:rest -> rest [] -> [] -- shouldn't happen anyway return $ Any failed -- }}} -------------------------------------------------- -- Statistics -------------------------------------------------- -- {{{ data Statistics = Statistics { statTotal :: !Int , statFailures :: !Int } instance Monoid Statistics where Statistics t1 f1 `mappend` Statistics t2 f2 = Statistics (t1 + t2) (f1 + f2) mempty = Statistics 0 0 computeStatistics :: StatusMap -> IO Statistics computeStatistics = getApp . foldMap (\var -> Ap $ (\r -> Statistics 1 (if resultSuccessful r then 0 else 1)) <$> getResultFromTVar var) printStatistics :: (?colors :: Bool) => Statistics -> Time -> IO () printStatistics st time = do printf "\n" case statFailures st of 0 -> do ok $ printf "All %d tests passed (%.2fs)\n" (statTotal st) time fs -> do fail $ printf "%d out of %d tests failed (%.2fs)\n" fs (statTotal st) time data FailureStatus = Unknown | Failed | OK instance Monoid FailureStatus where mappend Failed _ = Failed mappend _ Failed = Failed mappend OK OK = OK mappend _ _ = Unknown mempty = OK failureStatus :: StatusMap -> IO FailureStatus failureStatus smap = atomically $ do fst <- getApp $ flip foldMap smap $ \svar -> Ap $ do status <- readTVar svar return $ case status of Done r -> if resultSuccessful r then OK else Failed _ -> Unknown case fst of Unknown -> retry _ -> return fst -- }}} -------------------------------------------------- -- Console test reporter -------------------------------------------------- -- {{{ -- | A simple console UI consoleTestReporter :: Ingredient consoleTestReporter = TestReporter [ Option (Proxy :: Proxy Quiet) , Option (Proxy :: Proxy HideSuccesses) , Option (Proxy :: Proxy UseColor) ] $ \opts tree -> Just $ \smap -> do isTerm <- hSupportsANSI stdout (\k -> if isTerm then (do hideCursor; k) `finally` showCursor else k) $ do hSetBuffering stdout LineBuffering let whenColor = lookupOption opts Quiet quiet = lookupOption opts HideSuccesses hideSuccesses = lookupOption opts let ?colors = useColor whenColor isTerm let output = produceOutput opts tree case () of { _ | quiet -> return () | hideSuccesses && isTerm -> consoleOutputHidingSuccesses output smap | hideSuccesses && not isTerm -> streamOutputHidingSuccesses output smap | otherwise -> consoleOutput output smap } return $ \time -> if quiet then do fst <- failureStatus smap return $ case fst of OK -> True _ -> False else do stats <- computeStatistics smap printStatistics stats time return $ statFailures stats == 0 -- | Do not print test results (see README for details) newtype Quiet = Quiet Bool deriving (Eq, Ord, Typeable) instance IsOption Quiet where defaultValue = Quiet False parseValue = fmap Quiet . safeRead optionName = return "quiet" optionHelp = return "Do not produce any output; indicate success only by the exit code" optionCLParser = flagCLParser (Just 'q') (Quiet True) -- | Report only failed tests newtype HideSuccesses = HideSuccesses Bool deriving (Eq, Ord, Typeable) instance IsOption HideSuccesses where defaultValue = HideSuccesses False parseValue = fmap HideSuccesses . safeRead optionName = return "hide-successes" optionHelp = return "Do not print tests that passed successfully" optionCLParser = flagCLParser Nothing (HideSuccesses True) -- | When to use color on the output data UseColor = Never | Always | Auto deriving (Eq, Ord, Typeable) -- | Control color output instance IsOption UseColor where defaultValue = Auto parseValue = parseUseColor optionName = return "color" optionHelp = return "When to use colored output. Options are 'never', 'always' and 'auto' (default: 'auto')" optionCLParser = option parse ( long name <> help (untag (optionHelp :: Tagged UseColor String)) ) where name = untag (optionName :: Tagged UseColor String) parse = str >>= maybe (readerError $ "Could not parse " ++ name) pure <$> parseValue -- | @useColor when isTerm@ decides if colors should be used, -- where @isTerm@ denotes where @stdout@ is a terminal device. useColor :: UseColor -> Bool -> Bool useColor when isTerm = case when of Never -> False Always -> True Auto -> isTerm parseUseColor :: String -> Maybe UseColor parseUseColor s = case map toLower s of "never" -> return Never "always" -> return Always "auto" -> return Auto _ -> Nothing -- }}} -------------------------------------------------- -- Various utilities -------------------------------------------------- -- {{{ getResultFromTVar :: TVar Status -> IO Result getResultFromTVar var = atomically $ do status <- readTVar var case status of Done r -> return r _ -> retry -- }}} -------------------------------------------------- -- Formatting -------------------------------------------------- -- {{{ indentSize :: Int indentSize = 2 indent :: Int -> String indent n = replicate (indentSize * n) ' ' -- handle multi-line result descriptions properly formatDesc :: Int -- indent -> String -> String formatDesc n desc = let -- remove all trailing linebreaks chomped = reverse . dropWhile (== '\n') . reverse $ desc multiline = '\n' `elem` chomped -- we add a leading linebreak to the description, to start it on a new -- line and add an indentation paddedDesc = flip concatMap chomped $ \c -> if c == '\n' then c : indent n else [c] in if multiline then paddedDesc else chomped data Maximum a = Maximum a | MinusInfinity instance Ord a => Monoid (Maximum a) where mempty = MinusInfinity Maximum a `mappend` Maximum b = Maximum (a `max` b) MinusInfinity `mappend` a = a a `mappend` MinusInfinity = a -- | Compute the amount of space needed to align "OK"s and "FAIL"s computeAlignment :: OptionSet -> TestTree -> Int computeAlignment opts = fromMonoid . foldTestTree trivialFold { foldSingle = \_ name _ level -> Maximum (length name + level) , foldGroup = \_ m -> m . (+ indentSize) } opts where fromMonoid m = case m 0 of MinusInfinity -> 0 Maximum x -> x -- (Potentially) colorful output ok, fail, infoOk, infoFail :: (?colors :: Bool) => String -> IO () fail = output BoldIntensity Vivid Red ok = output NormalIntensity Dull Green infoOk = output NormalIntensity Dull White infoFail = output NormalIntensity Dull Red output :: (?colors :: Bool) => ConsoleIntensity -> ColorIntensity -> Color -> String -> IO () output bold intensity color str | ?colors = (do setSGR [ SetColor Foreground intensity color , SetConsoleIntensity bold ] putStr str ) `finally` setSGR [] | otherwise = putStr str -- }}} tasty-0.11.0.4/Test/Tasty/Ingredients/ListTests.hs0000644000000000000000000000255712457221174020073 0ustar0000000000000000-- | Ingredient for listing test names {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module Test.Tasty.Ingredients.ListTests ( ListTests(..) , testsNames , listingTests ) where import Data.Typeable import Data.Proxy import Test.Tasty.Core import Test.Tasty.Options import Test.Tasty.Ingredients -- | This option, when set to 'True', specifies that we should run in the -- «list tests» mode newtype ListTests = ListTests Bool deriving (Eq, Ord, Typeable) instance IsOption ListTests where defaultValue = ListTests False parseValue = fmap ListTests . safeRead optionName = return "list-tests" optionHelp = return "Do not run the tests; just print their names" optionCLParser = flagCLParser (Just 'l') (ListTests True) -- | Obtain the list of all tests in the suite testsNames :: OptionSet -> TestTree -> [TestName] testsNames {- opts -} {- tree -} = foldTestTree trivialFold { foldSingle = \_opts name _test -> [name] , foldGroup = \groupName names -> map ((groupName ++ "/") ++) names } -- | The ingredient that provides the test listing functionality listingTests :: Ingredient listingTests = TestManager [Option (Proxy :: Proxy ListTests)] $ \opts tree -> case lookupOption opts of ListTests False -> Nothing ListTests True -> Just $ do mapM_ putStrLn $ testsNames opts tree return True tasty-0.11.0.4/Test/Tasty/Ingredients/IncludingOptions.hs0000644000000000000000000000064712457221174021423 0ustar0000000000000000-- | Ingredient for registering user-defined options module Test.Tasty.Ingredients.IncludingOptions where import Test.Tasty.Ingredients import Test.Tasty.Options -- | This ingredient doesn't do anything apart from registering additional -- options. -- -- The option values can be accessed using 'askOption'. includingOptions :: [OptionDescription] -> Ingredient includingOptions opts = TestManager opts (\_ _ -> Nothing) tasty-0.11.0.4/LICENSE0000644000000000000000000000204312457221174012276 0ustar0000000000000000Copyright (c) 2013 Roman Cheplyaka Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. tasty-0.11.0.4/Setup.hs0000644000000000000000000000005612457221174012727 0ustar0000000000000000import Distribution.Simple main = defaultMain tasty-0.11.0.4/tasty.cabal0000644000000000000000000000415612757050724013434 0ustar0000000000000000-- Initial tasty.cabal generated by cabal init. For further documentation, -- see http://haskell.org/cabal/users-guide/ name: tasty version: 0.11.0.4 synopsis: Modern and extensible testing framework description: Tasty is a modern testing framework for Haskell. It lets you combine your unit tests, golden tests, QuickCheck/SmallCheck properties, and any other types of tests into a single test suite. See . license: MIT license-file: LICENSE author: Roman Cheplyaka maintainer: Roman Cheplyaka homepage: http://documentup.com/feuerbach/tasty bug-reports: https://github.com/feuerbach/tasty/issues -- copyright: category: Testing build-type: Simple extra-source-files: CHANGELOG.md cabal-version: >=1.10 Source-repository head type: git location: git://github.com/feuerbach/tasty.git subdir: core library exposed-modules: Test.Tasty, Test.Tasty.Options, Test.Tasty.Providers, Test.Tasty.Runners Test.Tasty.Ingredients, Test.Tasty.Ingredients.Basic other-modules: Test.Tasty.Parallel, Test.Tasty.Core, Test.Tasty.Options.Core, Test.Tasty.Options.Env, Test.Tasty.Patterns, Test.Tasty.Run, Test.Tasty.Runners.Reducers, Test.Tasty.Runners.Utils, Test.Tasty.CmdLine, Test.Tasty.Ingredients.ConsoleReporter Test.Tasty.Ingredients.ListTests Test.Tasty.Ingredients.IncludingOptions build-depends: base >= 4.5 && < 5, stm >= 2.3, containers, mtl, tagged >= 0.5, regex-tdfa >= 1.1.8.2, optparse-applicative >= 0.11, deepseq >= 1.3, unbounded-delays >= 0.1, async >= 2.0, ansi-terminal >= 0.6.2, clock >= 0.4.4.0 if impl(ghc < 7.6) -- for GHC.Generics build-depends: ghc-prim -- hs-source-dirs: default-language: Haskell2010 ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing tasty-0.11.0.4/CHANGELOG.md0000644000000000000000000001323212757051020013076 0ustar0000000000000000Changes ======= Version 0.11.0.4 ---------------- Fix compatibility with `optparse-applicative-0.13` Version 0.11.0.3 ---------------- Switch from `regex-tdfa-rc` to `regex-tdfa`, which got a new maintainer. Version 0.11.0.2 ---------------- Clarify `IsTest`’s specification with regard to exceptions Version 0.11.0.1 ---------------- Use monotonic clock when measuring durations. Version 0.11 ------------ New field `resultShortDescription` of `Result` Version 0.10.1.2 ---------------- * Improve the docs * Fix compatibility with GHC HEAD Version 0.10.1.1 ---------------- * Prevent parsing non-positive number of threads via program options (#104) * Buffer output to avoid slowdowns when printing test results (#101) * Default to using the maximum number of available cores for test execution Version 0.10.1 -------------- Export `Test.Tasty.Runners.formatMessage` Version 0.10.0.4 ---------------- Don't output ANSI codes for the Emacs terminal emulator Version 0.10.0.3 ---------------- Better handle the situation when there are no ingredients to run Version 0.10.0.2 ---------------- Split the changelog into per-project changelogs Version 0.10.0.1 ---------------- Update to optparse-applicative 0.11 Version 0.10 ------------ * Add the `--color` option * Timings * Introduce the `Time` type synonym * Change the types of `launchTestTree` and `TestReporter` to accept the total run time * `consoleTestReporter` now displays the timings Version 0.9.0.1 --------------- Upgrade to optparse-applicative-0.10. Version 0.8.1.3 --------------- Be careful not to export the `Show (a -> b)` instance, see Version 0.8.1.2 --------------- Hide cursor when running tests Version 0.8.1.1 --------------- Fix for GHC 7.9 Version 0.8.0.4 --------------- Remove the old 'colors' flag description from the cabal file Version 0.8.0.2 --------------- Make ansi-terminal an unconditional dependency Version 0.8 ----------- * `Test.Tasty.Ingredients` is now exposed * `Test.Tasty.Ingredients.Basic` is added, which exports the ingredients defined in the `tasty` package. These exports should now be used instead of ones exported from `Test.Tasty.Runners` * The `Result` type is now structured a bit differently. Providers now should use `testPassed` and `testFailed` functions instead of constructing `Result`s directly. * Add «quiet mode» (see README) * Add «hide successes» mode (see README) * Add short command-line options: `-j` for `--num-threads`, `-p` for `--pattern` * Add timeout support * `AppMonoid` is renamed to `Traversal` for consistency with the 'reducers' package. Another similar wrapper, `Ap`, is introduced. * Fix a resources bug (resources were not released if the test suite was interrupted) * The type of `launchTestTree` is changed. It now takes a continuation as an argument. This is necessary to fix the bug mentioned above. * Add `flagCLParser` to be used as the `optionCLParser` implementation for boolean options. * Add the ability to pass options via environment Version 0.7 ----------- * Use `regex-tdfa` instead of `regex-posix` (which is a native implementation, and as such is more portable) * `foldTestTree` now takes the algebra in the form of a record rather than multiple arguments, to minimize breakage when new nodes are added or existing ones change * `withResource` now passes the IO action to get the resource to the inner test tree Version 0.6 ----------- * Better handling of exceptions that arise during resource creation or disposal * Expose the `AppMonoid` wrapper * Add `askOption` and `inludingOptions` Version 0.5.2.1 --------------- Depend on ansi-terminal >= 0.6.1. This fixes some issues with colors on Windows. Version 0.5.2 ------------- * Export `Result` and `Progress` from `Test.Tasty.Runners` * Make it clear that only GHC 7.4+ is supported Version 0.5.1 ------------- Export `ResourceSpec` from `Test.Tasty.Runners` Version 0.5 ----------- Add a capability to acquire and release resources. See the «Resources» section in the `Test.Tasty` docs. For the end users, the API is backwards-compatible. Test runners may have to be adjusted — there is a new constructor of `TestTree` and a new argument of `foldTestTree`. Version 0.4.2 ------------- Add `defaultIngredients` Version 0.4.1.1 --------------- Print the failure description in red Version 0.4.0.1 --------------- Fix a bug ([#25](https://github.com/feuerbach/tasty/issues/25)) Version 0.4 ----------- The big change in this release is introduction of ingredients, which is a replacement for runners. But unless you have a custom runner, this is unlikely to affect you much. The `Ingredient` data type has replaced the `Runner` type. The following functions have been renamed and possibly changed their types: * `defaultMainWithRunner` → `defaultMainWithIngredients` * `treeOptionParser` → `suiteOptionParser` * `getTreeOptions` → `treeOptions` * `runUI` → `consoleTestReporter` Added in this release: * `suiteOptions` * `optionParser` * functions operating on ingredients * `testsNames` * the `listingTests` ingredient and its option, `ListTests` `NumThreads` is no longer a core option, but is automatically included in the test reporting ingredients (see its haddock). Version 0.3.1 ------------- * Proper reporting of (some) non-terminating tests (#15) * Upgrade to optparse-applicative 0.6 Version 0.3 ----------- * Restrict dependency versions * Fix a bug where non-terminating test would lead to a deadlock (#15) Version 0.2 ----------- * Add an `execRunner` function * Make `Runner` return `IO Bool` Version 0.1.1 ------------- Set lower bound on optparse-applicative dependency version