tasty 1.0.1 → 1.0.1.1
raw patch · 6 files changed
+117/−48 lines, 6 files
Files
- CHANGELOG.md +5/−0
- README.md +12/−13
- Test/Tasty/Options/Core.hs +3/−2
- Test/Tasty/Patterns.hs +2/−1
- Test/Tasty/Run.hs +94/−31
- tasty.cabal +1/−1
CHANGELOG.md view
@@ -1,6 +1,11 @@ Changes ======= +Version 1.0.1.1+---------------++Fix a bug where a test suite that uses resources would hang if interrupted+ Version 1.0.1 -------------
README.md view
@@ -175,28 +175,26 @@ % ./test --help Mmm... tasty test suite -Usage: test [-p|--pattern ARG] [-t|--timeout ARG] [-l|--list-tests]- [-j|--num-threads ARG] [-q|--quiet] [--hide-successes]- [--color never|always|auto] [--smallcheck-depth NUMBER]- [--quickcheck-tests NUMBER] [--quickcheck-replay SEED]- [--quickcheck-show-replay] [--quickcheck-max-size NUMBER]- [--quickcheck-max-ratio NUMBER] [--quickcheck-verbose]+Usage: test [-p|--pattern PATTERN] [-t|--timeout DURATION] [-l|--list-tests]+ [-j|--num-threads NUMBER] [-q|--quiet] [--hide-successes]+ [--color never|always|auto] [--quickcheck-tests NUMBER]+ [--quickcheck-replay SEED] [--quickcheck-show-replay]+ [--quickcheck-max-size NUMBER] [--quickcheck-max-ratio NUMBER]+ [--quickcheck-verbose] [--smallcheck-depth NUMBER] Available options: -h,--help Show this help text- -p,--pattern ARG Select only tests which satisfy a pattern or awk+ -p,--pattern PATTERN Select only tests which satisfy a pattern or awk expression- -t,--timeout ARG Timeout for individual tests (suffixes: ms,s,m,h;+ -t,--timeout DURATION Timeout for individual tests (suffixes: ms,s,m,h; default: s) -l,--list-tests Do not run the tests; just print their names- -j,--num-threads ARG Number of threads to use for tests execution+ -j,--num-threads NUMBER Number of threads to use for tests execution -q,--quiet Do not produce any output; indicate success only by the exit code --hide-successes Do not print tests that passed successfully --color never|always|auto When to use colored output (default: 'auto')- --smallcheck-depth NUMBER- Depth to use for smallcheck tests --quickcheck-tests NUMBER Number of test cases for QuickCheck to generate --quickcheck-replay SEED Random seed to use for replaying a previous test run@@ -208,13 +206,14 @@ Maximum number of discared tests per successful test before giving up --quickcheck-verbose Show the generated test cases+ --smallcheck-depth NUMBER+ Depth to use for smallcheck tests ``` Every option can be passed via environment. To obtain the environment variable name from the option name, replace hyphens `-` with underscores `_`, capitalize all letters, and prepend `TASTY_`. For example, the environment equivalent of-`--smallcheck-depth` is `TASTY_SMALLCHECK_DEPTH`. To turn on a switch (such as-`TASTY_HIDE_SUCCESSES`), set the variable to `True`.+`--smallcheck-depth` is `TASTY_SMALLCHECK_DEPTH`. Note on boolean options: by convention, boolean ("on/off") options are specified using a switch on the command line, for example `--quickcheck-show-replay`
Test/Tasty/Options/Core.hs view
@@ -13,6 +13,7 @@ import Data.Proxy import Data.Typeable import Data.Fixed+import Data.Monoid import Options.Applicative hiding (str) import GHC.Conc @@ -33,7 +34,7 @@ parseValue = mfilter onlyPositive . fmap NumThreads . safeRead optionName = return "num-threads" optionHelp = return "Number of threads to use for tests execution"- optionCLParser = mkOptionCLParser (short 'j')+ optionCLParser = mkOptionCLParser (short 'j' <> metavar "NUMBER") -- | Filtering function to prevent non-positive number of threads onlyPositive :: NumThreads -> Bool@@ -56,7 +57,7 @@ <*> pure str optionName = return "timeout" optionHelp = return "Timeout for individual tests (suffixes: ms,s,m,h; default: s)"- optionCLParser = mkOptionCLParser (short 't')+ optionCLParser = mkOptionCLParser (short 't' <> metavar "DURATION") parseTimeout :: String -> Maybe Integer parseTimeout str =
Test/Tasty/Patterns.hs view
@@ -14,6 +14,7 @@ import Test.Tasty.Patterns.Parser import Test.Tasty.Patterns.Eval +import Data.Monoid import Data.Char import qualified Data.Sequence as Seq import Data.Typeable@@ -30,7 +31,7 @@ parseValue = parseTestPattern optionName = return "pattern" optionHelp = return "Select only tests which satisfy a pattern or awk expression"- optionCLParser = mkOptionCLParser (short 'p')+ optionCLParser = mkOptionCLParser (short 'p' <> metavar "PATTERN") parseTestPattern :: String -> Maybe TestPattern parseTestPattern s
Test/Tasty/Run.hs view
@@ -17,6 +17,7 @@ import Control.Monad.State import Control.Monad.Writer import Control.Monad.Reader+import Control.Concurrent import Control.Concurrent.STM import Control.Concurrent.Timeout (timeout) import Control.Concurrent.Async@@ -55,6 +56,7 @@ | BeingCreated | FailedToCreate SomeException | Created r+ | BeingDestroyed | Destroyed instance Show (Resource r) where@@ -63,10 +65,9 @@ BeingCreated -> "BeingCreated" FailedToCreate exn -> "FailedToCreate " ++ show exn Created {} -> "Created"+ BeingDestroyed -> "BeingDestroyed" Destroyed -> "Destroyed" -data ResourceVar = forall r . ResourceVar (TVar (Resource r))- data Initializer = forall res . Initializer (IO res)@@ -134,8 +135,15 @@ BeingCreated -> retry Created {} -> return $ return () FailedToCreate exn -> return $ throwIO exn- _ -> return $ throwIO $- unexpectedState "initResources" resStatus+ -- If the resource is destroyed or being destroyed+ -- while we're starting a test, the test suite is probably+ -- shutting down. We are about to be killed.+ -- (In fact we are probably killed already, so these cases are+ -- unlikely to occur.)+ -- In any case, the most sensible thing to do is to go to+ -- sleep, awaiting our fate.+ Destroyed -> return $ sleepIndefinitely+ BeingDestroyed -> return $ sleepIndefinitely applyTimeout :: Timeout -> IO Result -> IO Result applyTimeout NoTimeout a = a@@ -161,7 +169,7 @@ destroyResources restore = do -- remember the first exception that occurred liftM getFirst . execWriterT . getTraversal $- flip F.foldMap fins $ \(Finalizer doRelease initVar finishVar) ->+ flip F.foldMap fins $ \fin@(Finalizer _ _ finishVar) -> Traversal $ do iAmLast <- liftIO $ atomically $ do nUsers <- readTVar finishVar@@ -171,19 +179,7 @@ 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+ then destroyResource restore fin else return Nothing tell $ First mbExcn@@ -199,12 +195,15 @@ 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])+-- variables to watch them.+--+-- Also return a list of finalizers in the order they should run when the+-- test suite completes.+createTestActions :: OptionSet -> TestTree -> IO ([(IO (), TVar Status)], Seq.Seq Finalizer) createTestActions opts0 tree = do let traversal ::- Traversal (WriterT ([(InitFinPair -> IO (), TVar Status)], [ResourceVar]) IO)+ Traversal (WriterT ([(InitFinPair -> IO (), TVar Status)], Seq.Seq Finalizer) IO) traversal = foldTestTree trivialFold@@ -225,14 +224,14 @@ tell ([(act, statusVar)], mempty) addInitAndRelease (ResourceSpec doInit doRelease) a = wrap $ do initVar <- atomically $ newTVar NotCreated- (tests, rvars) <- unwrap $ a (getResource initVar)+ (tests, fins) <- 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)+ return (tests', fins Seq.|> fin) wrap = Traversal . WriterT . fmap ((,) ()) unwrap = execWriterT . getTraversal @@ -246,9 +245,47 @@ 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.+-- | Run a resource finalizer.+--+-- This function is called from two different places:+--+-- 1. A test thread, which is the last one to use the resource.+-- 2. The main thread, if an exception (e.g. Ctrl-C) is received.+--+-- Therefore, it is possible that this function is called multiple+-- times concurrently on the same finalizer.+--+-- This function should be run with async exceptions masked,+-- and the restore function should be passed as an argument.+destroyResource :: (forall a . IO a -> IO a) -> Finalizer -> IO (Maybe SomeException)+destroyResource restore (Finalizer doRelease stateVar _) = join . atomically $ do+ rState <- readTVar stateVar+ case rState of+ Created res -> do+ writeTVar stateVar BeingDestroyed+ return $+ (either Just (const Nothing)+ <$> try (restore $ doRelease res))+ <* atomically (writeTVar stateVar Destroyed)+ BeingCreated -> retry+ -- If the resource is being destroyed, wait until it is destroyed.+ -- This is so that we don't start destroying the next resource out of+ -- order.+ BeingDestroyed -> retry+ NotCreated -> do+ -- prevent the resource from being created by a competing thread+ writeTVar stateVar Destroyed+ return $ return Nothing+ FailedToCreate {} -> return $ return Nothing+ Destroyed -> return $ return Nothing++-- | Start running the tests (in background, in parallel) and pass control+-- to the callback.+--+-- Once the callback returns, stop running the tests.+--+-- The number of test running threads is determined by the 'NumThreads'+-- option. launchTestTree :: OptionSet -> TestTree@@ -267,15 +304,22 @@ -- accurate than what could be measured from inside the first callback. -> IO a launchTestTree opts tree k0 = do- (testActions, rvars) <- createTestActions opts tree+ (testActions, fins) <- createTestActions opts tree let NumThreads numTheads = lookupOption opts (t,k1) <- timed $ do abortTests <- runInParallel numTheads (fst <$> testActions) (do let smap = IntMap.fromList $ zip [0..] (snd <$> testActions) k0 smap)- `finally` do+ `finallyRestore` \restore -> do+ -- Tell all running tests to wrap up. abortTests- waitForResources rvars+ -- Destroy all allocated resources in the case they didn't get+ -- destroyed by their tests. (See #75.)+ F.mapM_ (destroyResource restore) fins+ -- Wait until all resources are destroyed. (Specifically, those+ -- that were being destroyed by their tests, not those that were+ -- destroyed by destroyResource above.)+ restore $ waitForResources fins k1 t where alive :: Resource r -> Bool@@ -284,15 +328,34 @@ BeingCreated -> True FailedToCreate {} -> False Created {} -> True+ BeingDestroyed -> True Destroyed -> False - waitForResources rvars = atomically $- forM_ rvars $ \(ResourceVar rvar) -> do+ waitForResources fins = atomically $+ F.forM_ fins $ \(Finalizer _ rvar _) -> do res <- readTVar rvar check $ not $ alive res unexpectedState :: String -> Resource r -> SomeException unexpectedState where_ r = toException $ UnexpectedState where_ (show r)++sleepIndefinitely :: IO ()+sleepIndefinitely = forever $ threadDelay (10^(7::Int))++-- | Like 'finally' (which also masks its finalizers), but pass the restore+-- action to the finalizer.+finallyRestore+ :: IO a+ -- ^ computation to run first+ -> ((forall c . IO c -> IO c) -> IO b)+ -- ^ computation to run afterward (even if an exception was raised)+ -> IO a+ -- ^ returns the value from the first computation+a `finallyRestore` sequel =+ mask $ \restore -> do+ r <- restore a `onException` sequel restore+ _ <- sequel restore+ return r -- | Measure the time taken by an 'IO' action to run timed :: IO a -> IO (Time, a)
tasty.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: tasty-version: 1.0.1+version: 1.0.1.1 synopsis: Modern and extensible testing framework description: Tasty is a modern testing framework for Haskell. It lets you combine your unit tests, golden