packages feed

hspec2 0.2.1 → 0.3.0

raw patch · 15 files changed

+121/−77 lines, 15 filesdep +asyncdep +hspec2dep +io-memoizedep −hspecPVP ok

version bump matches the API change (PVP)

Dependencies added: async, hspec2, io-memoize

Dependencies removed: hspec

API changes (from Hackage documentation)

+ Test.Hspec: beforeAll :: IO a -> SpecWith a -> SpecWith ()
+ Test.Hspec.Core: BuildSpecs :: (IO [SpecTree a]) -> SpecTree a
- Test.Hspec: class Example e
+ Test.Hspec: class Example e where type family Arg e

Files

hspec2.cabal view
@@ -1,5 +1,5 @@ name:             hspec2-version:          0.2.1+version:          0.3.0 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2014 Simon Hengel,@@ -49,6 +49,8 @@     , QuickCheck    >= 2.5.1     , quickcheck-io     , hspec-expectations == 0.5.0.*+    , async >= 2+    , io-memoize   exposed-modules:       Test.Hspec       Test.Hspec.Core@@ -107,6 +109,8 @@     , QuickCheck     , quickcheck-io     , hspec-expectations+    , async+    , io-memoize      , hspec-meta >= 1.9.1     , process@@ -136,7 +140,7 @@       -Wall -Werror   build-depends:       base    == 4.*-    , hspec+    , hspec2     , QuickCheck  -- hspec-discover
src/Test/Hspec.hs view
@@ -9,6 +9,7 @@ module Test.Hspec ( -- * Types   Spec+, Arg , SpecWith , ActionWith , Example@@ -25,6 +26,7 @@ , pendingWith , before , beforeWith+, beforeAll , after , after_ , around@@ -43,6 +45,7 @@ import           Test.Hspec.HUnit () import           Test.Hspec.Expectations import qualified Test.Hspec.Core as Core+import           System.IO.Memoize  -- | Combine a list of specs into a larger spec. describe :: String -> SpecWith a -> SpecWith a@@ -92,6 +95,14 @@ -- | Run a custom action before every spec item. beforeWith :: (b -> IO a) -> SpecWith a -> SpecWith b beforeWith action = aroundWith $ \e x -> action x >>= e++-- | Run a custom action before all spec items.+beforeAll :: IO a -> SpecWith a -> SpecWith ()+beforeAll action = fromSpecList . return . BuildSpecs . go .  runSpecM+  where+    go xs = do+      action_ <- ioMemo action+      return . runSpecM $ before action_ (fromSpecList xs)  -- | Run a custom action after every spec item. after :: ActionWith a -> SpecWith a -> SpecWith a
src/Test/Hspec/Config.hs view
@@ -40,7 +40,21 @@ }  defaultConfig :: Config-defaultConfig = Config False False False Nothing Nothing Nothing Nothing Nothing 5 ColorAuto specdoc False (Left stdout)+defaultConfig = Config {+  configDryRun = False+, configPrintCpuTime = False+, configFastFail = False+, configFilterPredicate = Nothing+, configQuickCheckSeed = Nothing+, configQuickCheckMaxSuccess = Nothing+, configQuickCheckMaxDiscardRatio = Nothing+, configQuickCheckMaxSize = Nothing+, configSmallCheckDepth = 5+, configColorMode = ColorAuto+, configFormatter = specdoc+, configHtmlOutput = False+, configHandle = Left stdout+}  -- | Add a filter predicate to config.  If there is already a filter predicate, -- then combine them with `||`.
src/Test/Hspec/Core/QuickCheckUtil.hs view
@@ -13,7 +13,6 @@   #if MIN_VERSION_QuickCheck(2,7,0)-import           Control.Exception import           Test.QuickCheck.Random #endif @@ -36,15 +35,6 @@   ref <- newIORef (return QCP.succeeded)   action $ \a -> reduceRose (r a) >>= writeIORef ref   readIORef ref--isUserInterrupt :: QC.Result -> Bool-isUserInterrupt r = case r of-#if MIN_VERSION_QuickCheck(2,7,0)-  QC.Failure {theException = me} -> (me >>= fromException) == Just UserInterrupt-#else-  QC.Failure {QC.reason = "Exception: 'user interrupt'"} -> True-#endif-  _ -> False  formatNumbers :: Result -> String formatNumbers r = "(after " ++ pluralize (numTests r) "test" ++ shrinks ++ ")"
src/Test/Hspec/Core/Type.hs view
@@ -25,7 +25,6 @@  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)@@ -77,11 +76,12 @@ data Params = Params {   paramsQuickCheckArgs  :: QC.Args , paramsSmallCheckDepth :: Int-}+} deriving (Show)  -- | Internal representation of a spec. data SpecTree a =     SpecGroup String [SpecTree a]+  | BuildSpecs (IO [SpecTree a])   | SpecItem String (Item a)  data Item a = Item {@@ -97,6 +97,7 @@   where     go spec = case spec of       SpecItem r item -> SpecItem r (f item)+      BuildSpecs es -> BuildSpecs (map go <$> es)       SpecGroup d es -> SpecGroup d (map go es)  -- | The @describe@ function combines a list of specs into a larger spec.@@ -147,9 +148,6 @@   type Arg (a -> QC.Property) = a   evaluateExample p c action progressCallback = do     r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty action p)-    when (isUserInterrupt r) $ do-      E.throwIO E.UserInterrupt-     return $       case r of         QC.Success {}               -> Success
src/Test/Hspec/Runner.hs view
@@ -114,10 +114,11 @@         | otherwise      = spec_    useColor <- doesUseColor h c+  filteredSpec <- maybe id filterSpecs (configFilterPredicate c) <$> toTree spec    withHiddenCursor useColor h $     runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do-      runFormatter useColor h c formatter (maybe id filterSpecs (configFilterPredicate c) $ (map toTree . runSpecM) spec) `finally_` do+      runFormatter useColor h c formatter filteredSpec `finally_` do         failedFormatter formatter        footerFormatter formatter
src/Test/Hspec/Runner/Eval.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveFunctor #-} module Test.Hspec.Runner.Eval (runFormatter) where  import           Control.Applicative
src/Test/Hspec/Runner/Tree.hs view
@@ -1,18 +1,18 @@+{-# LANGUAGE DeriveFunctor #-} module Test.Hspec.Runner.Tree where +import           Control.Applicative import           Test.Hspec.Core.Type  data Tree a   = Node !String [Tree a]   | Leaf !String a-  deriving (Eq, Show)--instance Functor Tree where-  fmap f t = case t of-    Node s xs -> Node s (map (fmap f) xs)-    Leaf s x -> Leaf s (f x)+  deriving (Eq, Show, Functor) -toTree :: SpecTree () -> Tree (Item ())-toTree spec = case spec of-  SpecGroup label specs -> Node label (map toTree specs)-  SpecItem r item -> Leaf r item+toTree :: SpecWith a -> IO [Tree (Item a)]+toTree spec = concat <$> mapM go (runSpecM spec)+  where+    go x = case x of+      SpecGroup label xs -> return . Node label . concat <$> mapM go xs+      BuildSpecs xs -> concat <$> (xs >>= mapM go)+      SpecItem r item -> return [Leaf r item]
src/Test/Hspec/Util.hs view
@@ -11,11 +11,12 @@  import           Data.List import           Data.Char (isSpace)-import           Control.Applicative import qualified Control.Exception as E+import           Control.Concurrent.Async  import           Test.Hspec.Compat (showType) + -- | Create a more readable display of a quantity of something. -- -- Examples:@@ -44,15 +45,7 @@ formatException (E.SomeException e) = showType e ++ " (" ++ show e ++ ")"  safeTry :: IO a -> IO (Either E.SomeException a)-safeTry action = (Right <$> (action >>= E.evaluate)) `E.catches` [-  -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT-  -- (ctrl-c).  All AsyncExceptions are re-thrown (not just UserInterrupt)-  -- because all of them indicate severe conditions and should not occur during-  -- normal operation.-    E.Handler $ \e -> E.throwIO (e :: E.AsyncException)--  , E.Handler $ \e -> (return . Left) (e :: E.SomeException)-  ]+safeTry action = withAsync (action >>= E.evaluate) waitCatch  -- | -- A tuple that represents the location of an example within a spec.
test/Helper.hs view
@@ -44,7 +44,7 @@ ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return ()  ignoreUserInterrupt :: IO () -> IO ()-ignoreUserInterrupt action = action `E.catch` \e -> unless (e == E.UserInterrupt) (E.throwIO e)+ignoreUserInterrupt action = E.catchJust (guard . (== E.UserInterrupt)) action return  captureLines :: IO a -> IO [String] captureLines = fmap lines . capture_
test/Test/Hspec/Core/TypeSpec.hs view
@@ -5,7 +5,6 @@ import           Mock import           Data.List import           Data.IORef-import           Control.Exception (AsyncException(..), throwIO)  import qualified Test.Hspec.Core.Type as H hiding (describe, it) import qualified Test.Hspec as H@@ -92,10 +91,6 @@               modifyIORef ref succ         H.Success <- evaluateExampleWith action (property $ modifyIORef ref succ)         readIORef ref `shouldReturn` 200--      it "propagates UserInterrupt" $ do-        let p = property (throwIO UserInterrupt :: Expectation)-        evaluateExample p `shouldThrow` (== UserInterrupt)        it "pretty-prints exceptions" $ do         -- pendingWith "this probably needs a patch to QuickCheck"
test/Test/Hspec/HUnitSpec.hs view
@@ -1,28 +1,16 @@ module Test.Hspec.HUnitSpec (main, spec) where -import           Helper+import           Helper hiding (example) -import           Test.Hspec.Core.Type (SpecTree(..), runSpecM)+import           Test.Hspec.Runner.Tree import           Test.Hspec.HUnit import           Test.HUnit  main :: IO () main = hspec spec --- SpecTree does not have an Eq nor a Show instance, hence we map it to `Tree`.-data Tree = Group String [Tree] | Example String-  deriving (Eq, Show)--shouldYield :: Test -> [Tree] -> Expectation-a `shouldYield` b = (convert . runSpecM . fromHUnitTest) a `shouldBe` b-  where-    convert :: [SpecTree ()] -> [Tree]-    convert = map go-      where-        go :: SpecTree () -> Tree-        go x = case x of-          SpecGroup s xs  -> Group s (map go xs)-          SpecItem requirement _ -> Example requirement+shouldYield :: Test -> [Tree ()] -> Expectation+a `shouldYield` b = map (() <$) <$> toTree (fromHUnitTest a) `shouldReturn` b  spec :: Spec spec = do@@ -30,20 +18,23 @@     let e = TestCase $ pure ()      it "works for a TestCase" $ do-      e `shouldYield` [Example "<unlabeled>"]+      e `shouldYield` [example "<unlabeled>"]      it "works for a labeled TestCase" $ do       TestLabel "foo" e-        `shouldYield` [Example "foo"]+        `shouldYield` [example "foo"]      it "works for a TestCase with nested labels" $ do       (TestLabel "foo" . TestLabel "bar") e-        `shouldYield` [Group "foo" [Example "bar"]]+        `shouldYield` [Node "foo" [example "bar"]]      it "works for a flat TestList" $ do       TestList [e, e, e]-        `shouldYield` [Example "<unlabeled>", Example "<unlabeled>", Example "<unlabeled>"]+        `shouldYield` [example "<unlabeled>", example "<unlabeled>", example "<unlabeled>"]      it "works for a nested TestList" $ do       (TestLabel "foo" . TestLabel "bar" . TestList) [TestLabel "one" e, TestLabel "two" e, TestLabel "three" e]-        `shouldYield` [Group "foo" [Group "bar" [Example "one", Example "two", Example "three"]]]+        `shouldYield` [Node "foo" [Node "bar" [example "one", example "two", example "three"]]]+  where+    example :: String -> Tree ()+    example r = Leaf r ()
test/Test/Hspec/RunnerSpec.hs view
@@ -6,6 +6,7 @@ import           Control.Monad import           System.Environment (withArgs, withProgName, getArgs) import           System.Exit+import           Control.Concurrent import qualified Control.Exception as E import           Mock import           System.SetEnv@@ -143,11 +144,19 @@      context "when interrupted with ctrl-c" $ do       it "prints summary immediately" $ do-        r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec $ do-          H.it "foo" False-          H.it "bar" $ do-            E.throwIO E.UserInterrupt :: IO ()-          H.it "baz" True+        mvar <- newEmptyMVar+        sync <- newEmptyMVar+        threadId <- forkIO $ do+          r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec $ do+            H.it "foo" False+            H.it "bar" $ do+              putMVar sync ()+              threadDelay 1000000+            H.it "baz" True+          putMVar mvar r+        takeMVar sync+        throwTo threadId E.UserInterrupt+        r <- takeMVar mvar         normalizeSummary r `shouldBe` [             ""           , "- foo FAILED [1]"@@ -159,10 +168,17 @@           ]        it "throws UserInterrupt" $ do-        silence . H.hspec $ do-          H.it "foo" $ do-            E.throwIO E.UserInterrupt :: IO ()-        `shouldThrow` (== E.UserInterrupt)+        mvar <- newEmptyMVar+        sync <- newEmptyMVar+        threadId <- forkIO $ do+          silence . H.hspec $ do+            H.it "foo" $ do+              putMVar sync ()+              threadDelay 1000000+          `E.catch` putMVar mvar+        takeMVar sync+        throwTo threadId E.UserInterrupt+        takeMVar mvar `shouldReturn` E.UserInterrupt      context "with --help" $ do       let printHelp = withProgName "spec" . withArgs ["--help"] . H.hspec $ pure ()
test/Test/Hspec/UtilSpec.hs view
@@ -1,6 +1,7 @@ module Test.Hspec.UtilSpec (main, spec) where  import           Helper+import           Control.Concurrent import qualified Control.Exception as E  import           Test.Hspec.Util@@ -47,8 +48,15 @@       Left e <- safeTry (return undefined)       show e `shouldBe` "Prelude.undefined" -    it "re-throws AsyncException" $ do-      safeTry (E.throwIO E.UserInterrupt :: IO Int) `shouldThrow` (== E.UserInterrupt)+    it "does not catch asynchronous exceptions" $ do+      mvar <- newEmptyMVar+      sync <- newEmptyMVar+      threadId <- forkIO $ do+        safeTry (putMVar sync () >> threadDelay 1000000) >> return ()+        `E.catch` putMVar mvar+      takeMVar sync+      throwTo threadId E.UserInterrupt+      readMVar mvar `shouldReturn` E.UserInterrupt    describe "filterPredicate" $ do     it "tries to match a pattern against a path" $ do
test/Test/HspecSpec.hs view
@@ -137,6 +137,28 @@         silence $ H.hspec $ H.before (return n) $ H.beforeWith action $ do           H.it "foo" $ (`shouldBe` show n) +  describe "beforeAll" $ do+    it "runs an action before the first spec item" $ do+      ref <- newIORef ([] :: [String])+      let append n = modifyIORef ref (++ return n)+      silence $ H.hspec $ H.beforeAll (append "before") $ do+        H.it "foo" $ do+          append "foo"+        H.it "bar" $ do+          append "bar"+      readIORef ref `shouldReturn` [+          "before"+        , "foo"+        , "bar"+        ]++    context "when used with an action that returns a value" $ do+      it "passes that value to the spec item" $ do+        property $ \n -> do+          silence $ H.hspec $ H.beforeAll (return n) $ do+            H.it "foo" $ \m -> do+              m `shouldBe` (n :: Int)+   describe "after" $ do     it "must be used with a before action" $ do       ref <- newIORef ([] :: [String])