tasty 0.12 → 0.12.0.1

raw patch · 13 files changed

+109/−82 lines, 13 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−1
• README.md +2/−28
• Test/Tasty/Core.hs +6/−6
• Test/Tasty/Ingredients/ConsoleReporter.hs +43/−25
• Test/Tasty/Ingredients/ListTests.hs +4/−2
• Test/Tasty/Options.hs +10/−3
• Test/Tasty/Options/Core.hs +5/−4
• Test/Tasty/Parallel.hs +1/−1
• Test/Tasty/Patterns.hs +4/−2
• Test/Tasty/Run.hs +12/−7
• Test/Tasty/Runners/Reducers.hs +12/−0
• Test/Tasty/Runners/Utils.hs +1/−1
• tasty.cabal +3/−2

@@ -1,8 +1,13 @@ Changes ======= +Version 0.12.0.1+----------------++Fix compatibility with GHC 8.4+ Version 0.12---------------+------------  Backward compat breaking revision of `Test.Tasty.Ingredients.ConsoleReporter` that exposes the name of tests/groups.

@@ -16,18 +16,10 @@ * Extensibility: add your own test providers and ingredients (runners) above and   beyond those provided -[![Build Status](https://travis-ci.org/feuerbach/tasty.png?branch=master)](https://travis-ci.org/feuerbach/tasty)- To find out what's new, read the **[change log][]**.  [change log]: https://github.com/feuerbach/tasty/blob/master/core/CHANGELOG.md -Ask any tasty-related questions on the **[mailing list][]** or IRC channel-**#tasty** at FreeNode ([logs & stats][ircbrowse]).--[mailing list]: https://groups.google.com/forum/#!forum/haskell-tasty-[ircbrowse]: http://ircbrowse.net/tasty- ## Example  Here's how your `test.hs` might look like:@@ -111,6 +103,8 @@   (based on [smallcheck](http://hackage.haskell.org/package/smallcheck)) * [tasty-quickcheck](http://hackage.haskell.org/package/tasty-quickcheck) — for randomized   property-based testing (based on [QuickCheck](http://hackage.haskell.org/package/QuickCheck))+* [tasty-hedgehog](https://github.com/qfpl/tasty-hedgehog) — for randomized+  property-based testing (based on [Hedgehog](http://hackage.haskell.org/package/hedgehog)) * [tasty-hspec](http://hackage.haskell.org/package/tasty-hspec) — for   [Hspec](http://hspec.github.io/) tests * [tasty-program](http://hackage.haskell.org/package/tasty-program) — run@@ -415,26 +409,6 @@ * [Code testing in Haskell revisited (with Tasty)](http://lambda.jstolarek.com/2014/01/code-testing-in-haskell-revisited-with-tasty/)  [custom-options-article]: http://ro-che.info/articles/2013-12-20-tasty-custom-options.html--## Background--Tasty is heavily influenced by [test-framework][].--The problems with test-framework are:--* Poor code style (some lines of the code wouldn't even fit in a twitter message!)-* Poor architecture — e.g. relying on laziness for IO and control flow. The-  whole story with `:~>` and `ImprovingIO` is really obscure.-* Non-extensible options. For example, when I integrated SmallCheck with-  test-framework (in the form of the `test-framework-smallcheck` package), I-  still had to submit patches to the main package to make SmallCheck depth-  customizable by the user.-* The project is effectively unmaintained.--So I decided to recreate everything that I liked in test-framework from scratch-in this package.--[test-framework]: http://batterseapower.github.io/test-framework/  Maintainers -----------

@@ -223,12 +223,12 @@   -> TestTree      -- ^ the tree to fold   -> b-foldTestTree (TreeFold fTest fGroup fResource) opts tree =-  let pat = lookupOption opts-  in go pat [] opts tree+foldTestTree (TreeFold fTest fGroup fResource) opts0 tree0 =+  let pat = lookupOption opts0+  in go pat [] opts0 tree0   where-    go pat path opts tree =-      case tree of+    go pat path opts tree1 =+      case tree1 of         SingleTest name test           | testPatternMatches pat (path ++ [name])             -> fTest opts name test@@ -236,7 +236,7 @@         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)+        WithResource res0 tree -> fResource res0 $ \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

@@ -22,11 +22,11 @@   , foldTestOutput   ) 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@@ -39,14 +39,20 @@ import Data.Char import Data.Maybe import Data.Monoid-import Data.Proxy-import Data.Tagged import Data.Typeable-import Data.Foldable hiding (concatMap,elem,sequence_)-import Options.Applicative-import Prelude hiding (fail)  -- Silence AMP and FTP import warnings+import Options.Applicative hiding (str) import System.IO import System.Console.ANSI+#if !MIN_VERSION_base(4,8,0)+import Data.Proxy+import Data.Tagged+import Data.Foldable hiding (concatMap,elem,sequence_)+import Control.Applicative+#endif+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup)+import qualified Data.Semigroup (Semigroup((<>)))+#endif  -------------------------------------------------- -- TestOutput base definitions@@ -75,6 +81,10 @@ instance Monoid TestOutput where   mempty = Skip   mappend = Seq+#if MIN_VERSION_base(4,9,0)+instance Semigroup TestOutput where+  (<>) = mappend+#endif  type Level = Int @@ -177,36 +187,36 @@ -------------------------------------------------- -- {{{ consoleOutput :: (?colors :: Bool) => TestOutput -> StatusMap -> IO ()-consoleOutput output smap =-  getTraversal . fst $ foldTestOutput foldTest foldHeading output smap+consoleOutput toutput smap =+  getTraversal . fst $ foldTestOutput foldTest foldHeading toutput smap   where     foldTest _name printName getResult printResult =       ( Traversal $ do-          printName+          printName :: IO ()           r <- getResult           printResult r       , Any True)     foldHeading _name printHeading (printBody, Any nonempty) =       ( Traversal $ do-          when nonempty $ do printHeading; getTraversal printBody+          when nonempty $ do printHeading :: IO (); getTraversal printBody       , Any nonempty       )  consoleOutputHidingSuccesses :: (?colors :: Bool) => TestOutput -> StatusMap -> IO ()-consoleOutputHidingSuccesses output smap =-  void . getApp $ foldTestOutput foldTest foldHeading output smap+consoleOutputHidingSuccesses toutput smap =+  void . getApp $ foldTestOutput foldTest foldHeading toutput smap   where     foldTest _name printName getResult printResult =       Ap $ do-          printName+          printName :: IO ()           r <- getResult           if resultSuccessful r             then do clearThisLine; return $ Any False-            else do printResult r; return $ Any True+            else do printResult r :: IO (); return $ Any True      foldHeading _name printHeading printBody =       Ap $ do-        printHeading+        printHeading :: IO ()         Any failed <- getApp printBody         unless failed clearAboveLine         return $ Any failed@@ -215,9 +225,9 @@     clearThisLine = do clearLine; setCursorColumn 0  streamOutputHidingSuccesses :: (?colors :: Bool) => TestOutput -> StatusMap -> IO ()-streamOutputHidingSuccesses output smap =+streamOutputHidingSuccesses toutput smap =   void . flip evalStateT [] . getApp $-    foldTestOutput foldTest foldHeading output smap+    foldTestOutput foldTest foldHeading toutput smap   where     foldTest _name printName getResult printResult =       Ap $ do@@ -230,8 +240,8 @@                liftIO $ do                 sequence_ $ reverse stack-                printName-                printResult r+                printName :: IO ()+                printResult r :: IO ()                return $ Any True @@ -267,6 +277,10 @@ instance Monoid Statistics where   Statistics t1 f1 `mappend` Statistics t2 f2 = Statistics (t1 + t2) (f1 + f2)   mempty = Statistics 0 0+#if MIN_VERSION_base(4,9,0)+instance Semigroup Statistics where+  (<>) = mappend+#endif  computeStatistics :: StatusMap -> IO Statistics computeStatistics = getApp . foldMap (\var -> Ap $@@ -391,14 +405,14 @@             ?colors = useColor whenColor isTerm            let-            output = buildTestOutput opts tree+            toutput = buildTestOutput opts tree            case () of { _             | hideSuccesses && isTerm ->-                consoleOutputHidingSuccesses output smap+                consoleOutputHidingSuccesses toutput smap             | hideSuccesses && not isTerm ->-                streamOutputHidingSuccesses output smap-            | otherwise -> consoleOutput output smap+                streamOutputHidingSuccesses toutput smap+            | otherwise -> consoleOutput toutput smap           }            return $ \time -> do@@ -447,8 +461,8 @@ -- --   @since 0.11.3 useColor :: UseColor -> Bool -> Bool-useColor when isTerm =-  case when of+useColor when_ isTerm =+  case when_ of     Never  -> False     Always -> True     Auto   -> isTerm@@ -521,6 +535,10 @@   Maximum a `mappend` Maximum b = Maximum (a `max` b)   MinusInfinity `mappend` a = a   a `mappend` MinusInfinity = a+#if MIN_VERSION_base(4,9,0)+instance Ord a => Semigroup (Maximum a) where+  (<>) = mappend+#endif  -- | Compute the amount of space needed to align "OK"s and "FAIL"s computeAlignment :: OptionSet -> TestTree -> Int

@@ -1,5 +1,5 @@ -- | Ingredient for listing test names-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module Test.Tasty.Ingredients.ListTests   ( ListTests(..)   , testsNames@@ -8,8 +8,10 @@  import Data.Proxy import Data.Typeable-import Data.Monoid import Options.Applicative+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid+#endif  import Test.Tasty.Core import Test.Tasty.Options

@@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable,              ExistentialQuantification, GADTs,-             OverlappingInstances, FlexibleInstances, UndecidableInstances,+             FlexibleInstances, UndecidableInstances,              TypeOperators #-} -- | Extensible options. They are used for provider-specific settings, -- ingredient-specific settings and core settings (such as the test name pattern).@@ -29,9 +29,12 @@ import Data.Typeable import Data.Monoid import Data.Foldable-import Prelude  -- Silence FTP import warnings-+import Prelude hiding (mod) -- Silence FTP import warnings import Options.Applicative+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup)+import qualified Data.Semigroup (Semigroup((<>)))+#endif  -- | An option is a data type that inhabits the `IsOption` type class. class Typeable v => IsOption v where@@ -82,6 +85,10 @@   mempty = OptionSet mempty   OptionSet a `mappend` OptionSet b =     OptionSet $ Map.unionWith (flip const) a b+#if MIN_VERSION_base(4,9,0)+instance Semigroup OptionSet where+  (<>) = mappend+#endif  -- | Set the option value setOption :: IsOption v => v -> OptionSet -> OptionSet

@@ -1,5 +1,5 @@ -- | Core options, i.e. the options used by tasty itself-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- for (^) module Test.Tasty.Options.Core   ( NumThreads(..)@@ -12,12 +12,13 @@ import Control.Monad (mfilter) import Data.Proxy import Data.Typeable+#if !MIN_VERSION_base(4,8,0) import Data.Tagged-import Data.Fixed import Data.Monoid-import Options.Applicative+#endif+import Data.Fixed+import Options.Applicative hiding (str) import GHC.Conc-import Prelude  -- Silence FTP import warnings  import Test.Tasty.Options import Test.Tasty.Patterns

@@ -125,7 +125,7 @@           -- an exception strikes before we 'release'. Everything will be           -- killed, so why bother.           return $ do-            pid <- forkCarefully (do a; release)+            pid <- forkCarefully (do a :: IO (); release)             labelThread pid "tasty_test_thread"             cont 

@@ -28,7 +28,7 @@ -- -- (Most of the code borrowed from the test-framework) -{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP, DeriveDataTypeable #-}  module Test.Tasty.Patterns   ( TestPattern@@ -44,10 +44,12 @@  import Data.List import Data.Typeable+#if !MIN_VERSION_base(4,8,0) import Data.Tagged+import Data.Monoid+#endif  import Options.Applicative-import Data.Monoid  data Token = SlashToken            | WildcardToken

@@ -196,7 +196,7 @@ -- | 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+createTestActions opts0 tree = do   let     traversal ::       Traversal (WriterT ([(InitFinPair -> IO (), TVar Status)], [ResourceVar]) IO)@@ -206,7 +206,7 @@           { foldSingle = runSingleTest           , foldResource = addInitAndRelease           }-        opts tree+        opts0 tree   (tests, rvars) <- unwrap traversal   let tests' = map (first ($ (Seq.empty, Seq.empty))) tests   return (tests', rvars)@@ -261,17 +261,17 @@     -- 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+launchTestTree opts tree k0 = do   (testActions, rvars) <- createTestActions opts tree   let NumThreads numTheads = lookupOption opts-  (t,k) <- timed $ do+  (t,k1) <- timed $ do      abortTests <- runInParallel numTheads (fst <$> testActions)      (do let smap = IntMap.fromList $ zip [0..] (snd <$> testActions)-         k smap)+         k0 smap)       `finally` do          abortTests          waitForResources rvars-  k t+  k1 t   where     alive :: Resource r -> Bool     alive r = case r of@@ -304,5 +304,10 @@ getTime :: IO Time getTime = do   t <- Clock.getTime Clock.Monotonic-  let ns = realToFrac $ Clock.timeSpecAsNanoSecs t+  let ns = realToFrac $+#if MIN_VERSION_clock(0,7,1)+        Clock.toNanoSecs t+#else+        Clock.timeSpecAsNanoSecs t+#endif   return $ ns / 10 ^ (9 :: Int)

@@ -44,12 +44,20 @@ import Data.Monoid import Control.Applicative import Prelude  -- Silence AMP import warnings+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup)+import qualified Data.Semigroup (Semigroup((<>)))+#endif  -- | 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+#if MIN_VERSION_base(4,9,0)+instance Applicative f => Semigroup (Traversal f) where+  (<>) = mappend+#endif  -- | Monoid generated by @'liftA2' ('<>')@ newtype Ap f a = Ap { getApp :: f a }@@ -57,3 +65,7 @@ instance (Applicative f, Monoid a) => Monoid (Ap f a) where   mempty = pure mempty   mappend = liftA2 mappend+#if MIN_VERSION_base(4,9,0)+instance (Applicative f, Monoid a) => Semigroup (Ap f a) where+  (<>) = mappend+#endif

@@ -15,7 +15,7 @@ -- -- See e.g. <https://github.com/feuerbach/tasty/issues/25> formatMessage :: String -> IO String-formatMessage msg = go 3 msg+formatMessage = go 3   where     -- to avoid infinite recursion, we introduce the recursion limit     go :: Int -> String -> IO String

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                tasty-version:             0.12+version:             0.12.0.1 synopsis:            Modern and extensible testing framework description:         Tasty is a modern testing framework for Haskell.                      It lets you combine your unit tests, golden@@ -70,4 +70,5 @@    -- hs-source-dirs:         default-language:    Haskell2010-  ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing+  default-extensions:  CPP+  ghc-options: -Wall