packages feed

tasty 0.11.2.3 → 0.11.2.4

raw patch · 4 files changed

+98/−32 lines, 4 filesdep +unixdep ~basedep ~mtl

Dependencies added: unix

Dependency ranges changed: base, mtl

Files

CHANGELOG.md view
@@ -1,6 +1,13 @@ Changes ======= +Version 0.11.2.4+----------------++1. Make the `--quiet` mode more efficient on a large number of tests+2. Fix a bug where a cursor would disappear if the test suite was terminated by+   a signal other than SIGINT.+ Version 0.11.2.3 ---------------- 
Test/Tasty/CmdLine.hs view
@@ -1,5 +1,5 @@ -- | Parsing options supplied on the command line-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable #-} module Test.Tasty.CmdLine   ( optionParser   , suiteOptions@@ -10,17 +10,28 @@ import Options.Applicative import Data.Monoid import Data.Proxy-import Data.Foldable+import Data.Foldable (foldMap) import Prelude  -- Silence AMP and FTP import warnings import System.Exit import System.IO +-- for installSignalHandlers+#ifdef UNIX+import Control.Concurrent (mkWeakThreadId, myThreadId)+import Control.Exception (Exception(..), throwTo)+import Control.Monad (forM_)+import Data.Typeable (Typeable)+import System.Posix.Signals+import System.Mem.Weak (deRefWeak)+#endif+ 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@@ -40,6 +51,7 @@ -- details. defaultMainWithIngredients :: [Ingredient] -> TestTree -> IO () defaultMainWithIngredients ins testTree = do+  installSignalHandlers   cmdlineOpts <- execParser $     info (helper <*> suiteOptionParser ins testTree)     ( fullDesc <>@@ -58,3 +70,28 @@     Just act -> do       ok <- act       if ok then exitSuccess else exitFailure++-- from https://ro-che.info/articles/2014-07-30-bracket+-- Install a signal handler so that e.g. the cursor is restored if the test+-- suite is killed by SIGTERM.+installSignalHandlers :: IO ()+installSignalHandlers = do+#ifdef UNIX+  main_thread_id <- myThreadId+  weak_tid <- mkWeakThreadId main_thread_id+  forM_ [ sigABRT, sigBUS, sigFPE, sigHUP, sigILL, sigQUIT, sigSEGV,+          sigSYS, sigTERM, sigUSR1, sigUSR2, sigXCPU, sigXFSZ ] $ \sig ->+    installHandler sig (Catch $ send_exception weak_tid sig) Nothing+  where+    send_exception weak_tid sig = do+      m <- deRefWeak weak_tid+      case m of+        Nothing  -> return ()+        Just tid -> throwTo tid (toException $ SignalException sig)++newtype SignalException = SignalException Signal+  deriving (Show, Typeable)+instance Exception SignalException+#else+  return ()+#endif
Test/Tasty/Ingredients/ConsoleReporter.hs view
@@ -16,6 +16,7 @@ import Test.Tasty.Run import Test.Tasty.Ingredients import Test.Tasty.Options+import Test.Tasty.Options.Core import Test.Tasty.Runners.Reducers import Test.Tasty.Runners.Utils import Text.Printf@@ -241,39 +242,56 @@     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- -- | Wait until -- -- * all tests have finished successfully, and return 'True', or -- -- * at least one test has failed, and return 'False'-statusMapResult :: StatusMap -> IO Bool-statusMapResult 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-    OK -> return True-    Failed -> return False-    Unknown -> retry+statusMapResult+  :: Int -- ^ lookahead+  -> StatusMap+  -> IO Bool+statusMapResult lookahead0 smap+  | IntMap.null smap = return True+  | otherwise =+      join . atomically $+        IntMap.foldrWithKey f finish smap mempty lookahead0+  where+    f :: Int+      -> TVar Status+      -> (IntMap.IntMap () -> Int -> STM (IO Bool))+      -> (IntMap.IntMap () -> Int -> STM (IO Bool))+    -- ok_tests is a set of tests that completed successfully+    -- lookahead is the number of unfinished tests that we are allowed to+    -- look at+    f key tvar k ok_tests lookahead+      | lookahead <= 0 =+          -- We looked at too many unfinished tests.+          next_iter ok_tests+      | otherwise = do+          this_status <- readTVar tvar+          case this_status of+            Done r ->+              if resultSuccessful r+                then k (IntMap.insert key () ok_tests) lookahead+                else return $ return False+            _ -> k ok_tests (lookahead-1) +    -- next_iter is called when we end the current iteration,+    -- either because we reached the end of the test tree+    -- or because we exhausted the lookahead+    next_iter :: IntMap.IntMap () -> STM (IO Bool)+    next_iter ok_tests =+      -- If we made no progress at all, wait until at least some tests+      -- complete.+      -- Otherwise, reduce the set of tests we are looking at.+      if IntMap.null ok_tests+        then retry+        else return $ statusMapResult lookahead0 (IntMap.difference smap ok_tests)++    finish :: IntMap.IntMap () -> Int -> STM (IO Bool)+    finish ok_tests _ = next_iter ok_tests+ -- }}}  --------------------------------------------------@@ -295,10 +313,11 @@     whenColor = lookupOption opts     Quiet quiet = lookupOption opts     HideSuccesses hideSuccesses = lookupOption opts+    NumThreads numThreads = lookupOption opts    if quiet     then do-      b <- statusMapResult smap+      b <- statusMapResult numThreads smap       return $ \_time -> return b     else @@ -318,7 +337,6 @@             output = produceOutput opts tree            case () of { _-            | quiet -> return ()             | hideSuccesses && isTerm ->                 consoleOutputHidingSuccesses output smap             | hideSuccesses && not isTerm ->
tasty.cabal view
@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                tasty-version:             0.11.2.3+version:             0.11.2.4 synopsis:            Modern and extensible testing framework description:         Tasty is a modern testing framework for Haskell.                      It lets you combine your unit tests, golden@@ -63,6 +63,10 @@   if impl(ghc < 7.6)     -- for GHC.Generics     build-depends: ghc-prim++  if !os(windows)+    build-depends: unix+    cpp-options: -DUNIX    -- hs-source-dirs:         default-language:    Haskell2010