hspec-core 2.7.1 → 2.7.2
raw patch · 6 files changed
+94/−60 lines, 6 filesdep ~QuickCheckdep ~clock
Dependency ranges changed: QuickCheck, clock
Files
- hspec-core.cabal +5/−7
- src/Test/Hspec/Core/Clock.hs +5/−0
- src/Test/Hspec/Core/Formatters.hs +29/−18
- test/Helper.hs +0/−4
- test/Test/Hspec/Core/FormattersSpec.hs +26/−17
- test/Test/Hspec/Core/QuickCheckUtilSpec.hs +29/−14
hspec-core.cabal view
@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.0.+-- This file has been generated from package.yaml by hpack version 0.34.2. -- -- see: https://github.com/sol/hpack------ hash: 82bf612e65db816a15de01c4c432597ef4492ceeb81f46063dcdd57b74ec523a name: hspec-core-version: 2.7.1+version: 2.7.2 license: MIT license-file: LICENSE copyright: (c) 2011-2019 Simon Hengel,@@ -39,7 +37,7 @@ , array , base >=4.5.0.0 && <5 , call-stack- , clock+ , clock >=0.7.1 , deepseq , directory , filepath@@ -92,12 +90,12 @@ cpp-options: -DTEST build-depends: HUnit ==1.6.*- , QuickCheck >=2.13.1+ , QuickCheck >=2.14 , ansi-terminal >=0.5 , array , base >=4.5.0.0 && <5 , call-stack- , clock+ , clock >=0.7.1 , deepseq , directory , filepath
src/Test/Hspec/Core/Clock.hs view
@@ -5,11 +5,13 @@ , getMonotonicTime , measure , sleep+, timeout ) where import Text.Printf import System.Clock import Control.Concurrent+import qualified System.Timeout as System newtype Seconds = Seconds Double deriving (Eq, Show, Num, Fractional, PrintfArg)@@ -31,3 +33,6 @@ sleep :: Seconds -> IO () sleep = threadDelay . toMicroseconds++timeout :: Seconds -> IO a -> IO (Maybe a)+timeout = System.timeout . toMicroseconds
src/Test/Hspec/Core/Formatters.hs view
@@ -61,8 +61,11 @@ import Data.Maybe import Test.Hspec.Core.Util+import Test.Hspec.Core.Clock import Test.Hspec.Core.Spec (Location(..)) import Text.Printf+import Control.Monad.IO.Class+import Control.Exception -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make -- sure, that we only use the public API to implement formatters.@@ -100,8 +103,6 @@ , missingChunk ) -import Test.Hspec.Core.Clock (Seconds(..))- import Test.Hspec.Core.Formatters.Diff silent :: Formatter@@ -212,28 +213,38 @@ mapM_ indent preface b <- useDiff- let- chunks- | b = diff expected actual- | otherwise = [First expected, Second actual] - withFailColor $ write (indentation ++ "expected: ")- forM_ chunks $ \chunk -> case chunk of- Both a _ -> indented write a- First a -> indented extraChunk a- Second _ -> return ()- writeLine ""+ let threshold = 2 :: Seconds - withFailColor $ write (indentation ++ " but got: ")- forM_ chunks $ \chunk -> case chunk of- Both a _ -> indented write a- First _ -> return ()- Second a -> indented missingChunk a- writeLine ""+ mchunks <- liftIO $ if b+ then timeout threshold (evaluate $ diff expected actual)+ else return Nothing++ case mchunks of+ Just chunks -> do+ writeDiff chunks extraChunk missingChunk+ Nothing -> do+ writeDiff [First expected, Second actual] write write where indented output text = case break (== '\n') text of (xs, "") -> output xs (xs, _ : ys) -> output (xs ++ "\n") >> write (indentation ++ " ") >> indented output ys++ writeDiff chunks extra missing = do+ withFailColor $ write (indentation ++ "expected: ")+ forM_ chunks $ \ chunk -> case chunk of+ Both a _ -> indented write a+ First a -> indented extra a+ Second _ -> return ()+ writeLine ""++ withFailColor $ write (indentation ++ " but got: ")+ forM_ chunks $ \ chunk -> case chunk of+ Both a _ -> indented write a+ First _ -> return ()+ Second a -> indented missing a+ writeLine ""+ Error _ e -> withFailColor . indent $ (("uncaught exception: " ++) . formatException) e writeLine ""
test/Helper.hs view
@@ -36,7 +36,6 @@ import System.Exit import qualified Control.Exception as E import Control.Exception-import qualified System.Timeout as System import System.IO.Silently import System.SetEnv import System.Directory@@ -94,9 +93,6 @@ noOpProgressCallback :: H.ProgressCallback noOpProgressCallback _ = return ()--timeout :: Seconds -> IO a -> IO (Maybe a)-timeout = System.timeout . toMicroseconds shouldUseArgs :: HasCallStack => [String] -> (Args -> Bool) -> Expectation shouldUseArgs args p = do
test/Test/Hspec/Core/FormattersSpec.hs view
@@ -5,6 +5,7 @@ import Prelude () import Helper import Data.String+import Control.Monad.IO.Class import Control.Monad.Trans.Writer import qualified Control.Exception as E @@ -53,13 +54,13 @@ Plain x : xs -> color x : xs xs -> xs -interpret :: FormatM a -> [ColorizedText]+interpret :: FormatM a -> IO [ColorizedText] interpret = interpretWith environment -interpretWith :: Environment (Writer [ColorizedText]) -> FormatM a -> [ColorizedText]-interpretWith env = simplify . execWriter . H.interpretWith env+interpretWith :: Environment (WriterT [ColorizedText] IO) -> FormatM a -> IO [ColorizedText]+interpretWith env = fmap simplify . execWriterT . H.interpretWith env -environment :: Environment (Writer [ColorizedText])+environment :: Environment (WriterT [ColorizedText] IO) environment = Environment { environmentGetSuccessCount = return 0 , environmentGetPendingCount = return 0@@ -69,14 +70,22 @@ , environmentGetRealTime = return 0 , environmentWrite = tell . return . Plain , environmentWriteTransient = tell . return . Transient-, environmentWithFailColor = \action -> let (a, r) = runWriter action in tell (colorize Failed r) >> return a-, environmentWithSuccessColor = \action -> let (a, r) = runWriter action in tell (colorize Succeeded r) >> return a-, environmentWithPendingColor = \action -> let (a, r) = runWriter action in tell (colorize Pending r) >> return a-, environmentWithInfoColor = \action -> let (a, r) = runWriter action in tell (colorize Info r) >> return a+, environmentWithFailColor = \ action -> do+ (a, r) <- liftIO $ runWriterT action+ tell (colorize Failed r) >> return a+, environmentWithSuccessColor = \ action -> do+ (a, r) <- liftIO $ runWriterT action+ tell (colorize Succeeded r) >> return a+, environmentWithPendingColor = \ action -> do+ (a, r) <- liftIO $ runWriterT action+ tell (colorize Pending r) >> return a+, environmentWithInfoColor = \ action -> do+ (a, r) <- liftIO $ runWriterT action+ tell (colorize Info r) >> return a , environmentUseDiff = return True , environmentExtraChunk = tell . return . Extra , environmentMissingChunk = tell . return . Missing-, environmentLiftIO = undefined+, environmentLiftIO = liftIO } testSpec :: H.Spec@@ -96,19 +105,19 @@ describe "exampleSucceeded" $ do it "marks succeeding examples with ." $ do- interpret (H.exampleSucceeded formatter undefined undefined) `shouldBe` [+ interpret (H.exampleSucceeded formatter undefined undefined) `shouldReturn` [ Succeeded "." ] describe "exampleFailed" $ do it "marks failing examples with F" $ do- interpret (H.exampleFailed formatter undefined undefined undefined) `shouldBe` [+ interpret (H.exampleFailed formatter undefined undefined undefined) `shouldReturn` [ Failed "F" ] describe "examplePending" $ do it "marks pending examples with ." $ do- interpret (H.examplePending formatter undefined undefined undefined) `shouldBe` [+ interpret (H.examplePending formatter undefined undefined undefined) `shouldReturn` [ Pending "." ] @@ -206,7 +215,7 @@ environmentGetFailMessages = return [FailureRecord Nothing ([], "") (ExpectedButGot Nothing "first\nsecond\nthird" "first\ntwo\nthird")] } it "adds indentation" $ do- removeColors (interpretWith env action) `shouldBe` unlines [+ (removeColors <$> interpretWith env action) `shouldReturn` unlines [ "" , "Failures:" , ""@@ -238,7 +247,7 @@ context "without failures" $ do let env = environment {environmentGetSuccessCount = return 1} it "shows summary in green if there are no failures" $ do- interpretWith env action `shouldBe` [+ interpretWith env action `shouldReturn` [ "Finished in 0.0000 seconds\n" , Succeeded "1 example, 0 failures\n" ]@@ -246,7 +255,7 @@ context "with pending examples" $ do let env = environment {environmentGetPendingCount = return 1} it "shows summary in yellow if there are pending examples" $ do- interpretWith env action `shouldBe` [+ interpretWith env action `shouldReturn` [ "Finished in 0.0000 seconds\n" , Pending "1 example, 0 failures, 1 pending\n" ]@@ -254,7 +263,7 @@ context "with failures" $ do let env = environment {environmentGetFailMessages = return [undefined]} it "shows summary in red" $ do- interpretWith env action `shouldBe` [+ interpretWith env action `shouldReturn` [ "Finished in 0.0000 seconds\n" , Failed "1 example, 1 failure\n" ]@@ -262,7 +271,7 @@ context "with both failures and pending examples" $ do let env = environment {environmentGetFailMessages = return [undefined], environmentGetPendingCount = return 1} it "shows summary in red" $ do- interpretWith env action `shouldBe` [+ interpretWith env action `shouldReturn` [ "Finished in 0.0000 seconds\n" , Failed "2 examples, 1 failure, 1 pending\n" ]
test/Test/Hspec/Core/QuickCheckUtilSpec.hs view
@@ -91,7 +91,7 @@ , "0" , "" , "Passed:"- , "28"+ , "23" ] parseQuickCheckResult <$> quickCheckWithResult args {maxSuccess = 2} (verbose p) `shouldReturn` QuickCheckResult 2 info (QuickCheckOtherFailure "Passed 2 tests (expected failure).")@@ -100,11 +100,11 @@ context "without checkCoverage" $ do let p :: Int -> Property- p n = cover 10 (n == 23) "is 23" True+ p n = cover 10 (n == 5) "is 5" True it "parses result" $ do parseQuickCheckResult <$> qc p `shouldReturn`- QuickCheckResult 100 "+++ OK, passed 100 tests.\n\nOnly 0% is 23, but expected 10%" QuickCheckSuccess+ QuickCheckResult 100 "+++ OK, passed 100 tests (1% is 5).\n\nOnly 1% is 5, but expected 10%" QuickCheckSuccess it "includes verbose output" $ do let@@ -113,11 +113,11 @@ , "0" , "" , "Passed:"- , "28"+ , "23" , "" , "+++ OK, passed 2 tests." , ""- , "Only 0% is 23, but expected 10%"+ , "Only 0% is 5, but expected 10%" ] parseQuickCheckResult <$> quickCheckWithResult args {maxSuccess = 2} (verbose p) `shouldReturn` QuickCheckResult 2 info QuickCheckSuccess@@ -133,20 +133,20 @@ , quickCheckFailureException = Nothing , quickCheckFailureReason = "Insufficient coverage" , quickCheckFailureCounterexample = [- " 0.8% is 23"+ " 0.9% is 23" , ""- , "Only 0.8% is 23, but expected 10.0%"+ , "Only 0.9% is 23, but expected 10.0%" ] } it "parses result" $ do parseQuickCheckResult <$> qc p `shouldReturn`- QuickCheckResult 400 "" (QuickCheckFailure failure)+ QuickCheckResult 800 "" (QuickCheckFailure failure) it "includes verbose output" $ do- let info = intercalate "\n\n" (replicate 399 "Passed:")+ let info = intercalate "\n\n" (replicate 799 "Passed:") parseQuickCheckResult <$> qc (verbose . p) `shouldReturn`- QuickCheckResult 400 info (QuickCheckFailure failure)+ QuickCheckResult 800 info (QuickCheckFailure failure) context "with Failure" $ do context "with single-line failure reason" $ do@@ -155,7 +155,7 @@ p = (< 1) err = "Falsified"- result = QuickCheckResult 3 "" (QuickCheckFailure $ QCFailure 1 Nothing err ["1"])+ result = QuickCheckResult 4 "" (QuickCheckFailure $ QCFailure 2 Nothing err ["1"]) it "parses result" $ do parseQuickCheckResult <$> qc p `shouldReturn` result@@ -166,9 +166,18 @@ , "0" , "" , "Passed:"- , "-1"+ , "0" , ""+ , "Passed:"+ , "-2"+ , "" , "Failed:"+ , "3"+ , ""+ , "Passed:"+ , "0"+ , ""+ , "Failed:" , "2" , "" , "Passed:"@@ -189,7 +198,7 @@ p n = if n /= 2 then QCP.succeeded else QCP.failed {QCP.reason = err} err = "foo\nbar"- result = QuickCheckResult 3 "" (QuickCheckFailure $ QCFailure 0 Nothing err ["2"])+ result = QuickCheckResult 5 "" (QuickCheckFailure $ QCFailure 0 Nothing err ["2"]) it "parses result" $ do parseQuickCheckResult <$> qc p `shouldReturn` result@@ -200,7 +209,13 @@ , "0" , "" , "Passed:"- , "-1"+ , "0"+ , ""+ , "Passed:"+ , "-2"+ , ""+ , "Passed:"+ , "3" , "" , "Failed:" , "2"