packages feed

hspec2 0.2.0 → 0.2.1

raw patch · 14 files changed

+168/−79 lines, 14 filesdep ~QuickCheckdep ~hspec-metadep ~transformers

Dependency ranges changed: QuickCheck, hspec-meta, transformers

Files

+ changelog view
@@ -0,0 +1,1 @@+See https://github.com/hspec/hspec/blob/master/CHANGES.markdown
hspec2.cabal view
@@ -1,5 +1,5 @@ name:             hspec2-version:          0.2.0+version:          0.2.1 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2014 Simon Hengel,@@ -17,8 +17,10 @@                   If you are looking for a stable solution for testing Haskell                   code, use the 1.x series of Hspec: <http://hspec.github.io/> --- find hspec-discover/test-data/ -type f extra-source-files:+  changelog++-- find hspec-discover/test-data/ -type f   hspec-discover/test-data/nested-spec/FooSpec.hs   hspec-discover/test-data/nested-spec/Foo/Bar/BazSpec.hs   hspec-discover/test-data/nested-spec/Foo/BarSpec.hs@@ -41,10 +43,10 @@     , setenv     , ansi-terminal >= 0.5     , time-    , transformers  >= 0.2.2.0 && < 0.4.0+    , transformers  >= 0.2.2.0     , deepseq     , HUnit         >= 1.2.5-    , QuickCheck    >= 2.7+    , QuickCheck    >= 2.5.1     , quickcheck-io     , hspec-expectations == 0.5.0.*   exposed-modules:@@ -79,6 +81,7 @@       Helper       Test.HspecSpec       Test.Hspec.CompatSpec+      Test.Hspec.Core.QuickCheckUtilSpec       Test.Hspec.Core.TypeSpec       Test.Hspec.FailureReportSpec       Test.Hspec.FormattersSpec@@ -105,7 +108,7 @@     , quickcheck-io     , hspec-expectations -    , hspec-meta >= 1.9.0+    , hspec-meta >= 1.9.1     , process     , ghc-paths 
src/Test/Hspec/Compat.hs view
@@ -10,6 +10,10 @@ #endif ) where +#if !MIN_VERSION_base(4,3,0)+import           Control.Monad.Trans.Error () -- for Monad (Either e)+#endif+ import           Data.Typeable (Typeable, typeOf, typeRepTyCon) import           Text.Read import           Data.IORef
src/Test/Hspec/Config.hs view
@@ -12,15 +12,12 @@ import           System.IO import           System.Exit import qualified Test.QuickCheck as QC-import           Test.QuickCheck.Random (mkQCGen) import           Test.Hspec.Formatters  import           Test.Hspec.Util--import           Control.Monad.Trans.Error () -- for Monad (Either e) when base < 4.3- import           Test.Hspec.Options import           Test.Hspec.FailureReport+import           Test.Hspec.Core.QuickCheckUtil (mkGen)  data Config = Config {   configDryRun          :: Bool@@ -105,7 +102,7 @@     setMaxDiscardRatio n args = args {QC.maxDiscardRatio = n}      setSeed :: Integer -> QC.Args -> QC.Args-    setSeed n args = args {QC.replay = Just (mkQCGen (fromIntegral n), 0)}+    setSeed n args = args {QC.replay = Just (mkGen (fromIntegral n), 0)}  getConfig :: Options -> String -> [String] -> IO Config getConfig opts_ prog args = do
src/Test/Hspec/Core/QuickCheckUtil.hs view
@@ -1,7 +1,7 @@+{-# LANGUAGE CPP #-} module Test.Hspec.Core.QuickCheckUtil where  import           Control.Applicative-import           Control.Exception import           Data.Int import           Data.IORef import           Test.QuickCheck hiding (Result(..))@@ -10,11 +10,23 @@ import           Test.QuickCheck.Gen import qualified Test.QuickCheck.Property as QCP import           Test.QuickCheck.IO ()+++#if MIN_VERSION_QuickCheck(2,7,0)+import           Control.Exception import           Test.QuickCheck.Random+#endif+ import           System.Random +import           Test.Hspec.Util+ aroundProperty :: ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property+#if MIN_VERSION_QuickCheck(2,7,0) aroundProperty action p = MkProperty . MkGen $ \r n -> aroundProp action $ \a -> (unGen . unProperty $ p a) r n+#else+aroundProperty action p = MkGen $ \r n -> aroundProp action $ \a -> (unGen $ p a) r n+#endif  aroundProp :: ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop aroundProp action p = MkProp $ aroundRose action (\a -> unProp $ p a)@@ -27,8 +39,32 @@  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 ++ ")"+  where+    shrinks+      | 0 < numShrinks r = " and " ++ pluralize (numShrinks r) "shrink"+      | otherwise = ""+ newSeed :: IO Int-newSeed = fromIntegral <$> (fst . randomR (0, maxBound) <$> newQCGen :: IO Int32)+newSeed = fst . randomR (0, fromIntegral (maxBound :: Int32)) <$>+#if MIN_VERSION_QuickCheck(2,7,0)+  newQCGen+#else+  newStdGen+#endif++#if MIN_VERSION_QuickCheck(2,7,0)+mkGen :: Int -> QCGen+mkGen = mkQCGen+#else+mkGen :: Int -> StdGen+mkGen = mkStdGen+#endif
src/Test/Hspec/Core/Type.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable, TypeFamilies #-}+{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable, TypeFamilies #-} module Test.Hspec.Core.Type (   Spec , SpecWith@@ -153,15 +153,24 @@     return $       case r of         QC.Success {}               -> Success-        QC.Failure {QC.output = m}  -> fromMaybe (Fail $ sanitizeFailureMessage m) (parsePending m)+        QC.Failure {QC.output = m}  -> fromMaybe (Fail $ sanitizeFailureMessage r) (parsePending m)         QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ pluralize n "test" )         QC.NoExpectedFailure {}     -> Fail ("No expected failure")     where       qcProgressCallback = QCP.PostTest QCP.NotCounterexample $         \st _ -> progressCallback (QC.numSuccessTests st, QC.maxSuccessTests st) -      sanitizeFailureMessage :: String -> String-      sanitizeFailureMessage = strip . addFalsifiable . stripFailed+      sanitizeFailureMessage :: QC.Result -> String+      sanitizeFailureMessage r = let m = QC.output r in strip $+#if MIN_VERSION_QuickCheck(2,7,0)+        case QC.theException r of+          Just e -> let numbers = formatNumbers r in+            "uncaught exception: " ++ formatException e ++ " " ++ numbers ++ "\n" ++ case lines m of+              x:xs | x == (exceptionPrefix ++ show e ++ "' " ++ numbers ++ ": ") -> unlines xs+              _ -> m+          Nothing ->+#endif+            (addFalsifiable . stripFailed) m        addFalsifiable :: String -> String       addFalsifiable m@@ -178,11 +187,12 @@        parsePending :: String -> Maybe Result       parsePending m-        | prefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m+        | exceptionPrefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m         | otherwise = Nothing         where-          n = length prefix-          prefix = "*** Failed! Exception: '"+          n = length exceptionPrefix++      exceptionPrefix = "*** Failed! Exception: '"  -- | Specifies a pending example. --
src/Test/Hspec/Formatters.hs view
@@ -61,11 +61,9 @@  import           Data.Maybe import           Test.Hspec.Util-import           Test.Hspec.Compat import           Text.Printf import           Control.Monad (unless, forM_) import           Control.Applicative-import qualified Control.Exception as E import           System.IO (hPutStr, hFlush)  -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make@@ -200,17 +198,6 @@           writeLine err       where         err = either (("uncaught exception: " ++) . formatException) id reason---- | Convert an exception to a string.------ The type of the exception is included.  Here is an example:------ >>> import Control.Applicative--- >>> import Control.Exception--- >>> either formatException show <$> (try . evaluate) (1 `div` 0)--- "ArithException (divide by zero)"-formatException :: E.SomeException -> String-formatException (E.SomeException e) = showType e ++ " (" ++ show e ++ ")"  defaultFooter :: FormatM () defaultFooter = do
src/Test/Hspec/Options.hs view
@@ -11,13 +11,10 @@ import           Data.List import           System.Exit import           System.Console.GetOpt-import           Test.Hspec.Formatters +import           Test.Hspec.Formatters import           Test.Hspec.Compat import           Test.Hspec.Util---- for Monad (Either e) when base < 4.3-import           Control.Monad.Trans.Error ()  data Options = Options {   optionsDryRun       :: Bool
src/Test/Hspec/Runner/Tree.hs view
@@ -3,8 +3,8 @@ import           Test.Hspec.Core.Type  data Tree a-  = Node String [Tree a]-  | Leaf String a+  = Node !String [Tree a]+  | Leaf !String a   deriving (Eq, Show)  instance Functor Tree where
src/Test/Hspec/Util.hs view
@@ -1,5 +1,6 @@ module Test.Hspec.Util (   pluralize+, formatException , lineBreaksAt , safeTry , Path@@ -13,6 +14,8 @@ import           Control.Applicative import qualified Control.Exception as E +import           Test.Hspec.Compat (showType)+ -- | Create a more readable display of a quantity of something. -- -- Examples:@@ -28,6 +31,17 @@ pluralize :: Int -> String -> String pluralize 1 s = "1 " ++ s pluralize n s = show n ++ " " ++ s ++ "s"++-- | Convert an exception to a string.+--+-- The type of the exception is included.  Here is an example:+--+-- >>> import Control.Applicative+-- >>> import Control.Exception+-- >>> either formatException show <$> (try . evaluate) (1 `div` 0)+-- "ArithException (divide by zero)"+formatException :: E.SomeException -> String+formatException (E.SomeException e) = showType e ++ " (" ++ show e ++ ")"  safeTry :: IO a -> IO (Either E.SomeException a) safeTry action = (Right <$> (action >>= E.evaluate)) `E.catches` [
test/Helper.hs view
@@ -34,11 +34,11 @@  import           Test.Hspec.Meta import           Test.QuickCheck hiding (Result(..))-import           Test.QuickCheck.Random  import qualified Test.Hspec as H import qualified Test.Hspec.Core as H (Params(..), Item(..), ProgressCallback, mapSpecItem) import qualified Test.Hspec.Runner as H+import           Test.Hspec.Core.QuickCheckUtil (mkGen)  ignoreExitCode :: IO () -> IO () ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return ()@@ -65,7 +65,7 @@         | otherwise  = x  defaultParams :: H.Params-defaultParams = H.Params stdArgs {replay = Just (mkQCGen 23, 0)} (H.configSmallCheckDepth H.defaultConfig)+defaultParams = H.Params stdArgs {replay = Just (mkGen 23, 0)} (H.configSmallCheckDepth H.defaultConfig)  noOpProgressCallback :: H.ProgressCallback noOpProgressCallback _ = return ()
+ test/Test/Hspec/Core/QuickCheckUtilSpec.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+module Test.Hspec.Core.QuickCheckUtilSpec (main, spec) where++import           Helper++import           Test.QuickCheck+import           Test.Hspec.Core.QuickCheckUtil++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "formatNumbers" $ do+    it "includes number of tests" $ do+      formatNumbers (failure 1 0) `shouldBe` "(after 1 test)"++    it "pluralizes number of tests" $ do+      formatNumbers (failure 3 0) `shouldBe` "(after 3 tests)"++    it "includes number of shrinks" $ do+      formatNumbers (failure 3 1) `shouldBe` "(after 3 tests and 1 shrink)"++    it "pluralizes number of shrinks" $ do+      formatNumbers (failure 3 3) `shouldBe` "(after 3 tests and 3 shrinks)"+  where+    failure tests shrinks = Failure {+      numTests = tests+    , numShrinks = shrinks+    }
test/Test/Hspec/Core/TypeSpec.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP, TypeFamilies #-} module Test.Hspec.Core.TypeSpec (main, spec) where  import           Helper@@ -73,7 +73,11 @@       it "shows what falsified it" $ do         H.Fail r <- evaluateExample $ property $ \x y -> x + y == (x * y :: Int)         r `shouldBe` intercalate "\n" [+#if MIN_VERSION_QuickCheck(2,7,0)             "Falsifiable (after 2 tests and 2 shrinks): "+#else+            "Falsifiable (after 1 test and 3 shrinks): "+#endif           , "0"           , "1"           ]@@ -89,24 +93,35 @@         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"+        evaluateExample (property $ (error "foobar" :: Int -> Bool)) `shouldReturn` (H.Fail . intercalate "\n") [+#if MIN_VERSION_QuickCheck(2,7,0)+            "uncaught exception: ErrorCall (foobar) (after 1 test)"+#else+            "Exception: 'foobar' (after 1 test and 2 shrinks): "+#endif+          , "0"+          ]+       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" [+#if MIN_VERSION_QuickCheck(2,7,0)               "Falsifiable (after 2 tests and 2 shrinks): "+#else+              "Falsifiable (after 1 test and 3 shrinks): "+#endif             , "expected: 0"             , " but got: 1"             , "0"             , "1"             ]--      it "propagates UserInterrupt" $ do-        let p = property (throwIO UserInterrupt :: Expectation)-        evaluateExample p `shouldThrow` (== UserInterrupt)--      it "propagates exceptions" $ do-        pendingWith "this probably needs a patch to QuickCheck"-        -- evaluateExample (property $ (error "foobar" :: Int -> Bool)) `shouldThrow` errorCall "foobar"        context "when used with `pending`" $ do         it "returns Pending" $ do
test/Test/Hspec/RunnerSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Test.Hspec.RunnerSpec (main, spec) where  import           Helper@@ -24,6 +25,22 @@ quickCheckOptions :: [([Char], Args -> Int)] quickCheckOptions = [("--qc-max-success", QC.maxSuccess), ("--qc-max-size", QC.maxSize), ("--qc-max-discard", QC.maxDiscardRatio)] +prop_foo :: Integer -> Bool+prop_foo = (/= 26)++runPropFoo :: [String] -> IO String+runPropFoo args = fmap (unlines . normalizeSummary . lines) . capture_ . ignoreExitCode . withArgs args . H.hspec $ H.it "foo" $ property prop_foo++prop_foo_result_with_seed_42 :: String+prop_foo_result_with_seed_42 = unlines [+#if MIN_VERSION_QuickCheck(2,7,0)+            "Falsifiable (after 31 tests): "+#else+            "Falsifiable (after 30 tests): "+#endif+          , "26"+          ]+ spec :: Spec spec = do   describe "hspec" $ do@@ -86,18 +103,8 @@         r1 `shouldSatisfy` elem "3 examples, 3 failures"        it "reuses the same seed" $ do-        let runSpec_ = (captureLines . ignoreExitCode . H.hspec) $ do-              H.it "foo" $ property $ (/= (26 :: Integer))-        r0 <- withArgs ["--seed", "42"] runSpec_-        r0 `shouldContain` [-            "Falsifiable (after 31 tests): "-          , "26"-          ]-        r1 <- withArgs ["-r"] runSpec_-        r1 `shouldContain` [-            "Falsifiable (after 31 tests): "-          , "26"-          ]+        r <- runPropFoo ["--seed", "42"]+        runPropFoo ["-r"] `shouldReturn` r        forM_ quickCheckOptions $ \(flag, accessor) -> do         it ("reuses same " ++ flag) $ do@@ -292,27 +299,14 @@      context "with --seed" $ do       it "uses specified seed" $ do-        r <- captureLines . ignoreExitCode . withArgs ["--seed", "42"] . H.hspec $ do-            H.it "foo" $-              property (/= (26 :: Integer))-        r `shouldContain` [-            "Falsifiable (after 31 tests): "-          , "26"-          ]+        r <- runPropFoo ["--seed", "42"]+        r `shouldContain` prop_foo_result_with_seed_42        context "when run with --rerun" $ do         it "takes precedence" $ do-          let runSpec args = capture_ . ignoreExitCode . withArgs args . H.hspec $ do-                H.it "foo" $-                  property $ \n -> ((17 + 31 * n) `mod` 50) /= (23 :: Integer)-          r0 <- runSpec ["--seed", "23"]-          r0 `shouldContain` "(after 27 tests)"--          r1 <- runSpec ["--seed", "42"]-          r1 `shouldContain` "(after 31 tests)"--          r2 <- runSpec ["--rerun", "--seed", "23"]-          r2 `shouldContain` "(after 27 tests)"+          r <- runPropFoo ["--seed", "23"]+          _ <- runPropFoo ["--seed", "42"]+          runPropFoo ["--rerun", "--seed", "23"] `shouldReturn` r        context "when given an invalid argument" $ do         let run = withArgs ["--seed", "foo"] . H.hspec $ do