hspec 1.4.5 → 1.5.0
raw patch · 21 files changed
+385/−152 lines, 21 filesdep ~QuickCheckdep ~silently
Dependency ranges changed: QuickCheck, silently
Files
- hspec.cabal +6/−6
- src/Test/Hspec.hs +17/−2
- src/Test/Hspec/Compat.hs +58/−1
- src/Test/Hspec/Config.hs +9/−10
- src/Test/Hspec/Core.hs +1/−10
- src/Test/Hspec/Core/Type.hs +91/−16
- src/Test/Hspec/Formatters.hs +5/−0
- src/Test/Hspec/Formatters/Internal.hs +8/−2
- src/Test/Hspec/Monadic.hs +0/−1
- src/Test/Hspec/Pending.hs +0/−34
- src/Test/Hspec/Runner.hs +18/−10
- src/Test/Hspec/Timer.hs +14/−0
- src/Test/Hspec/Util.hs +4/−0
- test/SpecHelper.hs +37/−0
- test/Test/Hspec/Core/TypeSpec.hs +55/−10
- test/Test/Hspec/FormattersSpec.hs +2/−2
- test/Test/Hspec/HUnitSpec.hs +1/−1
- test/Test/Hspec/RunnerSpec.hs +6/−13
- test/Test/Hspec/TimerSpec.hs +30/−0
- test/Test/HspecSpec.hs +23/−7
- test/Util.hs +0/−27
hspec.cabal view
@@ -1,8 +1,8 @@ name: hspec-version: 1.4.5+version: 1.5.0 license: BSD3 license-file: LICENSE-copyright: (c) 2011-2012 Trystan Spangler, (c) 2011-2012 Simon Hengel, (c) 2011 Greg Weber+copyright: (c) 2011-2013 Simon Hengel, (c) 2011-2012 Trystan Spangler, (c) 2011 Greg Weber maintainer: Simon Hengel <sol@typeful.net> build-type: Simple cabal-version: >= 1.8@@ -52,12 +52,11 @@ build-depends: base == 4.* , setenv- , silently >= 1.1.1 , ansi-terminal >= 0.5 , time , transformers >= 0.2.2.0 && < 0.4.0 , HUnit >= 1.2.5- , QuickCheck >= 2.4.0.1+ , QuickCheck >= 2.5.1 , hspec-expectations == 0.3.0.* exposed-modules: Test.Hspec@@ -70,11 +69,11 @@ other-modules: Test.Hspec.Util Test.Hspec.Compat- Test.Hspec.Pending Test.Hspec.Core.Type Test.Hspec.Config Test.Hspec.FailureReport Test.Hspec.Formatters.Internal+ Test.Hspec.Timer test-suite spec type:@@ -85,7 +84,7 @@ Spec.hs other-modules: Mock- Util+ SpecHelper Test.HspecSpec Test.Hspec.CompatSpec Test.Hspec.Core.TypeSpec@@ -94,6 +93,7 @@ Test.Hspec.HUnitSpec Test.Hspec.QuickCheckSpec Test.Hspec.RunnerSpec+ Test.Hspec.TimerSpec Test.Hspec.UtilSpec ghc-options: -Wall -Werror
src/Test/Hspec.hs view
@@ -21,7 +21,6 @@ -- * Types Spec , Example-, Pending -- * Setting expectations , module Test.Hspec.Expectations@@ -30,7 +29,9 @@ , describe , context , it+, example , pending+, pendingWith -- * Running a spec , hspec@@ -40,7 +41,6 @@ import Test.Hspec.Runner import Test.Hspec.HUnit () import Test.Hspec.Expectations-import Test.Hspec.Pending import qualified Test.Hspec.Core as Core -- $intro@@ -126,3 +126,18 @@ -- > absolute (-1) == 1 it :: Example v => String -> v -> Spec it label action = fromSpecList [Core.it label action]++-- | This is a type restricted version of `id`. It can be used to get better+-- error messages on type mismatches.+--+-- Compare e.g.+--+-- > it "exposes some behavior" $ example $ do+-- > putStrLn+--+-- with+--+-- > it "exposes some behavior" $ do+-- > putStrLn+example :: Expectation -> Expectation+example = id
src/Test/Hspec/Compat.hs view
@@ -1,12 +1,60 @@ {-# LANGUAGE CPP #-}-module Test.Hspec.Compat where+module Test.Hspec.Compat (+ showType+, showFullType+, isUserInterrupt+, readMaybe+, module Data.IORef+#if !MIN_VERSION_base(4,6,0)+, modifyIORef'+#endif+) where import Data.Typeable (Typeable, typeOf, typeRepTyCon)+import qualified Test.QuickCheck as QC+import Text.Read+import Data.IORef #if MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (tyConModule, tyConName) #endif +#if !MIN_VERSION_base(4,6,0)+import qualified Text.ParserCombinators.ReadP as P+import Prelude+#endif++#if !MIN_VERSION_base(4,6,0)+-- |Strict version of 'modifyIORef'+modifyIORef' :: IORef a -> (a -> a) -> IO ()+modifyIORef' ref f = do+ x <- readIORef ref+ let x' = f x+ x' `seq` writeIORef ref x'++-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+-- A 'Left' value indicates a parse error.+readEither :: Read a => String -> Either String a+readEither s =+ case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of+ [x] -> Right x+ [] -> Left "Prelude.read: no parse"+ _ -> Left "Prelude.read: ambiguous parse"+ where+ read' =+ do x <- readPrec+ lift P.skipSpaces+ return x++-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+readMaybe :: Read a => String -> Maybe a+readMaybe s = case readEither s of+ Left _ -> Nothing+ Right a -> Just a+#endif+ showType :: Typeable a => a -> String showType a = let t = typeRepTyCon (typeOf a) in #if MIN_VERSION_base(4,4,0)@@ -23,3 +71,12 @@ #else show t #endif++isUserInterrupt :: QC.Result -> Bool+isUserInterrupt r = case r of+#if MIN_VERSION_QuickCheck(2,6,0)+ QC.Failure {QC.interrupted = x} -> x+#else+ QC.Failure {QC.reason = "Exception: 'user interrupt'"} -> True+#endif+ _ -> False
src/Test/Hspec/Config.hs view
@@ -16,7 +16,6 @@ import Test.Hspec.Formatters import Test.Hspec.Util-import Test.Hspec.Core.Type (Params (..), defaultParams) -- for Monad (Either e) when base < 4.3 import Control.Monad.Trans.Error ()@@ -32,17 +31,19 @@ -- A predicate that is used to filter the spec before it is run. Only examples -- that satisfy the predicate are run. , configFilterPredicate :: Maybe (Path -> Bool)-, configParams :: Params+, configQuickCheckArgs :: QC.Args , configColorMode :: ColorMode , configFormatter :: Formatter , configHtmlOutput :: Bool , configHandle :: Handle } +{-# DEPRECATED configVerbose "this has no effect anymore and will be removed with a future release" #-} -- deprecated since 1.5.0+ data ColorMode = ColorAuto | ColorNever | ColorAlway defaultConfig :: Config-defaultConfig = Config False False False False False Nothing defaultParams ColorAuto specdoc False stdout+defaultConfig = Config False False False False False Nothing QC.stdArgs {QC.chatty = False} ColorAuto specdoc False stdout formatters :: [(String, Formatter)] formatters = [@@ -69,10 +70,7 @@ mp = configFilterPredicate c setQC_MaxSuccess :: String -> Result -> Result-setQC_MaxSuccess n x = (mapParams $ \p -> p {paramsQuickCheckArgs = (paramsQuickCheckArgs p) {QC.maxSuccess = read n}}) <$> x- where- mapParams :: (Params -> Params) -> Config -> Config- mapParams f c = c {configParams = f (configParams c)}+setQC_MaxSuccess n x = (\c -> c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.maxSuccess = read n}}) <$> x addLineBreaks :: String -> [String] addLineBreaks = lineBreaksAt 44@@ -80,14 +78,13 @@ options :: [OptDescr (Result -> Result)] options = [ Option [] ["help"] (NoArg (const $ Left Help)) (h "display this help and exit")- , Option "v" ["verbose"] (NoArg setVerbose) (h "do not suppress output to stdout when evaluating examples") , Option "m" ["match"] (ReqArg setFilter "PATTERN") (h "only run examples that match given PATTERN") , Option [] ["color"] (OptArg setColor "WHEN") (h "colorize the output; WHEN defaults to `always' or can be `never' or `auto'") , Option "f" ["format"] (ReqArg setFormatter "FORMATTER") formatHelp , Option "a" ["qc-max-success"] (ReqArg setQC_MaxSuccess "N") (h "maximum number of successful tests before a QuickCheck property succeeds") , Option [] ["print-cpu-time"] (NoArg setPrintCpuTime) (h "include used CPU time in summary") , Option [] ["dry-run"] (NoArg setDryRun) (h "pretend that everything passed; don't verify anything")- , Option [] ["fast-fail"] (NoArg setFastFail) (h "stop after first failure")+ , Option [] ["fail-fast"] (NoArg setFastFail) (h "abort on first failure") ] where h = unlines . addLineBreaks@@ -95,7 +92,6 @@ setFilter :: String -> Result -> Result setFilter pattern x = configAddFilter (filterPredicate pattern) <$> x - setVerbose x = x >>= \c -> return c {configVerbose = True} setPrintCpuTime x = x >>= \c -> return c {configPrintCpuTime = True} setDryRun x = x >>= \c -> return c {configDryRun = True} setFastFail x = x >>= \c -> return c {configFastFail = True}@@ -123,6 +119,9 @@ -- undocumented for now, as we probably want to change this to produce a -- standalone HTML report in the future , Option [] ["html"] (NoArg setHtml) "produce HTML output"++ -- now a noop+ , Option "v" ["verbose"] (NoArg id) "do not suppress output to stdout when evaluating examples" ] where setReRun :: Result -> Result
src/Test/Hspec/Core.hs view
@@ -8,6 +8,7 @@ -- * A type class for examples Example (..) , Params (..)+, Progress , Result (..) -- * A writer monad for constructing specs@@ -27,15 +28,12 @@ , hspecX , hHspec , hspec-, Pending-, pending ) where import Control.Applicative import System.IO (Handle) import Test.Hspec.Core.Type hiding (Spec)-import qualified Test.Hspec.Pending as Pending import qualified Test.Hspec.Runner as Runner import Test.Hspec.Runner (Summary(..), Config(..), defaultConfig) @@ -63,10 +61,3 @@ {-# DEPRECATED Specs "use `[SpecTree]` instead" #-} -- since 1.4.0 type Specs = [SpecTree]--{-# DEPRECATED pending "use `Test.Hspec.pending` instead" #-} -- since 1.4.0-pending :: String -> Pending-pending = Pending.pending--{-# DEPRECATED Pending "use `Test.Hspec.Pending` instead" #-} -- since 1.4.0-type Pending = Pending.Pending
src/Test/Hspec/Core/Type.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.Core.Type ( Spec , SpecM (..)@@ -7,24 +8,33 @@ , SpecTree (..) , Example (..) , Result (..)- , Params (..)-, defaultParams+, Progress , describe , it++, pending+, pendingWith ) where import qualified Control.Exception as E import Control.Applicative import Control.Monad (when) import Control.Monad.Trans.Writer (Writer, execWriter, tell)+import Data.Typeable (Typeable)+import Data.List (isPrefixOf)+import Data.Maybe (fromMaybe) import Test.Hspec.Util import Test.Hspec.Expectations import Test.HUnit.Lang (HUnitFailure(..)) import qualified Test.QuickCheck as QC+import qualified Test.QuickCheck.State as QC+import qualified Test.QuickCheck.Property as QCP +import Test.Hspec.Compat (isUserInterrupt)+ type Spec = SpecM () -- | A writer monad for `SpecTree` forests.@@ -41,15 +51,17 @@ -- | The result of running an example. data Result = Success | Pending (Maybe String) | Fail String- deriving (Eq, Show)+ deriving (Eq, Show, Read, Typeable) +instance E.Exception Result++type Progress = (Int, Int)+ data Params = Params { paramsQuickCheckArgs :: QC.Args+, paramsReportProgress :: Progress -> IO () } -defaultParams :: Params-defaultParams = Params QC.stdArgs- -- | Internal representation of a spec. data SpecTree = SpecGroup String [SpecTree]@@ -57,11 +69,19 @@ -- | The @describe@ function combines a list of specs into a larger spec. describe :: String -> [SpecTree] -> SpecTree-describe = SpecGroup+describe s = SpecGroup msg+ where+ msg+ | null s = "(no description given)"+ | otherwise = s -- | Create a spec item. it :: Example a => String -> a -> SpecTree-it s e = SpecItem s (`evaluateExample` e)+it s e = SpecItem msg (`evaluateExample` e)+ where+ msg+ | null s = "(unspecified behavior)"+ | otherwise = s -- | A type class for examples. class Example a where@@ -71,25 +91,80 @@ evaluateExample _ b = if b then return Success else return (Fail "") instance Example Expectation where- evaluateExample _ action = (action >> return Success) `E.catch` \(HUnitFailure err) -> return (Fail err)+ evaluateExample _ action = (action >> return Success) `E.catches` [+ E.Handler (\(HUnitFailure err) -> (return . Fail) err)+ , E.Handler (return :: Result -> IO Result)+ ] instance Example Result where evaluateExample _ r = return r instance Example QC.Property where evaluateExample c p = do- r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) p+ r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) (QCP.callback progressCallback p) when (isUserInterrupt r) $ do E.throwIO E.UserInterrupt return $ case r of QC.Success {} -> Success- f@(QC.Failure {}) -> Fail (QC.output f)+ QC.Failure {QC.output = m} -> fromMaybe (Fail $ sanitizeFailureMessage m) (parsePending m) QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ quantify n "test" ) QC.NoExpectedFailure {} -> Fail ("No expected failure") where- isUserInterrupt :: QC.Result -> Bool- isUserInterrupt r = case r of- QC.Failure {QC.reason = "Exception: 'user interrupt'"} -> True- _ -> False+ progressCallback = QCP.PostTest QCP.NotCounterexample $+ \st _ -> paramsReportProgress c (QC.numSuccessTests st, QC.maxSuccessTests st)++ sanitizeFailureMessage :: String -> String+ sanitizeFailureMessage = strip . addFalsifiable . stripFailed++ addFalsifiable :: String -> String+ addFalsifiable m+ | "(after " `isPrefixOf` m = "Falsifiable " ++ m+ | otherwise = m++ stripFailed :: String -> String+ stripFailed m+ | prefix `isPrefixOf` m = drop n m+ | otherwise = m+ where+ prefix = "*** Failed! "+ n = length prefix++ parsePending :: String -> Maybe Result+ parsePending m+ | prefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m+ | otherwise = Nothing+ where+ n = length prefix+ prefix = "*** Failed! Exception: '"++instance QC.Testable Expectation where+ property = propertyIO+ exhaustive _ = True++propertyIO :: Expectation -> QC.Property+propertyIO action = QCP.morallyDubiousIOProperty $ do+ (action >> return succeeded) `E.catch` \(HUnitFailure err) -> return (failed err)+ where+ succeeded = QC.property QCP.succeeded+ failed err = QC.property QCP.failed {QCP.reason = err}++-- | Specifies a pending example.+--+-- If you want to textually specify a behavior but do not have an example yet,+-- use this:+--+-- > describe "fancyFormatter" $ do+-- > it "can format text in a way that everyone likes" $+-- > pending+pending :: Expectation+pending = E.throwIO (Pending Nothing)++-- | Specifies a pending example with a reason for why it's pending.+--+-- > describe "fancyFormatter" $ do+-- > it "can format text in a way that everyone likes" $+-- > pendingWith "waiting for clarification from the designers"+pendingWith :: String -> Expectation+pendingWith = E.throwIO . Pending . Just
src/Test/Hspec/Formatters.hs view
@@ -54,6 +54,7 @@ import Control.Monad (unless, forM_) import Control.Applicative import qualified Control.Exception as E+import System.IO (hPutStr) -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make -- sure, that we only use the public API to implement formatters.@@ -90,6 +91,7 @@ headerFormatter = return () , exampleGroupStarted = \_ _ _ -> return () , exampleGroupDone = return ()+, exampleProgress = \_ _ _ -> return () , exampleSucceeded = \_ -> return () , exampleFailed = \_ _ -> return () , examplePending = \_ _ -> return ()@@ -114,6 +116,9 @@ , exampleGroupDone = do newParagraph++, exampleProgress = \h _ (current, total) -> do+ hPutStr h $ "(" ++ show current ++ "/" ++ show total ++ ")\r" , exampleSucceeded = \(nesting, requirement) -> withSuccessColor $ do writeLine $ indentationFor nesting ++ "- " ++ requirement
src/Test/Hspec/Formatters/Internal.hs view
@@ -43,10 +43,11 @@ import Control.Monad.Trans.State hiding (gets, modify) import qualified Control.Monad.IO.Class as IOClass import qualified System.CPUTime as CPUTime-import Data.IORef import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) import Test.Hspec.Util (Path)+import Test.Hspec.Compat+import Test.Hspec.Core.Type (Progress) -- | A lifted version of `Control.Monad.Trans.State.gets` gets :: (FormatterState -> a) -> FormatM a@@ -56,7 +57,7 @@ -- | A lifted version of `Control.Monad.Trans.State.modify` modify :: (FormatterState -> FormatterState) -> FormatM () modify f = FormatM $ do- get >>= IOClass.liftIO . (`modifyIORef` f)+ get >>= IOClass.liftIO . (`modifyIORef'` f) -- | A lifted version of `IOClass.liftIO` --@@ -146,6 +147,11 @@ , exampleGroupStarted :: Int -> [String] -> String -> FormatM () , exampleGroupDone :: FormatM ()++-- | used to notify the progress of the currently evaluated example+--+-- NOTE: This is only called when interactive/color mode.+, exampleProgress :: Handle -> Path -> Progress -> IO () -- | evaluated after each successful example , exampleSucceeded :: Path -> FormatM ()
src/Test/Hspec/Monadic.hs view
@@ -3,7 +3,6 @@ -- * Types Spec , Example-, Pending -- * Defining a spec , describe
− src/Test/Hspec/Pending.hs
@@ -1,34 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-module Test.Hspec.Pending where--import qualified Test.Hspec.Core.Type as Core-import Test.Hspec.Core.Type (Example(..))---- NOTE: This is defined in a separate packages, because it clashes with--- Result.Pending.---- | A pending example.-newtype Pending = Pending (Maybe String)--instance Example Pending where- evaluateExample c (Pending reason) = evaluateExample c (Core.Pending reason)--instance Example (String -> Pending) where- evaluateExample c _ = evaluateExample c (Pending Nothing)---- | A pending example.------ If you want to textually specify a behavior but do not have an example yet,--- use this:------ > describe "fancyFormatter" $ do--- > it "can format text in a way that everyone likes" $--- > pending------ You can give an optional reason for why it's pending:------ > describe "fancyFormatter" $ do--- > it "can format text in a way that everyone likes" $--- > pending "waiting for clarification from the designers"-pending :: String -> Pending-pending = Pending . Just
src/Test/Hspec/Runner.hs view
@@ -21,7 +21,6 @@ import System.IO import System.Environment import System.Exit-import System.IO.Silently (silence) import Test.Hspec.Util (Path, safeEvaluate) import Test.Hspec.Core.Type@@ -29,6 +28,8 @@ import Test.Hspec.Formatters import Test.Hspec.Formatters.Internal import Test.Hspec.FailureReport+import System.Console.ANSI (hHideCursor, hShowCursor)+import Test.Hspec.Timer -- | Filter specs by given predicate. --@@ -47,8 +48,8 @@ xs -> Just (SpecGroup group xs) -- | Evaluate all examples of a given spec and produce a report.-runFormatter :: Config -> Formatter -> [SpecTree] -> FormatM ()-runFormatter c formatter specs = headerFormatter formatter >> zip [0..] specs `each` go []+runFormatter :: Bool -> Config -> Formatter -> [SpecTree] -> FormatM ()+runFormatter useColor c formatter specs = headerFormatter formatter >> zip [0..] specs `each` go [] where -- like forM_, but respects --fast-fail each :: [a] -> (a -> FormatM ()) -> FormatM ()@@ -59,13 +60,9 @@ unless (configFastFail c && fails /= 0) $ do xs `each` f - silence_- | configVerbose c = id- | otherwise = silence- eval | configDryRun c = \_ -> return (Right Success)- | otherwise = liftIO . safeEvaluate . silence_+ | otherwise = liftIO . safeEvaluate go :: [String] -> (Int, SpecTree) -> FormatM () go rGroups (n, SpecGroup group xs) = do@@ -73,7 +70,8 @@ zip [0..] xs `each` go (group : rGroups) exampleGroupDone formatter go rGroups (_, SpecItem requirement example) = do- result <- eval (example $ configParams c)+ progressHandler <- mkProgressHandler+ result <- eval (example $ Params (configQuickCheckArgs c) progressHandler) case result of Right Success -> do increaseSuccessCount@@ -92,6 +90,14 @@ addFailMessage path err exampleFailed formatter path err + mkProgressHandler+ | useColor = do+ timer <- liftIO $ newTimer 0.05+ return $ \p -> do+ f <- timer+ when f $ do+ exampleProgress formatter (configHandle c) path p+ | otherwise = return . const $ return () -- | Run given spec and write a report to `stdout`. -- Exit with `exitFailure` if at least one spec item fails.@@ -123,9 +129,11 @@ h = configHandle c useColor <- doesUseColor h c+ when useColor (hHideCursor h) runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) h $ do- runFormatter c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_`+ runFormatter useColor c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_` do failedFormatter formatter+ liftIO $ when useColor (hShowCursor h) footerFormatter formatter
+ src/Test/Hspec/Timer.hs view
@@ -0,0 +1,14 @@+module Test.Hspec.Timer where++import Data.IORef+import Data.Time.Clock.POSIX++newTimer :: POSIXTime -> IO (IO Bool)+newTimer delay = do+ ref <- getPOSIXTime >>= newIORef+ return $ do+ t0 <- readIORef ref+ t1 <- getPOSIXTime+ if delay < t1 - t0+ then writeIORef ref t1 >> return True+ else return False
src/Test/Hspec/Util.hs view
@@ -7,6 +7,7 @@ , formatRequirement , readMaybe , getEnv+, strip ) where import Data.List@@ -94,3 +95,6 @@ if length r <= n then go (r, ys) else s : go (y, ys)++strip :: String -> String+strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse
+ test/SpecHelper.hs view
@@ -0,0 +1,37 @@+module SpecHelper where++import qualified Test.Hspec.Core as H+import qualified Test.Hspec.Runner as H+import Data.List+import Data.Char+import Test.Hspec.Meta+import System.IO.Silently+import Data.Time.Clock.POSIX+import Control.Concurrent++captureLines :: IO a -> IO [String]+captureLines = fmap lines . capture_++shouldContain :: (Eq a, Show a) => [a] -> [a] -> Expectation+x `shouldContain` y = x `shouldSatisfy` isInfixOf y++shouldStartWith :: (Eq a, Show a) => [a] -> [a] -> Expectation+x `shouldStartWith` y = x `shouldSatisfy` isPrefixOf y++shouldEndWith :: (Eq a, Show a) => [a] -> [a] -> Expectation+x `shouldEndWith` y = x `shouldSatisfy` isSuffixOf y++-- replace times in summary with zeroes+normalizeSummary :: [String] -> [String]+normalizeSummary xs = map f xs+ where+ f x | "Finished in " `isPrefixOf` x = map g x+ | otherwise = x+ g x | isNumber x = '0'+ | otherwise = x++defaultParams :: H.Params+defaultParams = H.Params (H.configQuickCheckArgs H.defaultConfig) (const $ return ())++sleep :: POSIXTime -> IO ()+sleep t = threadDelay (floor $ t * 1000000)
test/Test/Hspec/Core/TypeSpec.hs view
@@ -1,18 +1,22 @@ module Test.Hspec.Core.TypeSpec (main, spec) where import Test.Hspec.Meta+import SpecHelper import Test.QuickCheck+import Mock+import Data.List import Test.QuickCheck.Property (morallyDubiousIOProperty) import Control.Exception (AsyncException(..), throwIO)-import qualified Test.Hspec.Core.Type as H-import qualified Test.Hspec.Pending as H (pending)+import qualified Test.Hspec.Core.Type as H hiding (describe, it)+import qualified Test.Hspec as H+import qualified Test.Hspec.Runner as H main :: IO () main = hspec spec evaluateExample :: H.Example e => e -> IO H.Result-evaluateExample = H.evaluateExample H.defaultParams+evaluateExample = H.evaluateExample (defaultParams {H.paramsQuickCheckArgs = (H.paramsQuickCheckArgs defaultParams) {replay = Just (read "", 0)}}) spec :: Spec spec = do@@ -37,6 +41,14 @@ it "propagates exceptions" $ do evaluateExample (error "foobar" :: Expectation) `shouldThrow` errorCall "foobar" + context "when used with `pending`" $ do+ it "returns Pending" $ do+ evaluateExample (H.pending) `shouldReturn` H.Pending Nothing++ context "when used with `pendingWith`" $ do+ it "includes the optional reason" $ do+ evaluateExample (H.pendingWith "foo") `shouldReturn` H.Pending (Just "foo")+ context "for Property" $ do it "returns Success if property holds" $ do evaluateExample (property $ \n -> n == (n :: Int)) `shouldReturn` H.Success@@ -46,9 +58,24 @@ return () it "shows what falsified it" $ do- H.Fail r <- evaluateExample $ property $ \ n -> n == (n + 1 :: Int)- lines r `shouldSatisfy` any (== "0")+ H.Fail r <- evaluateExample $ property $ \x y -> x + y == (x * y :: Int)+ r `shouldBe` intercalate "\n" [+ "Falsifiable (after 1 test and 2 shrinks): "+ , "0"+ , "1"+ ] + context "when used with shouldBe" $ do+ it "shows what falsified it" $ do+ H.Fail r <- evaluateExample $ property $ \x y -> x + y `shouldBe` (x * y :: Int)+ r `shouldBe` intercalate "\n" [+ "Falsifiable (after 1 test and 2 shrinks): "+ , "expected: 0"+ , " but got: 1"+ , "0"+ , "1"+ ]+ it "propagates UserInterrupt" $ do let p = morallyDubiousIOProperty (throwIO UserInterrupt >> return True) evaluateExample p `shouldThrow` (== UserInterrupt)@@ -57,9 +84,27 @@ pending "this probaly needs a patch to QuickCheck" -- evaluateExample (property $ (error "foobar" :: Int -> Bool)) `shouldThrow` errorCall "foobar" - context "for pending" $ do- it "returns Pending" $ do- evaluateExample (H.pending) `shouldReturn` H.Pending Nothing+ context "when used with `pending`" $ do+ it "returns Pending" $ do+ evaluateExample (property H.pending) `shouldReturn` H.Pending Nothing - it "includes the optional reason" $ do- evaluateExample (H.pending "foo") `shouldReturn` H.Pending (Just "foo")+ context "when used with `pendingWith`" $ do+ it "includes the optional reason" $ do+ evaluateExample (property $ H.pendingWith "foo") `shouldReturn` H.Pending (Just "foo")++ describe "Expectation" $ do+ context "as a QuickCheck property" $ do+ it "can be quantified" $ do+ e <- newMock+ H.hspec $ do+ H.it "some behavior" $ property $ \xs -> do+ mockAction e+ (reverse . reverse) xs `shouldBe` (xs :: [Int])+ mockCounter e `shouldReturn` 100++ it "can be used with expecatations/HUnit assertions" $ do+ H.hspecWith H.defaultConfig $ do+ H.describe "readIO" $ do+ H.it "is inverse to show" $ property $ \x -> do+ (readIO . show) x `shouldReturn` (x :: Int)+ `shouldReturn` H.Summary 1 0
test/Test/Hspec/FormattersSpec.hs view
@@ -3,7 +3,7 @@ import Test.Hspec.Meta -import Util+import SpecHelper import System.IO.Silently (capture) import qualified Test.Hspec as H import qualified Test.Hspec.Core as H (Result(..))@@ -22,7 +22,7 @@ H.describe "Example" $ do H.it "success" (H.Success) H.it "fail 1" (H.Fail "fail message")- H.it "pending" (H.pending "pending message")+ H.it "pending" (H.pendingWith "pending message") H.it "fail 2" (H.Fail "") H.it "exceptions" (undefined :: H.Result) H.it "fail 3" (H.Fail "")
test/Test/Hspec/HUnitSpec.hs view
@@ -1,7 +1,7 @@ module Test.Hspec.HUnitSpec (main, spec) where import Test.Hspec.Meta-import Util (captureLines)+import SpecHelper (captureLines) import Control.Applicative import qualified Test.Hspec as H
test/Test/Hspec/RunnerSpec.hs view
@@ -8,7 +8,7 @@ import System.Environment (withArgs, withProgName, getArgs) import System.Exit import qualified Control.Exception as E-import Util+import SpecHelper import Mock import System.SetEnv import Test.Hspec.Util (getEnv)@@ -41,11 +41,11 @@ H.it "foobar" False `shouldThrow` (== ExitFailure 1) - it "suppresses output to stdout when evaluating examples" $ do+ it "allows output to stdout" $ do r <- captureLines . H.hspec $ do H.it "foobar" $ do putStrLn "baz"- r `shouldSatisfy` notElem "baz"+ r `shouldSatisfy` elem "baz" it "prints an error message on unrecognized command-line options" $ do withProgName "myspec" . withArgs ["--foo"] $ do@@ -95,13 +95,6 @@ r `shouldSatisfy` all ((<= 80) . length) r `shouldSatisfy` any ((78 <=) . length) - context "with --verbose" $ do- it "does not suppress output to stdout" $ do- r <- captureLines . withArgs ["--verbose"] . H.hspec $ do- H.it "foobar" $ do- putStrLn "baz"- r `shouldSatisfy` elem "baz"- context "with --dry-run" $ do it "produces a report" $ do r <- captureLines . withArgs ["--dry-run"] . H.hspec $ do@@ -123,9 +116,9 @@ H.it "bar" False mockCounter e `shouldReturn` 0 - context "with --fast-fail" $ do+ context "with --fail-fast" $ do it "stops after first failure" $ do- r <- captureLines . ignoreExitCode . withArgs ["--fast-fail"] . H.hspec $ do+ r <- captureLines . ignoreExitCode . withArgs ["--fail-fast"] . H.hspec $ do H.it "foo" True H.it "bar" False H.it "baz" False@@ -141,7 +134,7 @@ ] it "works for nested specs" $ do- r <- captureLines . ignoreExitCode . withArgs ["--fast-fail"] . H.hspec $ do+ r <- captureLines . ignoreExitCode . withArgs ["--fail-fast"] . H.hspec $ do H.describe "foo" $ do H.it "bar" False H.it "baz" True
+ test/Test/Hspec/TimerSpec.hs view
@@ -0,0 +1,30 @@+module Test.Hspec.TimerSpec (main, spec) where++import Test.Hspec.Meta+import SpecHelper++import Test.Hspec.Timer++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "timer action returned by newTimer" $ do++ let dt = 0.01++ it "returns False" $ do+ timer <- newTimer dt+ timer `shouldReturn` False++ context "after specified time" $ do+ it "returns True" $ do+ timer <- newTimer dt+ sleep dt+ timer `shouldReturn` True+ timer `shouldReturn` False+ sleep dt+ sleep dt+ timer `shouldReturn` True+ timer `shouldReturn` False
test/Test/HspecSpec.hs view
@@ -1,10 +1,11 @@ module Test.HspecSpec (main, spec) where import Test.Hspec.Meta-import Util (captureLines)+import SpecHelper import Data.List (isPrefixOf) -import qualified Test.Hspec.Core.Type as H (defaultParams)+import Control.Applicative+ import Test.Hspec.Core (SpecTree(..), Result(..), runSpecM) import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H (hspecWith)@@ -21,10 +22,11 @@ H.it "foo" H.pending r `shouldSatisfy` any (== " # PENDING: No reason given") - it "accepts an optional message, which is included in the report" $ do+ describe "pending" $ do+ it "specifies a pending example with a reason for why it's pending" $ do r <- runSpec $ do H.it "foo" $ do- H.pending "for some reason"+ H.pendingWith "for some reason" r `shouldSatisfy` any (== " # PENDING: for some reason") describe "describe" $ do@@ -48,6 +50,11 @@ H.it "baz" True (foo, bar, baz) `shouldBe` ("foo", "bar", "baz") + context "when no description is given" $ do+ it "uses a default description" $ do+ let [SpecGroup d _] = runSpecM (H.describe "" (pure ()))+ d `shouldBe` "(no description given)"+ describe "it" $ do it "takes a description of a desired behavior" $ do let [SpecItem d _] = runSpecM (H.it "whatever" True)@@ -55,10 +62,19 @@ it "takes an example of that behavior" $ do let [SpecItem _ e] = runSpecM (H.it "whatever" True)- e H.defaultParams `shouldReturn` Success+ e defaultParams `shouldReturn` Success - it "can use a Bool, HUnit Test, QuickCheck property, or `pending` as an example"- pending+ context "when no description is given" $ do+ it "uses a default description" $ do+ let [SpecItem d _] = runSpecM (H.it "" True)+ d `shouldBe` "(unspecified behavior)"++ describe "example" $ do+ it "fixes the type of an expectation" $ do+ r <- runSpec $ do+ H.it "foo" $ H.example $ do+ pure ()+ r `shouldSatisfy` any (== "1 example, 0 failures") where runSpec :: H.Spec -> IO [String] runSpec = captureLines . H.hspecWith defaultConfig
− test/Util.hs
@@ -1,27 +0,0 @@-module Util where--import Data.List-import Data.Char-import Test.Hspec.Meta-import System.IO.Silently--captureLines :: IO a -> IO [String]-captureLines = fmap lines . capture_--shouldContain :: (Eq a, Show a) => [a] -> [a] -> Expectation-x `shouldContain` y = x `shouldSatisfy` isInfixOf y--shouldStartWith :: (Eq a, Show a) => [a] -> [a] -> Expectation-x `shouldStartWith` y = x `shouldSatisfy` isPrefixOf y--shouldEndWith :: (Eq a, Show a) => [a] -> [a] -> Expectation-x `shouldEndWith` y = x `shouldSatisfy` isSuffixOf y---- replace times in summary with zeroes-normalizeSummary :: [String] -> [String]-normalizeSummary xs = map f xs- where- f x | "Finished in " `isPrefixOf` x = map g x- | otherwise = x- g x | isNumber x = '0'- | otherwise = x