diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2011-2018 Simon Hengel +Copyright (c) 2011-2019 Simon Hengel Copyright (c) 2011-2012 Trystan Spangler Copyright (c) 2011-2011 Greg Weber diff --git a/hspec-core.cabal b/hspec-core.cabal --- a/hspec-core.cabal +++ b/hspec-core.cabal @@ -4,13 +4,13 @@ -- -- see: https://github.com/sol/hpack -- --- hash: fef917dc0cb43c6da4719fb2d080d28e01d8bc888b679a3fa1c61559f02d9848 +-- hash: 7cca186c021b61bad5f4aa3748a723fbe2ec81a918644d575eaa8d7fbba6f3a0 name: hspec-core -version: 2.6.0 +version: 2.6.1 license: MIT license-file: LICENSE -copyright: (c) 2011-2018 Simon Hengel, +copyright: (c) 2011-2019 Simon Hengel, (c) 2011-2012 Trystan Spangler, (c) 2011 Greg Weber maintainer: Simon Hengel diff --git a/src/Test/Hspec/Core/Config.hs b/src/Test/Hspec/Core/Config.hs --- a/src/Test/Hspec/Core/Config.hs +++ b/src/Test/Hspec/Core/Config.hs @@ -3,9 +3,12 @@ Config (..) , ColorMode(..) , defaultConfig -, getConfig +, readConfig , configAddFilter , configQuickCheckArgs + +, readFailureReportOnRerun +, applyFailureReport #ifdef TEST , readConfigFiles #endif @@ -21,6 +24,7 @@ import System.Exit import System.FilePath import System.Directory +import System.Environment (getProgName) import qualified Test.QuickCheck as QC import Test.Hspec.Core.Util @@ -36,8 +40,8 @@ configFilterPredicate = Just p1 `filterOr` configFilterPredicate c } -mkConfig :: Maybe FailureReport -> Config -> Config -mkConfig mFailureReport opts = opts { +applyFailureReport :: Maybe FailureReport -> Config -> Config +applyFailureReport mFailureReport opts = opts { configFilterPredicate = matchFilter `filterOr` rerunFilter , configQuickCheckSeed = mSeed , configQuickCheckMaxSuccess = mMaxSuccess @@ -79,8 +83,31 @@ setSeed :: Integer -> QC.Args -> QC.Args setSeed n args = args {QC.replay = Just (mkGen (fromIntegral n), 0)} -getConfig :: Config -> String -> [String] -> IO (Maybe FailureReport, Config) -getConfig opts_ prog args = do +-- | +-- `readConfig` parses config options from several sources and constructs a +-- `Config` value. It takes options from: +-- +-- 1. @~/.hspec@ (a config file in the user's home directory) +-- 1. @.hspec@ (a config file in the current working directory) +-- 1. the environment variable @HSPEC_OPTIONS@ +-- 1. the provided list of command-line options (the second argument to @readConfig@) +-- +-- (precedence from low to high) +-- +-- When parsing fails then @readConfig@ writes an error message to `stderr` and +-- exits with `exitFailure`. +-- +-- When @--help@ is provided as a command-line option then @readConfig@ writes +-- a help message to `stdout` and exits with `exitSuccess`. +-- +-- A common way to use @readConfig@ is: +-- +-- @ +-- `System.Environment.getArgs` >>= readConfig `defaultConfig` +-- @ +readConfig :: Config -> [String] -> IO Config +readConfig opts_ args = do + prog <- getProgName configFiles <- do ignore <- ignoreConfigFile opts_ args case ignore of @@ -89,9 +116,12 @@ envVar <- fmap words <$> lookupEnv envVarName case parseOptions opts_ prog configFiles envVar args of Left (err, msg) -> exitWithMessage err msg - Right opts -> do - r <- if configRerun opts then readFailureReport opts else return Nothing - return (r, mkConfig r opts) + Right opts -> return opts + +readFailureReportOnRerun :: Config -> IO (Maybe FailureReport) +readFailureReportOnRerun config + | configRerun config = readFailureReport config + | otherwise = return Nothing readConfigFiles :: IO [ConfigFile] readConfigFiles = do diff --git a/src/Test/Hspec/Core/Runner.hs b/src/Test/Hspec/Core/Runner.hs --- a/src/Test/Hspec/Core/Runner.hs +++ b/src/Test/Hspec/Core/Runner.hs @@ -5,18 +5,27 @@ module Test.Hspec.Core.Runner ( -- * Running a spec hspec -, hspecWith -, hspecResult -, hspecWithResult +, runSpec --- * Types -, Summary (..) +-- * Config , Config (..) , ColorMode (..) , Path , defaultConfig , configAddFilter +, readConfig +-- * Summary +, Summary (..) +, isSuccess +, evaluateSummary + +-- * Legacy +-- | The following primitives are deprecated. Use `runSpec` instead. +, hspecWith +, hspecResult +, hspecWithResult + #ifdef TEST , rerunAll #endif @@ -27,7 +36,7 @@ import Data.Maybe import System.IO -import System.Environment (getProgName, getArgs, withArgs) +import System.Environment (getArgs, withArgs) import System.Exit import qualified Control.Exception as E @@ -82,10 +91,18 @@ NodeWithCleanup _ xs -> NodeWithCleanup (\() -> return ()) (map removeCleanup xs) leaf@(Leaf _) -> leaf --- | Run given spec and write a report to `stdout`. +-- | Run a given spec and write a report to `stdout`. -- Exit with `exitFailure` if at least one spec item fails. +-- +-- /Note/: `hspec` handles command-line options and reads config files. This +-- is not always desired. Use `runSpec` if you need more control over these +-- aspects. hspec :: Spec -> IO () -hspec = hspecWith defaultConfig +hspec spec = + getArgs + >>= readConfig defaultConfig + >>= doNotLeakCommandLineArgumentsToExamples . runSpec spec + >>= evaluateSummary -- Add a seed to given config if there is none. That way the same seed is used -- for all properties. This helps with --seed and --rerun. @@ -99,20 +116,25 @@ -- | Run given spec with custom options. -- This is similar to `hspec`, but more flexible. hspecWith :: Config -> Spec -> IO () -hspecWith conf spec = do - r <- hspecWithResult conf spec - unless (isSuccess r) exitFailure +hspecWith config spec = getArgs >>= readConfig config >>= doNotLeakCommandLineArgumentsToExamples . runSpec spec >>= evaluateSummary +-- | `True` if the given `Summary` indicates that there were no +-- failures, `False` otherwise. isSuccess :: Summary -> Bool isSuccess summary = summaryFailures summary == 0 +-- | Exit with `exitFailure` if the given `Summary` indicates that there was at +-- least one failure. +evaluateSummary :: Summary -> IO () +evaluateSummary summary = unless (isSuccess summary) exitFailure + -- | Run given spec and returns a summary of the test run. -- -- /Note/: `hspecResult` does not exit with `exitFailure` on failing spec -- items. If you need this, you have to check the `Summary` yourself and act -- accordingly. hspecResult :: Spec -> IO Summary -hspecResult = hspecWithResult defaultConfig +hspecResult spec = getArgs >>= readConfig defaultConfig >>= doNotLeakCommandLineArgumentsToExamples . runSpec spec -- | Run given spec with custom options and returns a summary of the test run. -- @@ -120,11 +142,25 @@ -- items. If you need this, you have to check the `Summary` yourself and act -- accordingly. hspecWithResult :: Config -> Spec -> IO Summary -hspecWithResult config spec = do - prog <- getProgName - args <- getArgs - (oldFailureReport, c_) <- getConfig config prog args - c <- ensureSeed c_ +hspecWithResult config spec = getArgs >>= readConfig config >>= doNotLeakCommandLineArgumentsToExamples . runSpec spec + +-- | +-- `runSpec` is the most basic primitive to run a spec. `hspec` is defined in +-- terms of @runSpec@: +-- +-- @ +-- hspec spec = +-- `getArgs` +-- >>= `readConfig` `defaultConfig` +-- >>= `withArgs` [] . runSpec spec +-- >>= `evaluateSummary` +-- @ +runSpec :: Spec -> Config -> IO Summary +runSpec spec c_ = do + oldFailureReport <- readFailureReportOnRerun c_ + + c <- ensureSeed (applyFailureReport oldFailureReport c_) + if configRerunAllOnSuccess c -- With --rerun-all we may run the spec twice. For that reason GHC can not -- optimize away the spec tree. That means that the whole spec tree has to @@ -137,16 +173,16 @@ then rerunAllMode c oldFailureReport else normalMode c where - normalMode c = runSpec c spec + normalMode c = runSpec_ c spec rerunAllMode c oldFailureReport = do - summary <- runSpec c spec + summary <- runSpec_ c spec if rerunAll c oldFailureReport summary - then hspecWithResult config spec + then runSpec spec c_ else return summary -runSpec :: Config -> Spec -> IO Summary -runSpec config spec = do - doNotLeakCommandLineArgumentsToExamples $ withHandle config $ \h -> do +runSpec_ :: Config -> Spec -> IO Summary +runSpec_ config spec = do + withHandle config $ \h -> do let formatter = fromMaybe specdoc (configFormatter config) seed = (fromJust . configQuickCheckSeed) config qcArgs = configQuickCheckArgs config diff --git a/src/Test/Hspec/Core/Util.hs b/src/Test/Hspec/Core/Util.hs --- a/src/Test/Hspec/Core/Util.hs +++ b/src/Test/Hspec/Core/Util.hs @@ -63,7 +63,7 @@ else s : go (y, ys) -- | --- A `Path` represents the location of an example within the spec tree. +-- A `Path` describes the location of a spec item within a spec tree. -- -- It consists of a list of group descriptions and a requirement description. type Path = ([String], String) diff --git a/test/Helper.hs b/test/Helper.hs --- a/test/Helper.hs +++ b/test/Helper.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ConstraintKinds #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Helper ( module Test.Hspec.Meta @@ -96,7 +98,7 @@ timeout :: Seconds -> IO a -> IO (Maybe a) timeout = System.timeout . toMicroseconds -shouldUseArgs :: [String] -> (Args -> Bool) -> Expectation +shouldUseArgs :: HasCallStack => [String] -> (Args -> Bool) -> Expectation shouldUseArgs args p = do spy <- newIORef (H.paramsQuickCheckArgs defaultParams) let interceptArgs item = item {H.itemExample = \params action progressCallback -> writeIORef spy (H.paramsQuickCheckArgs params) >> H.itemExample item params action progressCallback}