Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-hspec-core for openSUSE:Factory checked in at 2023-01-28 18:44:31 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hspec-core (Old) and /work/SRC/openSUSE:Factory/.ghc-hspec-core.new.32243 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hspec-core" Sat Jan 28 18:44:31 2023 rev:29 rq:1061632 version:2.10.9 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hspec-core/ghc-hspec-core.changes 2023-01-18 13:10:15.776626114 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-hspec-core.new.32243/ghc-hspec-core.changes 2023-01-28 18:52:00.432895458 +0100 @@ -1,0 +2,6 @@ +Fri Jan 27 12:38:22 UTC 2023 - Peter Simons <[email protected]> + +- Update hspec-core to version 2.10.9. + Upstream does not provide a change log file. + +------------------------------------------------------------------- Old: ---- hspec-core-2.10.8.tar.gz New: ---- hspec-core-2.10.9.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hspec-core.spec ++++++ --- /var/tmp/diff_new_pack.hcAZwR/_old 2023-01-28 18:52:00.924898244 +0100 +++ /var/tmp/diff_new_pack.hcAZwR/_new 2023-01-28 18:52:00.928898267 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-hspec-core # -# Copyright (c) 2022 SUSE LLC +# Copyright (c) 2023 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name hspec-core %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.10.8 +Version: 2.10.9 Release: 0 Summary: A Testing Framework for Haskell License: MIT ++++++ hspec-core-2.10.8.tar.gz -> hspec-core-2.10.9.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/LICENSE new/hspec-core-2.10.9/LICENSE --- old/hspec-core-2.10.8/LICENSE 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/LICENSE 2001-09-09 03:46:40.000000000 +0200 @@ -1,4 +1,4 @@ -Copyright (c) 2011-2022 Simon Hengel <[email protected]> +Copyright (c) 2011-2023 Simon Hengel <[email protected]> Copyright (c) 2011-2012 Trystan Spangler <[email protected]> Copyright (c) 2011-2011 Greg Weber <[email protected]> diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/help.txt new/hspec-core-2.10.9/help.txt --- old/hspec-core-2.10.8/help.txt 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/help.txt 2001-09-09 03:46:40.000000000 +0200 @@ -11,7 +11,7 @@ anything --[no-]focused-only do not run anything, unless there are focused spec items - --[no-]fail-on=ITEMS empty: fail if no spec items have been run + --[no-]fail-on=ITEMS empty: fail if all spec items have been filtered focused: fail on focused spec items pending: fail on pending spec items --[no-]strict same as --fail-on=focused,pending diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/hspec-core.cabal new/hspec-core-2.10.9/hspec-core.cabal --- old/hspec-core-2.10.8/hspec-core.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/hspec-core.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,14 +1,14 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0. +-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack name: hspec-core -version: 2.10.8 +version: 2.10.9 license: MIT license-file: LICENSE -copyright: (c) 2011-2022 Simon Hengel, +copyright: (c) 2011-2023 Simon Hengel, (c) 2011-2012 Trystan Spangler, (c) 2011 Greg Weber maintainer: Simon Hengel <[email protected]> @@ -19,7 +19,7 @@ category: Testing stability: experimental bug-reports: https://github.com/hspec/hspec/issues -homepage: http://hspec.github.io/ +homepage: https://hspec.github.io/ synopsis: A Testing Framework for Haskell description: This package exposes internal types and functions that can be used to extend Hspec's functionality. @@ -87,6 +87,7 @@ Test.Hspec.Core.Formatters.V1.Monad Test.Hspec.Core.QuickCheckUtil Test.Hspec.Core.Runner.Eval + Test.Hspec.Core.Runner.JobQueue Test.Hspec.Core.Runner.PrintSlowSpecItems Test.Hspec.Core.Runner.Result Test.Hspec.Core.Shuffle @@ -172,6 +173,7 @@ Test.Hspec.Core.QuickCheckUtil Test.Hspec.Core.Runner Test.Hspec.Core.Runner.Eval + Test.Hspec.Core.Runner.JobQueue Test.Hspec.Core.Runner.PrintSlowSpecItems Test.Hspec.Core.Runner.Result Test.Hspec.Core.Shuffle @@ -206,6 +208,7 @@ Test.Hspec.Core.HooksSpec Test.Hspec.Core.QuickCheckUtilSpec Test.Hspec.Core.Runner.EvalSpec + Test.Hspec.Core.Runner.JobQueueSpec Test.Hspec.Core.Runner.PrintSlowSpecItemsSpec Test.Hspec.Core.Runner.ResultSpec Test.Hspec.Core.RunnerSpec diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/GetOpt/Declarative/Interpret.hs new/hspec-core-2.10.9/src/GetOpt/Declarative/Interpret.hs --- old/hspec-core-2.10.8/src/GetOpt/Declarative/Interpret.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/GetOpt/Declarative/Interpret.hs 2001-09-09 03:46:40.000000000 +0200 @@ -7,7 +7,6 @@ import Prelude () import Test.Hspec.Core.Compat -import Data.Maybe import System.Console.GetOpt (OptDescr, ArgOrder(..), getOpt) import qualified System.Console.GetOpt as GetOpt diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Compat.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Compat.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Compat.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Compat.hs 2001-09-09 03:46:40.000000000 +0200 @@ -16,9 +16,14 @@ , sequence , sequence_ ) +import Data.Maybe as Imports import Data.Foldable as Imports import Data.CallStack as Imports (HasCallStack) +import System.IO +import System.Exit +import System.Environment + #if MIN_VERSION_base(4,11,0) import Data.Functor as Imports #endif @@ -73,7 +78,6 @@ import System.Environment as Imports (lookupEnv) #else import Text.Read -import System.Environment import qualified Text.ParserCombinators.ReadP as P #endif @@ -182,3 +186,9 @@ pass :: Monad m => m () pass = return () #endif + +die :: String -> IO a +die err = do + name <- getProgName + hPutStrLn stderr $ name <> ": " <> err + exitFailure diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Config/Definition.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Config/Definition.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Config/Definition.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Config/Definition.hs 2001-09-09 03:46:40.000000000 +0200 @@ -4,7 +4,7 @@ , ColorMode(..) , UnicodeMode(..) , filterOr -, defaultConfig +, mkDefaultConfig , commandLineOnlyOptions , formatterOptions @@ -27,8 +27,7 @@ import Test.Hspec.Core.Example (Params(..), defaultParams) import Test.Hspec.Core.Format (Format, FormatConfig) import Test.Hspec.Core.Formatters.Pretty (pretty2) -import qualified Test.Hspec.Core.Formatters.V1 as V1 -import qualified Test.Hspec.Core.Formatters.V2 as V2 +import qualified Test.Hspec.Core.Formatters.V1.Monad as V1 import Test.Hspec.Core.Util import GetOpt.Declarative @@ -89,8 +88,8 @@ , configConcurrentJobs :: Maybe Int } -defaultConfig :: Config -defaultConfig = Config { +mkDefaultConfig :: [(String, FormatConfig -> IO Format)] -> Config +mkDefaultConfig formatters = Config { configIgnoreConfigFile = False , configDryRun = False , configFocusedOnly = False @@ -120,13 +119,7 @@ , configPrettyPrint = True , configPrettyPrintFunction = pretty2 , configTimes = False -, configAvailableFormatters = map (fmap V2.formatterToFormat) [ - ("checks", V2.checks) - , ("specdoc", V2.specdoc) - , ("progress", V2.progress) - , ("failed-examples", V2.failed_examples) - , ("silent", V2.silent) - ] +, configAvailableFormatters = formatters , configFormat = Nothing , configFormatter = Nothing , configHtmlOutput = False @@ -346,7 +339,7 @@ showFailOn item <> ": " <> help item where help item = case item of - FailOnEmpty -> "fail if no spec items have been run" + FailOnEmpty -> "fail if all spec items have been filtered" FailOnFocused -> "fail on focused spec items" FailOnPending -> "fail on pending spec items" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Config.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Config.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Config.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Config.hs 2001-09-09 03:46:40.000000000 +0200 @@ -18,7 +18,6 @@ import Prelude () import Test.Hspec.Core.Compat -import Data.Maybe import System.IO import System.IO.Error import System.Exit @@ -29,10 +28,20 @@ import Test.Hspec.Core.Util import Test.Hspec.Core.Config.Options -import Test.Hspec.Core.Config.Definition (Config(..), ColorMode(..), UnicodeMode(..), defaultConfig, filterOr) +import Test.Hspec.Core.Config.Definition (Config(..), ColorMode(..), UnicodeMode(..), mkDefaultConfig, filterOr) import Test.Hspec.Core.FailureReport import Test.Hspec.Core.QuickCheckUtil (mkGen) import Test.Hspec.Core.Example (Params(..), defaultParams) +import qualified Test.Hspec.Core.Formatters.V2 as V2 + +defaultConfig :: Config +defaultConfig = mkDefaultConfig $ map (fmap V2.formatterToFormat) [ + ("checks", V2.checks) + , ("specdoc", V2.specdoc) + , ("progress", V2.progress) + , ("failed-examples", V2.failed_examples) + , ("silent", V2.silent) + ] -- | Add a filter predicate to config. If there is already a filter predicate, -- then combine them with `||`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Example/Location.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Example/Location.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Example/Location.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Example/Location.hs 2001-09-09 03:46:40.000000000 +0200 @@ -17,7 +17,6 @@ import Test.Hspec.Core.Compat import Data.Char -import Data.Maybe import GHC.IO.Exception #ifdef mingw32_HOST_OS diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Example.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Example.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Example.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Example.hs 2001-09-09 03:46:40.000000000 +0200 @@ -21,6 +21,7 @@ , safeEvaluateExample -- END RE-EXPORTED from Test.Hspec.Core.Spec , safeEvaluateResultStatus +, exceptionToResultStatus , toLocation ) where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Formatters/Internal.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Formatters/Internal.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Formatters/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Formatters/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -198,7 +198,7 @@ runFormatM :: FormatConfig -> FormatM a -> IO a runFormatM config (FormatM action) = withLineBuffering $ do time <- getMonotonicTime - cpuTime <- if (formatConfigPrintCpuTime config) then Just <$> CPUTime.getCPUTime else pure Nothing + cpuTime <- if formatConfigPrintCpuTime config then Just <$> CPUTime.getCPUTime else pure Nothing let progress = formatConfigReportProgress config && not (formatConfigHtmlOutput config) @@ -245,9 +245,9 @@ writeTransient :: String -> FormatM () writeTransient new = do reportProgress <- getConfig formatConfigReportProgress - when (reportProgress) $ do + when reportProgress $ do h <- getHandle - write $ new + write new liftIO $ IO.hFlush h write $ "\r" ++ replicate (length new) ' ' ++ "\r" @@ -347,7 +347,7 @@ getCPUTime = do t1 <- liftIO CPUTime.getCPUTime mt0 <- gets stateCpuStartTime - return $ toSeconds <$> ((-) <$> pure t1 <*> mt0) + return $ toSeconds <$> ((t1 -) <$> mt0) where toSeconds x = Seconds (fromIntegral x / (10.0 ^ (12 :: Integer))) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Formatters/Pretty.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Formatters/Pretty.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Formatters/Pretty.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Formatters/Pretty.hs 2001-09-09 03:46:40.000000000 +0200 @@ -5,6 +5,7 @@ #ifdef TEST , pretty , recoverString +, recoverMultiLineString #endif ) where @@ -20,25 +21,27 @@ import Test.Hspec.Core.Formatters.Pretty.Parser pretty2 :: Bool -> String -> String -> (String, String) -pretty2 unicode expected actual = case (recoverString unicode expected, recoverString unicode actual) of +pretty2 unicode expected actual = case (recoverMultiLineString unicode expected, recoverMultiLineString unicode actual) of (Just expected_, Just actual_) -> (expected_, actual_) _ -> case (pretty unicode expected, pretty unicode actual) of - (Just expected_, Just actual_) -> (expected_, actual_) - _ -> (rec expected, rec actual) - where - rec = if unicode then urecover else id + (Just expected_, Just actual_) | expected_ /= actual_ -> (expected_, actual_) + _ -> (expected, actual) - urecover :: String -> String - urecover xs = maybe xs ushow $ readMaybe xs +recoverString :: String -> Maybe String +recoverString xs = case xs of + '"' : _ -> case reverse xs of + '"' : _ -> readMaybe xs + _ -> Nothing + _ -> Nothing -recoverString :: Bool -> String -> Maybe String -recoverString unicode input = case readMaybe input of +recoverMultiLineString :: Bool -> String -> Maybe String +recoverMultiLineString unicode input = case recoverString input of Just r | shouldParseBack r -> Just r _ -> Nothing where shouldParseBack = (&&) <$> all isSafe <*> isMultiLine isMultiLine = lines >>> length >>> (> 1) - isSafe c = (unicode || isAscii c) && (not $ isControl c) || c == '\n' + isSafe c = (unicode || isAscii c) && not (isControl c) || c == '\n' pretty :: Bool -> String -> Maybe String pretty unicode = parseValue >=> render_ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Formatters/V1.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Formatters/V1.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Formatters/V1.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Formatters/V1.hs 2001-09-09 03:46:40.000000000 +0200 @@ -62,7 +62,6 @@ import Prelude () import Test.Hspec.Core.Compat hiding (First) -import Data.Maybe import Test.Hspec.Core.Util import Test.Hspec.Core.Clock import Test.Hspec.Core.Example (Location(..)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Formatters/V2.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Formatters/V2.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Formatters/V2.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Formatters/V2.hs 2001-09-09 03:46:40.000000000 +0200 @@ -21,6 +21,9 @@ -- Actions live in the `FormatM` monad. It provides access to the runner state -- and primitives for appending to the generated report. , Formatter (..) +, Path +, Progress +, Location(..) , Item(..) , Result(..) , FailureReason (..) @@ -80,10 +83,9 @@ import Test.Hspec.Core.Compat hiding (First) import Data.Char -import Data.Maybe import Test.Hspec.Core.Util import Test.Hspec.Core.Clock -import Test.Hspec.Core.Example (Location(..)) +import Test.Hspec.Core.Example (Location(..), Progress) import Text.Printf import Test.Hspec.Core.Formatters.Pretty.Unicode (ushow) import Control.Monad.IO.Class diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Hooks.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Hooks.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Hooks.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Hooks.hs 2001-09-09 03:46:40.000000000 +0200 @@ -4,7 +4,12 @@ {-# LANGUAGE ConstraintKinds #-} -- | Stability: provisional module Test.Hspec.Core.Hooks ( - before +-- * Types + Spec +, SpecWith +, ActionWith +-- * Hooks +, before , before_ , beforeWith , beforeAll @@ -109,11 +114,12 @@ -- | Run a custom action before and/or after every spec item. aroundWith :: (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b -aroundWith = mapSpecItem_ . modifyAroundAction +aroundWith = mapSpecItem_ . modifyHook -modifyAroundAction :: (ActionWith a -> ActionWith b) -> Item a -> Item b -modifyAroundAction action item@Item{itemExample = e} = - item{ itemExample = \params aroundAction -> e params (aroundAction . action) } +modifyHook :: (ActionWith a -> ActionWith b) -> Item a -> Item b +modifyHook action item = item { + itemExample = \ params hook -> itemExample item params (hook . action) + } -- | Wrap an action around the given spec. aroundAll :: HasCallStack => (ActionWith a -> IO ()) -> SpecWith a -> Spec diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/QuickCheckUtil.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/QuickCheckUtil.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/QuickCheckUtil.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/QuickCheckUtil.hs 2001-09-09 03:46:40.000000000 +0200 @@ -22,7 +22,6 @@ import Prelude () import Test.Hspec.Core.Compat -import Data.Maybe import Data.Int import System.Random diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Runner/Eval.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Runner/Eval.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Runner/Eval.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Runner/Eval.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,38 +2,24 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE RankNTypes #-} - -#if MIN_VERSION_base(4,6,0) && !MIN_VERSION_base(4,7,0) --- Control.Concurrent.QSem is deprecated in base-4.6.0.* -{-# OPTIONS_GHC -fno-warn-deprecations #-} -#endif - module Test.Hspec.Core.Runner.Eval ( EvalConfig(..) , EvalTree , Tree(..) , EvalItem(..) +, Concurrency(..) , runFormatter #ifdef TEST , mergeResults -, runSequentially #endif ) where import Prelude () import Test.Hspec.Core.Compat hiding (Monad) -import qualified Test.Hspec.Core.Compat as M - -import Control.Concurrent -import Control.Concurrent.Async hiding (cancel) import Control.Monad.IO.Class (liftIO) -import qualified Control.Monad.IO.Class as M - import Control.Monad.Trans.Reader import Control.Monad.Trans.Class @@ -44,21 +30,19 @@ import qualified Test.Hspec.Core.Format as Format import Test.Hspec.Core.Clock import Test.Hspec.Core.Example.Location -import Test.Hspec.Core.Example (safeEvaluateResultStatus) +import Test.Hspec.Core.Example (safeEvaluateResultStatus, exceptionToResultStatus) import qualified NonEmpty import NonEmpty (NonEmpty(..)) +import Test.Hspec.Core.Runner.JobQueue + data Tree c a = Node String (NonEmpty (Tree c a)) | NodeWithCleanup (Maybe (String, Location)) c (NonEmpty (Tree c a)) | Leaf a deriving (Eq, Show, Functor, Foldable, Traversable) --- for compatibility with GHC < 7.10.1 -type Monad m = (Functor m, Applicative m, M.Monad m) -type MonadIO m = (Monad m, M.MonadIO m) - data EvalConfig = EvalConfig { evalConfigFormat :: Format , evalConfigConcurrentJobs :: Int @@ -67,6 +51,7 @@ data Env = Env { envConfig :: EvalConfig +, envFailed :: IORef Bool , envResults :: IORef [(Path, Format.Item)] } @@ -77,14 +62,21 @@ type EvalM = ReaderT Env IO +setFailed :: EvalM () +setFailed = do + ref <- asks envFailed + liftIO $ writeIORef ref True + +hasFailed :: EvalM Bool +hasFailed = do + ref <- asks envFailed + liftIO $ readIORef ref + addResult :: Path -> Format.Item -> EvalM () addResult path item = do ref <- asks envResults liftIO $ modifyIORef ref ((path, item) :) -getResults :: EvalM [(Path, Format.Item)] -getResults = reverse <$> (asks envResults >>= liftIO . readIORef) - reportItem :: Path -> Maybe Location -> EvalM (Seconds, Result) -> EvalM () reportItem path loc action = do reportItemStarted path @@ -95,6 +87,12 @@ reportItemDone :: Path -> Format.Item -> EvalM () reportItemDone path item = do + let + isFailure = case Format.itemResult item of + Format.Success{} -> False + Format.Pending{} -> False + Format.Failure{} -> True + when isFailure setFailed addResult path item formatEvent $ Format.ItemDone path item @@ -116,8 +114,8 @@ data EvalItem = EvalItem { evalItemDescription :: String , evalItemLocation :: Maybe Location -, evalItemParallelize :: Bool -, evalItemAction :: ProgressCallback -> IO Result +, evalItemConcurrency :: Concurrency +, evalItemAction :: ProgressCallback -> IO (Seconds, Result) } type EvalTree = Tree (IO ()) EvalItem @@ -125,46 +123,55 @@ -- | Evaluate all examples of a given spec and produce a report. runFormatter :: EvalConfig -> [EvalTree] -> IO ([(Path, Format.Item)]) runFormatter config specs = do - ref <- newIORef [] + withJobQueue (evalConfigConcurrentJobs config) $ \ queue -> do + withTimer 0.05 $ \ timer -> do + env <- mkEnv + runningSpecs_ <- enqueueItems queue specs - let - start = parallelizeTree (evalConfigConcurrentJobs config) specs - cancel = cancelMany . concatMap toList . map (fmap fst) + let + applyReportProgress :: RunningItem_ IO -> RunningItem + applyReportProgress item = fmap (. reportProgress timer) item - bracket start cancel $ \ runningSpecs -> do - withTimer 0.05 $ \ timer -> do + runningSpecs :: [RunningTree ()] + runningSpecs = applyCleanup $ map (fmap applyReportProgress) runningSpecs_ - format Format.Started - runReaderT (run . applyCleanup $ map (fmap (fmap (. reportProgress timer) . snd)) runningSpecs) (Env config ref) `finally` do - results <- reverse <$> readIORef ref - format (Format.Done results) + getResults :: IO [(Path, Format.Item)] + getResults = reverse <$> readIORef (envResults env) - results <- reverse <$> readIORef ref - return results + formatItems :: IO () + formatItems = runReaderT (eval runningSpecs) env + + formatDone :: IO () + formatDone = getResults >>= format . Format.Done + + format Format.Started + formatItems `finally` formatDone + getResults where + mkEnv :: IO Env + mkEnv = Env config <$> newIORef False <*> newIORef [] + + format :: Format format = evalConfigFormat config + reportProgress :: IO Bool -> Path -> Progress -> IO () reportProgress timer path progress = do r <- timer when r $ do format (Format.Progress path progress) -cancelMany :: [Async a] -> IO () -cancelMany asyncs = do - mapM_ (killThread . asyncThreadId) asyncs - mapM_ waitCatch asyncs - data Item a = Item { - _itemDescription :: String -, _itemLocation :: Maybe Location + itemDescription :: String +, itemLocation :: Maybe Location , itemAction :: a } deriving Functor -type Job m progress a = (progress -> m ()) -> m a - type RunningItem = Item (Path -> IO (Seconds, Result)) type RunningTree c = Tree c RunningItem +type RunningItem_ m = Item (Job m Progress (Seconds, Result)) +type RunningTree_ m = Tree (IO ()) (RunningItem_ m) + applyCleanup :: [RunningTree (IO ())] -> [RunningTree ()] applyCleanup = map go where @@ -211,63 +218,23 @@ Just (name, _) -> Just $ "in " ++ name ++ "-hook:" Nothing -> Nothing -type RunningItem_ m = (Async (), Item (Job m Progress (Seconds, Result))) -type RunningTree_ m = Tree (IO ()) (RunningItem_ m) - -data Semaphore = Semaphore { - semaphoreWait :: IO () -, semaphoreSignal :: IO () -} +enqueueItems :: MonadIO m => JobQueue -> [EvalTree] -> IO [RunningTree_ m] +enqueueItems queue = mapM (traverse $ enqueueItem queue) -parallelizeTree :: MonadIO m => Int -> [EvalTree] -> IO [RunningTree_ m] -parallelizeTree n specs = do - sem <- newQSem n - mapM (traverse $ parallelizeItem sem) specs - -parallelizeItem :: MonadIO m => QSem -> EvalItem -> IO (RunningItem_ m) -parallelizeItem sem EvalItem{..} = do - (asyncAction, evalAction) <- parallelize (Semaphore (waitQSem sem) (signalQSem sem)) evalItemParallelize (interruptible . evalItemAction) - return (asyncAction, Item evalItemDescription evalItemLocation evalAction) - -parallelize :: MonadIO m => Semaphore -> Bool -> Job IO progress a -> IO (Async (), Job m progress (Seconds, a)) -parallelize sem isParallelizable - | isParallelizable = runParallel sem - | otherwise = runSequentially - -runSequentially :: MonadIO m => Job IO progress a -> IO (Async (), Job m progress (Seconds, a)) -runSequentially action = do - mvar <- newEmptyMVar - (asyncAction, evalAction) <- runParallel (Semaphore (takeMVar mvar) pass) action - return (asyncAction, \ notifyPartial -> liftIO (putMVar mvar ()) >> evalAction notifyPartial) - -data Parallel progress a = Partial progress | Return a - -runParallel :: forall m progress a. MonadIO m => Semaphore -> Job IO progress a -> IO (Async (), Job m progress (Seconds, a)) -runParallel Semaphore{..} action = do - mvar <- newEmptyMVar - asyncAction <- async $ bracket_ semaphoreWait semaphoreSignal (worker mvar) - return (asyncAction, eval mvar) +enqueueItem :: MonadIO m => JobQueue -> EvalItem -> IO (RunningItem_ m) +enqueueItem queue EvalItem{..} = do + job <- enqueueJob queue evalItemConcurrency evalItemAction + return Item { + itemDescription = evalItemDescription + , itemLocation = evalItemLocation + , itemAction = job >=> liftIO . either exceptionToResult return + } where - worker :: MVar (Parallel progress (Seconds, a)) -> IO () - worker mvar = do - let partialCallback = replaceMVar mvar . Partial - result <- measure $ action partialCallback - replaceMVar mvar (Return result) - - eval :: MVar (Parallel progress (Seconds, a)) -> (progress -> m ()) -> m (Seconds, a) - eval mvar notifyPartial = do - r <- liftIO (takeMVar mvar) - case r of - Partial p -> do - notifyPartial p - eval mvar notifyPartial - Return result -> return result + exceptionToResult :: SomeException -> IO (Seconds, Result) + exceptionToResult err = (,) 0 . Result "" <$> exceptionToResultStatus err -replaceMVar :: MVar a -> a -> IO () -replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p - -run :: [RunningTree ()] -> EvalM () -run specs = do +eval :: [RunningTree ()] -> EvalM () +eval specs = do failFast <- asks (evalConfigFailFast . envConfig) sequenceActions failFast (concatMap foldSpec specs) where @@ -320,13 +287,5 @@ action stopNow <- case failFast of False -> return False - True -> any itemIsFailure <$> getResults + True -> hasFailed unless stopNow (go actions) - - itemIsFailure :: (Path, Format.Item) -> Bool - itemIsFailure = isFailure . Format.itemResult . snd - where - isFailure r = case r of - Format.Success{} -> False - Format.Pending{} -> False - Format.Failure{} -> True diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Runner/JobQueue.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Runner/JobQueue.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Runner/JobQueue.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Runner/JobQueue.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,121 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ConstraintKinds #-} + +#if MIN_VERSION_base(4,6,0) && !MIN_VERSION_base(4,7,0) +-- Control.Concurrent.QSem is deprecated in base-4.6.0.* +{-# OPTIONS_GHC -fno-warn-deprecations #-} +#endif + +module Test.Hspec.Core.Runner.JobQueue ( + MonadIO +, Job +, Concurrency(..) +, JobQueue +, withJobQueue +, enqueueJob +) where + +import Prelude () +import Test.Hspec.Core.Compat hiding (Monad) +import qualified Test.Hspec.Core.Compat as M + +import Control.Concurrent +import Control.Concurrent.Async (Async, AsyncCancelled(..), async, waitCatch, asyncThreadId) + +import Control.Monad.IO.Class (liftIO) +import qualified Control.Monad.IO.Class as M + +-- for compatibility with GHC < 7.10.1 +type Monad m = (Functor m, Applicative m, M.Monad m) +type MonadIO m = (Monad m, M.MonadIO m) + +type Job m progress a = (progress -> m ()) -> m a + +data Concurrency = Sequential | Concurrent + +data JobQueue = JobQueue { + _semaphore :: Semaphore +, _cancelQueue :: CancelQueue +} + +data Semaphore = Semaphore { + _wait :: IO () +, _signal :: IO () +} + +type CancelQueue = IORef [Async ()] + +withJobQueue :: Int -> (JobQueue -> IO a) -> IO a +withJobQueue concurrency = bracket new cancelAll + where + new :: IO JobQueue + new = JobQueue <$> newSemaphore concurrency <*> newIORef [] + + cancelAll :: JobQueue -> IO () + cancelAll (JobQueue _ cancelQueue) = readIORef cancelQueue >>= cancelMany + + cancelMany :: [Async a] -> IO () + cancelMany jobs = do + mapM_ notifyCancel jobs + mapM_ waitCatch jobs + + notifyCancel :: Async a -> IO () + notifyCancel = flip throwTo AsyncCancelled . asyncThreadId + +newSemaphore :: Int -> IO Semaphore +newSemaphore capacity = do + sem <- newQSem capacity + return $ Semaphore (waitQSem sem) (signalQSem sem) + +enqueueJob :: MonadIO m => JobQueue -> Concurrency -> Job IO progress a -> IO (Job m progress (Either SomeException a)) +enqueueJob (JobQueue sem cancelQueue) concurrency = case concurrency of + Sequential -> runSequentially cancelQueue + Concurrent -> runConcurrently sem cancelQueue + +runSequentially :: forall m progress a. MonadIO m => CancelQueue -> Job IO progress a -> IO (Job m progress (Either SomeException a)) +runSequentially cancelQueue action = do + barrier <- newEmptyMVar + let + wait :: IO () + wait = takeMVar barrier + + signal :: m () + signal = liftIO $ putMVar barrier () + + job <- runConcurrently (Semaphore wait pass) cancelQueue action + return $ \ notifyPartial -> signal >> job notifyPartial + +data Partial progress a = Partial progress | Done + +runConcurrently :: forall m progress a. MonadIO m => Semaphore -> CancelQueue -> Job IO progress a -> IO (Job m progress (Either SomeException a)) +runConcurrently (Semaphore wait signal) cancelQueue action = do + result :: MVar (Partial progress a) <- newEmptyMVar + let + worker :: IO a + worker = bracket_ wait signal $ do + interruptible (action partialResult) `finally` done + where + partialResult :: progress -> IO () + partialResult = replaceMVar result . Partial + + done :: IO () + done = replaceMVar result Done + + pushOnCancelQueue :: Async a -> IO () + pushOnCancelQueue = (modifyIORef cancelQueue . (:) . void) + + job <- bracket (async worker) pushOnCancelQueue return + + let + waitForResult :: (progress -> m ()) -> m (Either SomeException a) + waitForResult notifyPartial = do + r <- liftIO (takeMVar result) + case r of + Partial progress -> notifyPartial progress >> waitForResult notifyPartial + Done -> liftIO $ waitCatch job + + return waitForResult + +replaceMVar :: MVar a -> a -> IO () +replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Runner/Result.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Runner/Result.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Runner/Result.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Runner/Result.hs 2001-09-09 03:46:40.000000000 +0200 @@ -59,11 +59,11 @@ | ResultItemFailure deriving (Eq, Show) -toSpecResult :: Bool -> [(Path, Format.Item)] -> SpecResult -toSpecResult failOnEmpty results = SpecResult items success +toSpecResult :: [(Path, Format.Item)] -> SpecResult +toSpecResult results = SpecResult items success where items = map toResultItem results - success = not (failOnEmpty && null results) && all (not . resultItemIsFailure) items + success = all (not . resultItemIsFailure) items toResultItem :: (Path, Format.Item) -> ResultItem toResultItem (path, item) = ResultItem path status diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Runner.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Runner.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Runner.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Runner.hs 2001-09-09 03:46:40.000000000 +0200 @@ -75,6 +75,10 @@ , isSuccess , evaluateSummary +-- * Re-exports +, Spec +, SpecWith + #ifdef TEST , rerunAll , specToEvalForest @@ -86,11 +90,10 @@ import Prelude () import Test.Hspec.Core.Compat -import Data.Maybe import NonEmpty (nonEmpty) import System.IO import System.Environment (getArgs, withArgs) -import System.Exit +import System.Exit (exitFailure) import System.Random import Control.Monad.ST import Data.STRef @@ -99,6 +102,7 @@ import qualified Test.QuickCheck as QC import Test.Hspec.Core.Util (Path) +import Test.Hspec.Core.Clock import Test.Hspec.Core.Spec hiding (pruneTree, pruneForest) import Test.Hspec.Core.Config import Test.Hspec.Core.Format (Format, FormatConfig(..)) @@ -150,7 +154,7 @@ removeCleanup _ = pass markSuccess :: EvalItem -> EvalItem - markSuccess item = item {evalItemAction = \ _ -> return $ Result "" Success} + markSuccess item = item {evalItemAction = \ _ -> return (0, Result "" Success)} -- | Run a given spec and write a report to `stdout`. -- Exit with `exitFailure` if at least one spec item fails. @@ -273,9 +277,6 @@ then runSpecForest spec c_ else return result -runSpecForest_ :: Config -> [SpecTree ()] -> IO SpecResult -runSpecForest_ config spec = runEvalTree config (specToEvalForest config spec) - mapItem :: (Item a -> Item b) -> [SpecTree a] -> [SpecTree b] mapItem f = map (fmap f) @@ -320,13 +321,17 @@ | configFocusedOnly config = spec | otherwise = focusForest spec -runEvalTree :: Config -> [EvalTree] -> IO SpecResult -runEvalTree config spec = do +runSpecForest_ :: Config -> [SpecTree ()] -> IO SpecResult +runSpecForest_ config spec = do let - failOnEmpty = configFailOnEmpty config - seed = (fromJust . configQuickCheckSeed) config - qcArgs = configQuickCheckArgs config - !numberOfItems = countSpecItems spec + filteredSpec = specToEvalForest config spec + seed = (fromJust . configQuickCheckSeed) config + qcArgs = configQuickCheckArgs config + !numberOfItems = countEvalItems filteredSpec + + when (configFailOnEmpty config && numberOfItems == 0) $ do + when (countSpecItems spec /= 0) $ do + die "all spec items have been filtered; failing due to --fail-on=empty" concurrentJobs <- case configConcurrentJobs config of Nothing -> getDefaultConcurrentJobs @@ -335,7 +340,7 @@ (reportProgress, useColor) <- colorOutputSupported (configColorMode config) (hSupportsANSI stdout) outputUnicode <- unicodeOutputSupported (configUnicodeMode config) stdout - results <- fmap (toSpecResult failOnEmpty) . withHiddenCursor reportProgress stdout $ do + results <- fmap toSpecResult . withHiddenCursor reportProgress stdout $ do let formatConfig = FormatConfig { formatConfigUseColor = useColor @@ -363,7 +368,7 @@ , evalConfigConcurrentJobs = concurrentJobs , evalConfigFailFast = configFailFast config } - runFormatter evalConfig spec + runFormatter evalConfig filteredSpec let failures :: [Path] @@ -392,8 +397,13 @@ >>> randomize >>> pruneForest where + seed :: Integer seed = (fromJust . configQuickCheckSeed) config + + params :: Params params = Params (configQuickCheckArgs config) (configSmallCheckDepth config) + + randomize :: [Tree c a] -> [Tree c a] randomize | configRandomize config = randomizeForest seed | otherwise = id @@ -415,7 +425,12 @@ toEvalItemForest params = bimapForest id toEvalItem . filterForest itemIsFocused where toEvalItem :: Item () -> EvalItem - toEvalItem (Item requirement loc isParallelizable _isFocused e) = EvalItem requirement loc (fromMaybe False isParallelizable) (e params withUnit) + toEvalItem (Item requirement loc isParallelizable _isFocused e) = EvalItem { + evalItemDescription = requirement + , evalItemLocation = loc + , evalItemConcurrency = if isParallelizable == Just True then Concurrent else Sequential + , evalItemAction = \ progress -> measure $ e params withUnit progress + } withUnit :: ActionWith () -> IO () withUnit action = action () @@ -434,8 +449,8 @@ doNotLeakCommandLineArgumentsToExamples = withArgs [] withHiddenCursor :: Bool -> Handle -> IO a -> IO a -withHiddenCursor useColor h - | useColor = bracket_ (hHideCursor h) (hShowCursor h) +withHiddenCursor reportProgress h + | reportProgress = bracket_ (hHideCursor h) (hShowCursor h) | otherwise = id colorOutputSupported :: ColorMode -> IO Bool -> IO (Bool, Bool) @@ -497,5 +512,8 @@ ref <- newSTRef (mkStdGen $ fromIntegral seed) shuffleForest ref t -countSpecItems :: [Eval.Tree c a] -> Int +countEvalItems :: [Eval.Tree c a] -> Int +countEvalItems = getSum . foldMap (foldMap . const $ Sum 1) + +countSpecItems :: [Tree c a] -> Int countSpecItems = getSum . foldMap (foldMap . const $ Sum 1) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Spec.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Spec.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Spec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Spec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -73,6 +73,10 @@ , Test.Hspec.Core.Tree.location , focusForest + +-- * Re-exports +, HasCallStack +, Expectation ) where import Prelude () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/src/Test/Hspec/Core/Tree.hs new/hspec-core-2.10.9/src/Test/Hspec/Core/Tree.hs --- old/hspec-core-2.10.8/src/Test/Hspec/Core/Tree.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/src/Test/Hspec/Core/Tree.hs 2001-09-09 03:46:40.000000000 +0200 @@ -29,7 +29,6 @@ import Data.CallStack (SrcLoc(..)) import qualified Data.CallStack as CallStack -import Data.Maybe import Test.Hspec.Core.Example @@ -126,8 +125,14 @@ | otherwise = s -- | The @specItem@ function creates a spec item. -specItem :: (HasCallStack, Example a) => String -> a -> SpecTree (Arg a) -specItem s e = Leaf $ Item requirement location Nothing False (safeEvaluateExample e) +specItem :: (HasCallStack, Example e) => String -> e -> SpecTree (Arg e) +specItem s e = Leaf Item { + itemRequirement = requirement + , itemLocation = location + , itemIsParallelizable = Nothing + , itemIsFocused = False + , itemExample = safeEvaluateExample e + } where requirement :: HasCallStack => String requirement diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/test/Helper.hs new/hspec-core-2.10.9/test/Helper.hs --- old/hspec-core-2.10.8/test/Helper.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/test/Helper.hs 2001-09-09 03:46:40.000000000 +0200 @@ -8,6 +8,7 @@ , module Test.Hspec.Core.Compat , module Test.QuickCheck , module System.IO.Silently +, Seconds(..) , sleep , timeout , defaultParams diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/test/Test/Hspec/Core/Formatters/PrettySpec.hs new/hspec-core-2.10.9/test/Test/Hspec/Core/Formatters/PrettySpec.hs --- old/hspec-core-2.10.8/test/Test/Hspec/Core/Formatters/PrettySpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/test/Test/Hspec/Core/Formatters/PrettySpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -19,23 +19,53 @@ it "does not recover unicode" $ do pretty2 False (show "foo\955bar") (show "foo-bar") `shouldBe` ("\"foo\\955bar\"", "\"foo-bar\"") + context "when expected and actual would be equal after pretty-printing" $ do + it "returns the original values unmodified" $ do + pretty2 True (show "foo") (show "foo" <> " ") `shouldBe` (show "foo", show "foo" <> " ") + describe "recoverString" $ do - it "parses back multi-line string literals" $ do - recoverString True (show "foo\nbar\nbaz\n") `shouldBe` Just "foo\nbar\nbaz\n" + it "recovers a string" $ do + recoverString (show "foo") `shouldBe` Just "foo" + + it "recovers the empty string" $ do + recoverString (show "") `shouldBe` Just "" + + it "does not recover a string with leading space" $ do + recoverString (" " <> show "foo") `shouldBe` Nothing + + it "does not recover a string with trailing space" $ do + recoverString (show "foo" <> " ") `shouldBe` Nothing + + it "does not recover an empty list" $ do + recoverString "[]" `shouldBe` Nothing + + describe "recoverMultiLineString" $ do + let + multiLineString :: String + multiLineString = "foo\nbar\nbaz\n" + + it "recovers multi-line string literals" $ do + recoverMultiLineString True (show multiLineString) `shouldBe` Just multiLineString + + it "does not recover string literals that contain control characters" $ do + recoverMultiLineString True (show "foo\n\tbar\nbaz\n") `shouldBe` Nothing + + it "does not recover string literals that span a single line" $ do + recoverMultiLineString True (show "foo\n") `shouldBe` Nothing - it "does not parse back string literals that contain control characters" $ do - recoverString True (show "foo\n\tbar\nbaz\n") `shouldBe` Nothing + it "does not recover a string with trailing space" $ do + recoverMultiLineString True (" " <> show multiLineString) `shouldBe` Nothing - it "does not parse back string literals that span a single line" $ do - recoverString True (show "foo\n") `shouldBe` Nothing + it "does not recover a string with trailing space" $ do + recoverMultiLineString True (show multiLineString <> " ") `shouldBe` Nothing context "when unicode is True" $ do - it "parses back string literals that contain unicode" $ do - recoverString True (show "foo\n\955\nbaz\n") `shouldBe` Just "foo\n\955\nbaz\n" + it "recovers string literals that contain unicode" $ do + recoverMultiLineString True (show "foo\n\955\nbaz\n") `shouldBe` Just "foo\n\955\nbaz\n" context "when unicode is False" $ do - it "does not parse back string literals that contain unicode" $ do - recoverString False (show "foo\n\955\nbaz\n") `shouldBe` Nothing + it "does not recover string literals that contain unicode" $ do + recoverMultiLineString False (show "foo\n\955\nbaz\n") `shouldBe` Nothing describe "pretty" $ do let person = Person "Joe" 23 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/test/Test/Hspec/Core/Formatters/V2Spec.hs new/hspec-core-2.10.9/test/Test/Hspec/Core/Formatters/V2Spec.hs --- old/hspec-core-2.10.8/test/Test/Hspec/Core/Formatters/V2Spec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/test/Test/Hspec/Core/Formatters/V2Spec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -100,7 +100,7 @@ formatter = checks config = H.defaultConfig { H.configFormat = Just $ formatterToFormat formatter } - it "" $ do + it "prints unicode check marks" $ do r <- captureLines . H.hspecWithResult config $ do H.it "foo" True normalizeSummary r `shouldBe` [ @@ -111,7 +111,7 @@ , "1 example, 0 failures" ] - it "" $ do + it "uses ASCII as a fallback" $ do r <- captureLines . H.hspecWithResult config { H.configUnicodeMode = H.UnicodeNever } $ do H.it "foo" True normalizeSummary r `shouldBe` [ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/test/Test/Hspec/Core/Runner/EvalSpec.hs new/hspec-core-2.10.9/test/Test/Hspec/Core/Runner/EvalSpec.hs --- old/hspec-core-2.10.8/test/Test/Hspec/Core/Runner/EvalSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/test/Test/Hspec/Core/Runner/EvalSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -73,13 +73,3 @@ ref <- newIORef [] traverse_ (modifyIORef ref . (:) ) tree reverse <$> readIORef ref `shouldReturn` [1 .. 4] - - describe "runSequentially" $ do - it "runs actions sequentially" $ do - ref <- newIORef [] - (_, actionA) <- runSequentially $ \ _ -> modifyIORef ref (23 :) - (_, actionB) <- runSequentially $ \ _ -> modifyIORef ref (42 :) - (_, ()) <- actionB (\_ -> pass) - readIORef ref `shouldReturn` [42 :: Int] - (_, ()) <- actionA (\_ -> pass) - readIORef ref `shouldReturn` [23, 42] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/test/Test/Hspec/Core/Runner/JobQueueSpec.hs new/hspec-core-2.10.9/test/Test/Hspec/Core/Runner/JobQueueSpec.hs --- old/hspec-core-2.10.8/test/Test/Hspec/Core/Runner/JobQueueSpec.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-core-2.10.9/test/Test/Hspec/Core/Runner/JobQueueSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,44 @@ +module Test.Hspec.Core.Runner.JobQueueSpec (spec) where + +import Prelude () +import Helper + +import Control.Concurrent + +import Test.Hspec.Core.Runner.JobQueue + +spec :: Spec +spec = do + describe "enqueueJob" $ do + let + waitFor job = job (\ _ -> pass) >>= either throwIO return + + context "with Sequential" $ do + it "runs actions sequentially" $ do + withJobQueue 10 $ \ queue -> do + ref <- newIORef [] + jobA <- enqueueJob queue Sequential $ \ _ -> modifyIORef ref (23 :) + jobB <- enqueueJob queue Sequential $ \ _ -> modifyIORef ref (42 :) + waitFor jobB + readIORef ref `shouldReturn` [42 :: Int] + waitFor jobA + readIORef ref `shouldReturn` [23, 42] + + context "with Concurrent" $ do + it "runs actions concurrently" $ do + withJobQueue 10 $ \ queue -> do + barrierA <- newEmptyMVar + barrierB <- newEmptyMVar + + jobA <- enqueueJob queue Concurrent $ \ _ -> do + putMVar barrierB () + takeMVar barrierA + + jobB <- enqueueJob queue Concurrent $ \ _ -> do + putMVar barrierA () + takeMVar barrierB + + timeout (0.1 :: Seconds) $ do + waitFor jobA + waitFor jobB + `shouldReturn` Just () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/test/Test/Hspec/Core/Runner/ResultSpec.hs new/hspec-core-2.10.9/test/Test/Hspec/Core/Runner/ResultSpec.hs --- old/hspec-core-2.10.8/test/Test/Hspec/Core/Runner/ResultSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/test/Test/Hspec/Core/Runner/ResultSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -16,21 +16,12 @@ context "when all spec items passed" $ do it "returns True" $ do - specResultSuccess (toSpecResult False [item Success]) `shouldBe` True + specResultSuccess (toSpecResult [item Success]) `shouldBe` True context "with a failed spec item" $ do it "returns False" $ do - specResultSuccess (toSpecResult False [item Success, item failure]) `shouldBe` False + specResultSuccess (toSpecResult [item Success, item failure]) `shouldBe` False context "with an empty result list" $ do it "returns True" $ do - specResultSuccess (toSpecResult False []) `shouldBe` True - - context "when configFailOnEmpty is True" $ do - context "when all spec items passed" $ do - it "returns True" $ do - specResultSuccess (toSpecResult True [item Success]) `shouldBe` True - - context "with an empty result list" $ do - it "returns False" $ do - specResultSuccess (toSpecResult True []) `shouldBe` False + specResultSuccess (toSpecResult []) `shouldBe` True diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/test/Test/Hspec/Core/RunnerSpec.hs new/hspec-core-2.10.9/test/Test/Hspec/Core/RunnerSpec.hs --- old/hspec-core-2.10.8/test/Test/Hspec/Core/RunnerSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/test/Test/Hspec/Core/RunnerSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -270,15 +270,12 @@ context "with --fail-on=empty" $ do it "fails if no spec items have been run" $ do - (out, r) <- capture . try . withArgs ["--skip=", "--fail-on=empty"] . H.hspec $ do + (out, r) <- hCapture [stdout, stderr] . try . withProgName "spec" . withArgs ["--skip=", "--fail-on=empty"] . H.hspec $ do H.it "foo" True H.it "bar" True H.it "baz" True unlines (normalizeSummary (lines out)) `shouldBe` unlines [ - "" - , "" - , "Finished in 0.0000 seconds" - , "0 examples, 0 failures" + "spec: all spec items have been filtered; failing due to --fail-on=empty" ] r `shouldBe` Left (ExitFailure 1) @@ -699,6 +696,16 @@ H.it "foobar" throwException_ `shouldReturn` H.Summary 1 1 + it "handles unguarded exceptions in runner" $ do + let + throwExceptionThatIsNotGuardedBy_safeTry :: H.Item () -> H.Item () + throwExceptionThatIsNotGuardedBy_safeTry item = item { + H.itemExample = \ _params _hook _progress -> throwIO DivideByZero + } + hspecResult_ $ H.mapSpecItem_ throwExceptionThatIsNotGuardedBy_safeTry $ do + H.it "foo" True + `shouldReturn` H.Summary 1 1 + it "uses the specdoc formatter by default" $ do _:r:_ <- captureLines . H.hspecResult $ do H.describe "Foo.Bar" $ do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/test/Test/Hspec/Core/SpecSpec.hs new/hspec-core-2.10.9/test/Test/Hspec/Core/SpecSpec.hs --- old/hspec-core-2.10.8/test/Test/Hspec/Core/SpecSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/test/Test/Hspec/Core/SpecSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -18,7 +18,12 @@ spec :: Spec spec = do - let runSpecM = fmap snd . H.runSpecM + let + runSpecM :: H.SpecWith a -> IO [H.SpecTree a] + runSpecM = fmap snd . H.runSpecM + + runItem :: Item () -> IO Result + runItem item = itemExample item defaultParams ($ ()) noOpProgressCallback describe "getSpecDescriptionPath" $ do it "returns the spec path" $ do @@ -51,8 +56,7 @@ describe "xdescribe" $ do it "creates a tree of pending spec items" $ do [Node _ [Leaf item]] <- runSpecM (H.xdescribe "" $ H.it "whatever" True) - r <- itemExample item defaultParams ($ ()) noOpProgressCallback - r `shouldBe` Result "" (Pending Nothing Nothing) + runItem item `shouldReturn` Result "" (Pending Nothing Nothing) describe "it" $ do it "takes a description of a desired behavior" $ do @@ -61,8 +65,7 @@ it "takes an example of that behavior" $ do [Leaf item] <- runSpecM (H.it "whatever" True) - r <- itemExample item defaultParams ($ ()) noOpProgressCallback - r `shouldBe` Result "" Success + runItem item `shouldReturn` Result "" Success it "adds source locations" $ do [Leaf item] <- runSpecM (H.it "foo" True) @@ -81,8 +84,7 @@ describe "xit" $ do it "creates a pending spec item" $ do [Leaf item] <- runSpecM (H.xit "whatever" True) - r <- itemExample item defaultParams ($ ()) noOpProgressCallback - r `shouldBe` Result "" (Pending Nothing Nothing) + runItem item `shouldReturn` Result "" (Pending Nothing Nothing) describe "pending" $ do it "specifies a pending example" $ do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.10.8/version.yaml new/hspec-core-2.10.9/version.yaml --- old/hspec-core-2.10.8/version.yaml 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.10.9/version.yaml 2001-09-09 03:46:40.000000000 +0200 @@ -1 +1 @@ -&version 2.10.8 +&version 2.10.9
