packages feed

hspec-core 2.1.8 → 2.1.9

raw patch · 10 files changed

+173/−49 lines, 10 filesdep ~basedep ~hspec-expectations

Dependency ranges changed: base, hspec-expectations

Files

hspec-core.cabal view
@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.4.0.+-- This file has been generated from package.yaml by hpack version 0.5.4. -- -- see: https://github.com/sol/hpack  name:             hspec-core-version:          2.1.8+version:          2.1.9 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2015 Simon Hengel,@@ -25,7 +25,23 @@   subdir: hspec-core  library-  hs-source-dirs: src+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >= 4.3 && < 5+    , random+    , tf-random+    , setenv+    , ansi-terminal >= 0.5+    , time+    , transformers >= 0.2.2.0+    , deepseq+    , HUnit >= 1.2.5+    , QuickCheck >= 2.5.1+    , quickcheck-io+    , hspec-expectations == 0.7.1.*+    , async >= 2   exposed-modules:       Test.Hspec.Core.Spec       Test.Hspec.Core.Hooks@@ -45,6 +61,15 @@       Test.Hspec.FailureReport       Test.Hspec.Options       Test.Hspec.Timer+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+    , src+  ghc-options: -Wall   build-depends:       base >= 4.3 && < 5     , random@@ -57,15 +82,11 @@     , HUnit >= 1.2.5     , QuickCheck >= 2.5.1     , quickcheck-io-    , hspec-expectations == 0.7.0.*+    , hspec-expectations == 0.7.1.*     , async >= 2-  ghc-options: -Wall-  default-language: Haskell2010--test-suite spec-  type: exitcode-stdio-1.0-  hs-source-dirs: test, src-  main-is: Spec.hs+    , hspec-meta >= 2.1.5+    , silently >= 1.2.4+    , process   other-modules:       Helper       Mock@@ -83,37 +104,18 @@       Test.Hspec.Compat       Test.Hspec.Config       Test.Hspec.Core.Example-      Test.Hspec.Core.Formatters.Internal       Test.Hspec.Core.Formatters+      Test.Hspec.Core.Formatters.Internal       Test.Hspec.Core.Hooks       Test.Hspec.Core.QuickCheck       Test.Hspec.Core.QuickCheckUtil-      Test.Hspec.Core.Runner.Eval       Test.Hspec.Core.Runner-      Test.Hspec.Core.Spec.Monad+      Test.Hspec.Core.Runner.Eval       Test.Hspec.Core.Spec+      Test.Hspec.Core.Spec.Monad       Test.Hspec.Core.Tree       Test.Hspec.Core.Util       Test.Hspec.FailureReport       Test.Hspec.Options       Test.Hspec.Timer-  build-depends:-      base >= 4.3 && < 5-    , random-    , tf-random-    , setenv-    , ansi-terminal >= 0.5-    , time-    , transformers >= 0.2.2.0-    , deepseq-    , HUnit >= 1.2.5-    , QuickCheck >= 2.5.1-    , quickcheck-io-    , hspec-expectations == 0.7.0.*-    , async >= 2--    , hspec-meta >= 2.1.5-    , silently >= 1.2.4-    , process-  ghc-options: -Wall   default-language: Haskell2010
src/Test/Hspec/Core/Runner.hs view
@@ -1,3 +1,10 @@+{-# LANGUAGE CPP #-}++#if MIN_VERSION_base(4,6,0)+-- Control.Concurrent.QSem is deprecated in base-4.6.0.*+{-# OPTIONS_GHC -fno-warn-deprecations #-}+#endif+ -- | -- Stability: provisional module Test.Hspec.Core.Runner (@@ -25,6 +32,7 @@ import           System.Environment (getProgName, getArgs, withArgs) import           System.Exit import qualified Control.Exception as E+import           Control.Concurrent  import           System.Console.ANSI (hHideCursor, hShowCursor) import qualified Test.QuickCheck as QC@@ -122,13 +130,17 @@         seed = (fromJust . configQuickCheckSeed) c         qcArgs = configQuickCheckArgs c +    jobsSem <- newQSem =<< case configConcurrentJobs c of+      Nothing -> getNumCapabilities+      Just maxJobs -> return maxJobs+     useColor <- doesUseColor h c      filteredSpec <- filterSpecs c . applyDryRun c <$> runSpecM spec      withHiddenCursor useColor h $       runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do-        runFormatter useColor h c formatter filteredSpec `finally_` do+        runFormatter jobsSem useColor h c formatter filteredSpec `finally_` do           failedFormatter formatter          footerFormatter formatter
src/Test/Hspec/Core/Runner/Eval.hs view
@@ -1,3 +1,10 @@+{-# LANGUAGE CPP #-}++#if MIN_VERSION_base(4,6,0)+-- Control.Concurrent.QSem is deprecated in base-4.6.0.*+{-# OPTIONS_GHC -fno-warn-deprecations #-}+#endif+ module Test.Hspec.Core.Runner.Eval (runFormatter) where  import           Prelude ()@@ -22,8 +29,8 @@ type EvalTree = Tree (ActionWith ()) (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ()))  -- | Evaluate all examples of a given spec and produce a report.-runFormatter :: Bool -> Handle -> Config -> Formatter -> [SpecTree ()] -> FormatM ()-runFormatter useColor h c formatter specs = do+runFormatter :: QSem -> Bool -> Handle -> Config -> Formatter -> [SpecTree ()] -> FormatM ()+runFormatter jobsSem useColor h c formatter specs = do   headerFormatter formatter   chan <- liftIO newChan   reportProgress <- liftIO mkReportProgress@@ -38,7 +45,7 @@     toEvalTree = map (fmap f)       where         f :: Item () -> (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ()))-        f (Item requirement loc isParallelizable e) = (requirement, loc, parallelize isParallelizable $ e params ($ ()))+        f (Item requirement loc isParallelizable e) = (requirement, loc, parallelize jobsSem isParallelizable $ e params ($ ()))      params :: Params     params = Params (configQuickCheckArgs c) (configSmallCheckDepth c)@@ -53,9 +60,9 @@  type FormatResult = Either E.SomeException Result -> FormatM () -parallelize :: Bool -> (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())-parallelize isParallelizable e-  | isParallelizable = runParallel e+parallelize :: QSem -> Bool -> (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())+parallelize jobsSem isParallelizable e+  | isParallelizable = runParallel jobsSem e   | otherwise = runSequentially e  runSequentially :: (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())@@ -65,10 +72,10 @@  data Report = ReportProgress Progress | ReportResult (Either E.SomeException Result) -runParallel :: (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())-runParallel e reportProgress formatResult = do+runParallel :: QSem -> (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())+runParallel jobsSem e reportProgress formatResult = do   mvar <- newEmptyMVar-  _ <- forkIO $ do+  _ <- forkIO $ E.bracket_ (waitQSem jobsSem) (signalQSem jobsSem) $ do     let progressCallback = replaceMVar mvar . ReportProgress     result <- evalExample (e progressCallback)     replaceMVar mvar (ReportResult result)
src/Test/Hspec/Core/Spec.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE CPP #-}+#if MIN_VERSION_base(4,8,1)+#define HAS_SOURCE_LOCATIONS+{-# LANGUAGE ImplicitParams #-}+#endif -- | -- Stability: unstable --@@ -22,7 +27,12 @@ , module Test.Hspec.Core.Tree ) where +#ifdef HAS_SOURCE_LOCATIONS+import           GHC.Stack+#endif+ import qualified Control.Exception as E+ import           Test.Hspec.Expectations (Expectation)  import           Test.Hspec.Core.Example@@ -44,7 +54,11 @@ -- > describe "absolute" $ do -- >   it "returns a positive number when given a negative number" $ -- >     absolute (-1) == 1+#ifdef HAS_SOURCE_LOCATIONS+it :: (?loc :: CallStack, Example a) => String -> a -> SpecWith (Arg a)+#else it :: Example a => String -> a -> SpecWith (Arg a)+#endif it label action = fromSpecList [specItem label action]  -- | `parallel` marks all spec items of the given spec to be safe for parallel
src/Test/Hspec/Core/Tree.hs view
@@ -1,4 +1,11 @@ {-# LANGUAGE DeriveFunctor #-}++{-# LANGUAGE CPP #-}+#if MIN_VERSION_base(4,8,1)+#define HAS_SOURCE_LOCATIONS+{-# LANGUAGE ImplicitParams #-}+#endif+ -- | -- Stability: unstable module Test.Hspec.Core.Tree (@@ -11,6 +18,11 @@ , specItem ) where +#ifdef HAS_SOURCE_LOCATIONS+import           GHC.SrcLoc+import           GHC.Stack+#endif+ import           Prelude () import           Test.Hspec.Compat @@ -93,9 +105,22 @@       | otherwise = s  -- | The @specItem@ function creates a spec item.+#ifdef HAS_SOURCE_LOCATIONS+specItem :: (?loc :: CallStack, Example a) => String -> a -> SpecTree (Arg a)+#else specItem :: Example a => String -> a -> SpecTree (Arg a)-specItem s e = Leaf $ Item requirement Nothing False (evaluateExample e)+#endif+specItem s e = Leaf $ Item requirement location False (evaluateExample e)   where     requirement       | null s = "(unspecified behavior)"       | otherwise = s++    location :: Maybe Location+#ifdef HAS_SOURCE_LOCATIONS+    location = case reverse (getCallStack ?loc) of+      (_, loc) : _ -> Just (Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc) ExactLocation)+      _ -> Nothing+#else+    location = Nothing+#endif
src/Test/Hspec/Options.hs view
@@ -7,6 +7,7 @@ ) where  import           Prelude ()+import           Control.Monad import           Test.Hspec.Compat  import           System.IO@@ -37,6 +38,7 @@ , configFormatter :: Maybe Formatter , configHtmlOutput :: Bool , configOutputFile :: Either Handle FilePath+, configConcurrentJobs :: Maybe Int }  defaultConfig :: Config@@ -56,6 +58,7 @@ , configFormatter = Nothing , configHtmlOutput = False , configOutputFile = Left stdout+, configConcurrentJobs = Nothing }  filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool)@@ -137,6 +140,7 @@   , Option   []  ["dry-run"]          (NoArg setDryRun)                   (h "pretend that everything passed; don't verify anything")   , Option   []  ["fail-fast"]        (NoArg setFastFail)                 (h "abort on first failure")   , Option   "r" ["rerun"]            (NoArg  setRerun)                   (h "rerun all examples that failed in the previously test run (only works in GHCi)")+  , mkOption "j"  "jobs"              (Arg "N" readMaxJobs setMaxJobs)    (h "run at most N parallelizable tests simultaneously (default: number of available processors)")   ]   where     h = unlines . addLineBreaks@@ -144,11 +148,20 @@     readFormatter :: String -> Maybe Formatter     readFormatter = (`lookup` formatters) +    readMaxJobs :: String -> Maybe Int+    readMaxJobs s = do+      n <- readMaybe s+      guard $ n > 0+      return n+     setFormatter :: Formatter -> Config -> Config     setFormatter f c = c {configFormatter = Just f}      setOutputFile :: String -> Config -> Config     setOutputFile file c = c {configOutputFile = Right file}++    setMaxJobs :: Int -> Config -> Config+    setMaxJobs n c = c {configConcurrentJobs = Just n}      setPrintCpuTime x = x >>= \c -> return c {configPrintCpuTime = True}     setDryRun       x = x >>= \c -> return c {configDryRun = True}
test/Helper.hs view
@@ -15,6 +15,8 @@ , throwException  , shouldUseArgs++, removeLocations ) where  import           Prelude ()@@ -79,3 +81,6 @@         H.it "foo" False   (silence . ignoreExitCode . withArgs args . H.hspec) spec   readIORef spy >>= (`shouldSatisfy` p)++removeLocations :: H.SpecWith a -> H.SpecWith a+removeLocations = H.mapSpecItem_ (\item -> item{H.itemLocation = Nothing})
test/Test/Hspec/Core/RunnerSpec.hs view
@@ -151,7 +151,7 @@         mvar <- newEmptyMVar         sync <- newEmptyMVar         threadId <- forkIO $ do-          r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec $ do+          r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec . removeLocations $ do             H.it "foo" False             H.it "bar" $ do               putMVar sync ()@@ -229,7 +229,7 @@      context "with --fail-fast" $ do       it "stops after first failure" $ do-        r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do+        r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec . removeLocations $ do           H.it "foo" True           H.it "bar" False           H.it "baz" False@@ -249,7 +249,7 @@           ]        it "works for nested specs" $ do-        r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do+        r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec . removeLocations $ do           H.describe "foo" $ do             H.it "bar" False             H.it "baz" True@@ -430,6 +430,23 @@       let n = 10           t = 0.01           dt = t * (fromIntegral n / 2)-      r <- timeout dt . silence . H.hspecResult . H.parallel $ do+      r <- timeout dt . silence . withArgs ["-j", show n] . H.hspecResult . H.parallel $ do         replicateM_ n (H.it "foo" $ sleep t)       r `shouldBe` Just (H.Summary n 0)++    context "with -j" $ do+      it "limits parallelism" $ do+        currentRef <- newIORef (0 :: Int)+        highRef <- newIORef 0+        let n = 10+            t = 0.01+            j = 2+            start = do+              current <- atomicModifyIORef currentRef $ \x -> let y = succ x in (y, y)+              atomicModifyIORef highRef $ \x -> (max x current, ())+            stop = atomicModifyIORef currentRef $ \x -> (pred x, ())+        r <- withArgs ["-j", show j] . H.hspecResult . H.parallel $ do+          replicateM_ n $ H.it "foo" $ E.bracket_ start stop $ sleep t+        r `shouldBe` H.Summary n 0+        high <- readIORef highRef+        high `shouldBe` j
test/Test/Hspec/Core/SpecSpec.hs view
@@ -1,8 +1,20 @@+{-# LANGUAGE RecordWildCards #-}++{-# LANGUAGE CPP #-}+#if MIN_VERSION_base(4,8,1)+#define HAS_SOURCE_LOCATIONS+{-# LANGUAGE ImplicitParams #-}+#endif module Test.Hspec.Core.SpecSpec (main, spec) where  import           Prelude () import           Helper +#ifdef HAS_SOURCE_LOCATIONS+import           GHC.SrcLoc+import           GHC.Stack+#endif+ import           Test.Hspec.Core.Spec (Item(..), Result(..)) import qualified Test.Hspec.Core.Runner as H import           Test.Hspec.Core.Spec (Tree(..), runSpecM)@@ -38,6 +50,14 @@     it "takes an example of that behavior" $ do       [Leaf item] <- runSpecM (H.it "whatever" True)       itemExample item defaultParams ($ ()) noOpProgressCallback `shouldReturn` Success++#ifdef HAS_SOURCE_LOCATIONS+    it "adds source locations" $ do+      [Leaf item] <- runSpecM (H.it "foo" True)+      let [(_, loc)] = (getCallStack ?loc)+          location = H.Location (srcLocFile loc) (pred $ srcLocStartLine loc) 32 H.ExactLocation+      itemLocation item `shouldBe` Just location+#endif      context "when no description is given" $ do       it "uses a default description" $ do
test/Test/Hspec/OptionsSpec.hs view
@@ -1,10 +1,11 @@ module Test.Hspec.OptionsSpec (main, spec) where +import           Control.Monad import           Helper import           System.Exit -import           Test.Hspec.Options hiding (parseOptions) import qualified Test.Hspec.Options as Options+import           Test.Hspec.Options hiding (parseOptions)  main :: IO () main = hspec spec@@ -42,3 +43,11 @@     context "with --depth" $ do       it "sets depth parameter for SmallCheck" $ do         configSmallCheckDepth <$> parseOptions ["--depth", "23"] `shouldBe` Right 23++    context "with --jobs" $ do+      it "sets number of concurrent jobs" $ do+        configConcurrentJobs <$> parseOptions ["--jobs=23"] `shouldBe` Right (Just 23)++      it "rejects values < 1" $ do+        let msg = "my-spec: invalid argument `0' for `--jobs'\nTry `my-spec --help' for more information.\n"+        void (parseOptions ["--jobs=0"]) `shouldBe` Left (ExitFailure 1, msg)