packages feed

tasty 1.3.1 → 1.4

raw patch · 7 files changed

+47/−28 lines, 7 files

Files

CHANGELOG.md view
@@ -1,6 +1,14 @@ Changes ======= +Version 1.4+-----------++* Change the `TreeFold` data type to give all functions access to `OptionSet`+* Fix a bug where a looping failure message escaped the time out set for the+    test+* Fix a bug where pattern changes inside the `TestTree` weren't respected+ Version 1.3.1 -------------
Test/Tasty/Core.hs view
@@ -1,6 +1,6 @@ -- | Core types and definitions {-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts,-             ExistentialQuantification, RankNTypes, DeriveDataTypeable,+             ExistentialQuantification, RankNTypes, DeriveDataTypeable, NoMonomorphismRestriction,              DeriveGeneric #-} module Test.Tasty.Core where @@ -310,9 +310,9 @@ -- 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-  , foldAfter :: DependencyType -> Expr -> b -> b+  , foldGroup :: OptionSet -> TestName -> b -> b+  , foldResource :: forall a . OptionSet -> ResourceSpec a -> (IO a -> b) -> b+  , foldAfter :: OptionSet -> DependencyType -> Expr -> b -> b   }  -- | 'trivialFold' can serve as the basis for custom folds. Just override@@ -329,9 +329,9 @@ trivialFold :: Monoid b => TreeFold b trivialFold = TreeFold   { foldSingle = \_ _ _ -> mempty-  , foldGroup = const id-  , foldResource = \_ f -> f $ throwIO NotRunningTests-  , foldAfter = \_ _ b -> b+  , foldGroup = \_ _ b -> b+  , foldResource = \_ _ f -> f $ throwIO NotRunningTests+  , foldAfter = \_ _ _ b -> b   }  -- | Fold a test tree into a single value.@@ -353,7 +353,7 @@ -- affected by the subsequent option changes. This shouldn't be a problem -- in practice; OTOH, this behaviour may be changed later. foldTestTree-  :: Monoid b+  :: forall b . Monoid b   => TreeFold b      -- ^ the algebra (i.e. how to fold a tree)   -> OptionSet@@ -362,21 +362,23 @@      -- ^ the tree to fold   -> b foldTestTree (TreeFold fTest fGroup fResource fAfter) opts0 tree0 =-  let pat = lookupOption opts0-  in go pat mempty opts0 tree0+  go mempty opts0 tree0   where-    go pat path opts tree1 =+    go :: (Seq.Seq TestName -> OptionSet -> TestTree -> b)+    go path opts tree1 =       case tree1 of         SingleTest name test           | testPatternMatches pat (path Seq.|> name)             -> fTest opts name test           | otherwise -> mempty         TestGroup name trees ->-          fGroup name $ foldMap (go pat (path Seq.|> name) opts) trees-        PlusTestOptions f tree -> go pat path (f opts) tree-        WithResource res0 tree -> fResource res0 $ \res -> go pat path opts (tree res)-        AskOptions f -> go pat path opts (f opts)-        After deptype dep tree -> fAfter deptype dep $ go pat path opts tree+          fGroup opts name $ foldMap (go (path Seq.|> name) opts) trees+        PlusTestOptions f tree -> go path (f opts) tree+        WithResource res0 tree -> fResource opts res0 $ \res -> go path opts (tree res)+        AskOptions f -> go path opts (f opts)+        After deptype dep tree -> fAfter opts deptype dep $ go path opts tree+      where+        pat = lookupOption opts :: TestPattern  -- | Get the list of options that are relevant for a given test tree treeOptions :: TestTree -> [OptionDescription]
Test/Tasty/Ingredients/ConsoleReporter.hs view
@@ -136,8 +136,8 @@        return $ PrintTest name printTestName printTestResult -    runGroup :: TestName -> Ap (Reader Level) TestOutput -> Ap (Reader Level) TestOutput-    runGroup name grp = Ap $ do+    runGroup :: OptionSet -> TestName -> Ap (Reader Level) TestOutput -> Ap (Reader Level) TestOutput+    runGroup _opts name grp = Ap $ do       level <- ask       let         printHeading = printf "%s%s\n" (indent level) name@@ -595,7 +595,7 @@   foldTestTree     trivialFold       { foldSingle = \_ name _ level -> Maximum (stringWidth name + level)-      , foldGroup = \_ m -> m . (+ indentSize)+      , foldGroup = \_opts _ m -> m . (+ indentSize)       }     opts   where
Test/Tasty/Ingredients/ListTests.hs view
@@ -31,7 +31,7 @@   foldTestTree     trivialFold       { foldSingle = \_opts name _test -> [name]-      , foldGroup = \groupName names -> map ((groupName ++ ".") ++) names+      , foldGroup = \_opts groupName names -> map ((groupName ++ ".") ++) names       }  -- | The ingredient that provides the test listing functionality
Test/Tasty/Run.hs view
@@ -34,7 +34,7 @@ import Test.Tasty.Options import Test.Tasty.Options.Core import Test.Tasty.Runners.Reducers-import Test.Tasty.Runners.Utils (timed)+import Test.Tasty.Runners.Utils (timed, forceElements) import Test.Tasty.Providers.ConsoleFormat (noResultDetails)  -- | Current status of a test@@ -106,7 +106,15 @@     -- handler doesn't interfere with our timeout.     withAsync (action yieldProgress) $ \asy -> do       labelThread (asyncThreadId asy) "tasty_test_execution_thread"-      timed $ applyTimeout timeoutOpt $ wait asy+      timed $ applyTimeout timeoutOpt $ do+        r <- wait asy+        -- Not only wait for the result to be returned, but make sure to+        -- evalute it inside applyTimeout; see #280.+        evaluate $+          resultOutcome r `seq`+          forceElements (resultDescription r) `seq`+          forceElements (resultShortDescription r)+        return r    -- no matter what, try to run each finalizer   mbExn <- destroyResources restore@@ -233,9 +241,9 @@         (trivialFold :: TreeFold Tr)           { foldSingle = runSingleTest           , foldResource = addInitAndRelease-          , foldGroup = \name (Traversal a) ->+          , foldGroup = \_opts name (Traversal a) ->               Traversal $ local (first (Seq.|> name)) a-          , foldAfter = \deptype pat (Traversal a) ->+          , foldAfter = \_opts deptype pat (Traversal a) ->               Traversal $ local (second ((deptype, pat) :)) a           }         opts0 tree@@ -260,8 +268,8 @@         act (inits, fins) =           executeTest (run opts test) statusVar (lookupOption opts) inits fins       tell ([(act, (statusVar, path, deps))], mempty)-    addInitAndRelease :: ResourceSpec a -> (IO a -> Tr) -> Tr-    addInitAndRelease (ResourceSpec doInit doRelease) a = wrap $ \path deps -> do+    addInitAndRelease :: OptionSet -> ResourceSpec a -> (IO a -> Tr) -> Tr+    addInitAndRelease _opts (ResourceSpec doInit doRelease) a = wrap $ \path deps -> do       initVar <- atomically $ newTVar NotCreated       (tests, fins) <- unwrap path deps $ a (getResource initVar)       let ntests = length tests
Test/Tasty/Runners/Utils.hs view
@@ -47,7 +47,8 @@         Right () -> return msg         Left e' -> printf "message threw an exception: %s" <$> go (recLimit-1) (show (e' :: SomeException)) --- https://ro-che.info/articles/2015-05-28-force-list+-- | Force elements of a list+-- (<https://ro-che.info/articles/2015-05-28-force-list>) forceElements :: [a] -> () forceElements = foldr seq ()
tasty.cabal view
@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                tasty-version:             1.3.1+version:             1.4 synopsis:            Modern and extensible testing framework description:         Tasty is a modern testing framework for Haskell.                      It lets you combine your unit tests, golden