hspec2 0.1.1 → 0.2.0
raw patch · 10 files changed
+80/−107 lines, 10 filesdep +tf-randomdep ~QuickCheckdep ~hspec-metadep ~random
Dependencies added: tf-random
Dependency ranges changed: QuickCheck, hspec-meta, random
Files
- hspec2.cabal +7/−5
- src/Test/Hspec/Config.hs +28/−21
- src/Test/Hspec/Core/QuickCheckUtil.hs +16/−13
- src/Test/Hspec/Core/Type.hs +1/−1
- src/Test/Hspec/Runner.hs +14/−15
- src/Test/Hspec/Util.hs +0/−18
- test/Helper.hs +2/−1
- test/Test/Hspec/Core/TypeSpec.hs +4/−4
- test/Test/Hspec/RunnerSpec.hs +8/−10
- test/Test/Hspec/UtilSpec.hs +0/−19
hspec2.cabal view
@@ -1,5 +1,5 @@ name: hspec2-version: 0.1.1+version: 0.2.0 license: MIT license-file: LICENSE copyright: (c) 2011-2014 Simon Hengel,@@ -36,14 +36,15 @@ src build-depends: base == 4.*- , random == 1.0.*+ , random+ , tf-random , setenv , ansi-terminal >= 0.5 , time , transformers >= 0.2.2.0 && < 0.4.0 , deepseq , HUnit >= 1.2.5- , QuickCheck >= 2.5.1+ , QuickCheck >= 2.7 , quickcheck-io , hspec-expectations == 0.5.0.* exposed-modules:@@ -91,7 +92,8 @@ -Wall -Werror build-depends: base == 4.*- , random == 1.0.*+ , random+ , tf-random , setenv , silently >= 1.2.4 , ansi-terminal@@ -103,7 +105,7 @@ , quickcheck-io , hspec-expectations - , hspec-meta >= 1.8.0+ , hspec-meta >= 1.9.0 , process , ghc-paths
src/Test/Hspec/Config.hs view
@@ -3,7 +3,7 @@ , defaultConfig , getConfig , configAddFilter-, configSetSeed+, configQuickCheckArgs ) where import Control.Applicative@@ -12,12 +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 --- for Monad (Either e) when base < 4.3-import Control.Monad.Trans.Error ()+import Control.Monad.Trans.Error () -- for Monad (Either e) when base < 4.3 import Test.Hspec.Options import Test.Hspec.FailureReport@@ -31,7 +31,10 @@ -- 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)-, configQuickCheckArgs :: QC.Args+, configQuickCheckSeed :: Maybe Integer+, configQuickCheckMaxSuccess :: Maybe Int+, configQuickCheckMaxDiscardRatio :: Maybe Int+, configQuickCheckMaxSize :: Maybe Int , configSmallCheckDepth :: Int , configColorMode :: ColorMode , configFormatter :: Formatter@@ -40,7 +43,7 @@ } defaultConfig :: Config-defaultConfig = Config False False False Nothing QC.stdArgs 5 ColorAuto specdoc False (Left stdout)+defaultConfig = Config False False False Nothing Nothing Nothing Nothing Nothing 5 ColorAuto specdoc False (Left stdout) -- | Add a filter predicate to config. If there is already a filter predicate, -- then combine them with `||`.@@ -54,16 +57,16 @@ (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path _ -> p1_ <|> p2_ -configSetSeed :: Integer -> Config -> Config-configSetSeed n c = c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.replay = Just (stdGenFromInteger n, 0)}}- mkConfig :: Maybe FailureReport -> Options -> Config mkConfig mFailureReport opts = Config { configDryRun = optionsDryRun opts , configPrintCpuTime = optionsPrintCpuTime opts , configFastFail = optionsFastFail opts , configFilterPredicate = matchFilter `filterOr` rerunFilter- , configQuickCheckArgs = qcArgs+ , configQuickCheckSeed = mSeed+ , configQuickCheckMaxSuccess = mMaxSuccess+ , configQuickCheckMaxDiscardRatio = mMaxDiscardRatio+ , configQuickCheckMaxSize = mMaxSize , configSmallCheckDepth = fromMaybe (configSmallCheckDepth defaultConfig) (optionsDepth opts) , configColorMode = optionsColorMode opts , configFormatter = optionsFormatter opts@@ -71,17 +74,27 @@ , configHandle = maybe (configHandle defaultConfig) Right (optionsOutputFile opts) } where- qcArgs = (- maybe id setSeed mSeed- . maybe id setMaxDiscardRatio mMaxDiscardRatio- . maybe id setMaxSize mMaxSize- . maybe id setMaxSuccess mMaxSuccess) QC.stdArgs mSeed = optionsSeed opts <|> (failureReportSeed <$> mFailureReport) mMaxSuccess = optionsMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport) mMaxSize = optionsMaxSize opts <|> (failureReportMaxSize <$> mFailureReport) mMaxDiscardRatio = optionsMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport) + matchFilter = case optionsMatch opts of+ [] -> Nothing+ xs -> Just $ foldl1' (\p0 p1 path -> p0 path || p1 path) (map filterPredicate xs)++ rerunFilter = flip elem . failureReportPaths <$> mFailureReport++configQuickCheckArgs :: Config -> QC.Args+configQuickCheckArgs c = qcArgs+ where+ qcArgs = (+ maybe id setSeed (configQuickCheckSeed c)+ . maybe id setMaxDiscardRatio (configQuickCheckMaxDiscardRatio c)+ . maybe id setMaxSize (configQuickCheckMaxSize c)+ . maybe id setMaxSuccess (configQuickCheckMaxSuccess c)) QC.stdArgs+ setMaxSuccess :: Int -> QC.Args -> QC.Args setMaxSuccess n args = args {QC.maxSuccess = n} @@ -92,13 +105,7 @@ setMaxDiscardRatio n args = args {QC.maxDiscardRatio = n} setSeed :: Integer -> QC.Args -> QC.Args- setSeed n args = args {QC.replay = Just (stdGenFromInteger n, 0)}-- matchFilter = case optionsMatch opts of- [] -> Nothing- xs -> Just $ foldl1' (\p0 p1 path -> p0 path || p1 path) (map filterPredicate xs)-- rerunFilter = flip elem . failureReportPaths <$> mFailureReport+ setSeed n args = args {QC.replay = Just (mkQCGen (fromIntegral n), 0)} getConfig :: Options -> String -> [String] -> IO Config getConfig opts_ prog args = do
src/Test/Hspec/Core/QuickCheckUtil.hs view
@@ -1,16 +1,20 @@-{-# LANGUAGE CPP #-} module Test.Hspec.Core.QuickCheckUtil where -import Data.IORef-import Test.QuickCheck hiding (Result(..))-import Test.QuickCheck as QC-import Test.QuickCheck.Property hiding (Result(..))-import Test.QuickCheck.Gen+import Control.Applicative+import Control.Exception+import Data.Int+import Data.IORef+import Test.QuickCheck hiding (Result(..))+import Test.QuickCheck as QC+import Test.QuickCheck.Property hiding (Result(..))+import Test.QuickCheck.Gen import qualified Test.QuickCheck.Property as QCP-import Test.QuickCheck.IO ()+import Test.QuickCheck.IO ()+import Test.QuickCheck.Random+import System.Random aroundProperty :: ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property-aroundProperty action p = MkGen $ \r n -> aroundProp action $ \a -> (unGen $ p a) r n+aroundProperty action p = MkProperty . MkGen $ \r n -> aroundProp action $ \a -> (unGen . unProperty $ p a) r n aroundProp :: ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop aroundProp action p = MkProp $ aroundRose action (\a -> unProp $ p a)@@ -23,9 +27,8 @@ 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+ QC.Failure {theException = me} -> (me >>= fromException) == Just UserInterrupt _ -> False++newSeed :: IO Int+newSeed = fromIntegral <$> (fst . randomR (0, maxBound) <$> newQCGen :: IO Int32)
src/Test/Hspec/Core/Type.hs view
@@ -89,7 +89,7 @@ , itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result } --- | An `IO` action that expects an argument of type a.+-- | An `IO` action that expects an argument of type @a@. type ActionWith a = a -> IO () mapSpecItem :: (Item a -> Item b) -> SpecWith a -> SpecWith b
src/Test/Hspec/Runner.hs view
@@ -29,16 +29,16 @@ import System.Console.ANSI (hHideCursor, hShowCursor) import qualified Test.QuickCheck as QC-import System.Random (newStdGen) import Control.Monad.IO.Class (liftIO) import Test.Hspec.Compat (lookupEnv)-import Test.Hspec.Util (Path, stdGenToInteger)+import Test.Hspec.Util (Path) import Test.Hspec.Core.Type import Test.Hspec.Config import Test.Hspec.Formatters import Test.Hspec.Formatters.Internal import Test.Hspec.FailureReport+import Test.Hspec.Core.QuickCheckUtil import Test.Hspec.Options (Options(..), ColorMode(..), defaultOptions) import Test.Hspec.Runner.Tree@@ -70,16 +70,14 @@ f <- toFormatter formatter hspecWithOptions defaultOptions {optionsFormatter = f} spec --- Add a StdGen to configQuickCheckArgs if there is none. That way the same--- seed is used for all properties. This helps with --seed and --rerun.-ensureStdGen :: Config -> IO Config-ensureStdGen c = case QC.replay qcArgs of+-- Add a seed to given config if there is none. That way the same seed is used+-- for all properties. This helps with --seed and --rerun.+ensureSeed :: Config -> IO Config+ensureSeed c = case configQuickCheckSeed c of Nothing -> do- stdGen <- newStdGen- return c {configQuickCheckArgs = qcArgs {QC.replay = Just (stdGen, 0)}}+ seed <- newSeed+ return c {configQuickCheckSeed = Just (fromIntegral seed)} _ -> return c- where- qcArgs = configQuickCheckArgs c -- | Run given spec with custom options. -- This is similar to `hspec`, but more flexible.@@ -107,9 +105,10 @@ -- accordingly. hspecWith :: Config -> Spec -> IO Summary hspecWith c_ spec_ = withHandle c_ $ \h -> do- c <- ensureStdGen c_+ c <- ensureSeed c_ let formatter = configFormatter c- seed = (stdGenToInteger . fst . fromJust . QC.replay . configQuickCheckArgs) c+ seed = (fromJust . configQuickCheckSeed) c+ qcArgs = configQuickCheckArgs c spec | configDryRun c = mapSpecItem markSuccess spec_ | otherwise = spec_@@ -127,9 +126,9 @@ xs <- map failureRecordPath <$> getFailMessages liftIO $ writeFailureReport FailureReport { failureReportSeed = seed- , failureReportMaxSuccess = QC.maxSuccess (configQuickCheckArgs c)- , failureReportMaxSize = QC.maxSize (configQuickCheckArgs c)- , failureReportMaxDiscardRatio = QC.maxDiscardRatio (configQuickCheckArgs c)+ , failureReportMaxSuccess = QC.maxSuccess qcArgs+ , failureReportMaxSize = QC.maxSize qcArgs+ , failureReportMaxDiscardRatio = QC.maxDiscardRatio qcArgs , failureReportPaths = xs }
src/Test/Hspec/Util.hs view
@@ -6,16 +6,12 @@ , filterPredicate , formatRequirement , strip-, stdGenToInteger-, stdGenFromInteger ) where -import Data.Int (Int32) import Data.List import Data.Char (isSpace) import Control.Applicative import qualified Control.Exception as E-import System.Random (StdGen) -- | Create a more readable display of a quantity of something. --@@ -90,17 +86,3 @@ strip :: String -> String strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse---- | Converts a 'StdGen' into an 'Integer'. Assumes--- StdGens to be encoded as two positive 'Int32's and--- $show (StdGen a b) = show a ++ " " ++ show b$.-stdGenToInteger :: StdGen -> Integer-stdGenToInteger stdGen =- let [a, b] = map read . words $ show stdGen- in b * fromIntegral (maxBound :: Int32) + a---- | Inverse of 'stdGenToInteger'.-stdGenFromInteger :: Integer -> StdGen-stdGenFromInteger n =- let (a, b) = quotRem n (fromIntegral (maxBound :: Int32))- in read (show b ++ " " ++ show a)
test/Helper.hs view
@@ -34,6 +34,7 @@ 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)@@ -64,7 +65,7 @@ | otherwise = x defaultParams :: H.Params-defaultParams = H.Params (H.configQuickCheckArgs H.defaultConfig) (H.configSmallCheckDepth H.defaultConfig)+defaultParams = H.Params stdArgs {replay = Just (mkQCGen 23, 0)} (H.configSmallCheckDepth H.defaultConfig) noOpProgressCallback :: H.ProgressCallback noOpProgressCallback _ = return ()
test/Test/Hspec/Core/TypeSpec.hs view
@@ -15,10 +15,10 @@ main = hspec spec evaluateExample :: (H.Example e, H.Arg e ~ ()) => e -> IO H.Result-evaluateExample e = H.evaluateExample e (defaultParams {H.paramsQuickCheckArgs = (H.paramsQuickCheckArgs defaultParams) {replay = Just (read "", 0)}}) ($ ()) noOpProgressCallback+evaluateExample e = H.evaluateExample e defaultParams ($ ()) noOpProgressCallback evaluateExampleWith :: (H.Example e, H.Arg e ~ ()) => (IO () -> IO ()) -> e -> IO H.Result-evaluateExampleWith action e = H.evaluateExample e (defaultParams {H.paramsQuickCheckArgs = (H.paramsQuickCheckArgs defaultParams) {replay = Just (read "", 0)}}) (action . ($ ())) noOpProgressCallback+evaluateExampleWith action e = H.evaluateExample e defaultParams (action . ($ ())) noOpProgressCallback spec :: Spec spec = do@@ -73,7 +73,7 @@ it "shows what falsified it" $ do H.Fail r <- evaluateExample $ property $ \x y -> x + y == (x * y :: Int) r `shouldBe` intercalate "\n" [- "Falsifiable (after 1 test and 2 shrinks): "+ "Falsifiable (after 2 tests and 2 shrinks): " , "0" , "1" ]@@ -93,7 +93,7 @@ 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): "+ "Falsifiable (after 2 tests and 2 shrinks): " , "expected: 0" , " but got: 1" , "0"
test/Test/Hspec/RunnerSpec.hs view
@@ -88,16 +88,14 @@ it "reuses the same seed" $ do let runSpec_ = (captureLines . ignoreExitCode . H.hspec) $ do H.it "foo" $ property $ (/= (26 :: Integer))-- r0 <- withArgs ["--seed", "2413421499272008081"] runSpec_+ r0 <- withArgs ["--seed", "42"] runSpec_ r0 `shouldContain` [- "Falsifiable (after 66 tests): "+ "Falsifiable (after 31 tests): " , "26" ]- r1 <- withArgs ["-r"] runSpec_ r1 `shouldContain` [- "Falsifiable (after 66 tests): "+ "Falsifiable (after 31 tests): " , "26" ] @@ -294,11 +292,11 @@ context "with --seed" $ do it "uses specified seed" $ do- r <- captureLines . ignoreExitCode . withArgs ["--seed", "2413421499272008081"] . H.hspec $ do+ r <- captureLines . ignoreExitCode . withArgs ["--seed", "42"] . H.hspec $ do H.it "foo" $ property (/= (26 :: Integer)) r `shouldContain` [- "Falsifiable (after 66 tests): "+ "Falsifiable (after 31 tests): " , "26" ] @@ -308,13 +306,13 @@ H.it "foo" $ property $ \n -> ((17 + 31 * n) `mod` 50) /= (23 :: Integer) r0 <- runSpec ["--seed", "23"]- r0 `shouldContain` "(after 88 tests)"+ r0 `shouldContain` "(after 27 tests)" r1 <- runSpec ["--seed", "42"]- r1 `shouldContain` "(after 48 tests)"+ r1 `shouldContain` "(after 31 tests)" r2 <- runSpec ["--rerun", "--seed", "23"]- r2 `shouldContain` "(after 88 tests)"+ r2 `shouldContain` "(after 27 tests)" context "when given an invalid argument" $ do let run = withArgs ["--seed", "foo"] . H.hspec $ do
test/Test/Hspec/UtilSpec.hs view
@@ -1,9 +1,6 @@-{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.UtilSpec (main, spec) where import Helper-import Data.Int (Int32)-import System.Random (StdGen) import qualified Control.Exception as E import Test.Hspec.Util@@ -90,19 +87,3 @@ it "properly handles context after a subject that consists of several components" $ do formatRequirement (["Data", "List", "reverse", "when applied twice"], "reverses a list") `shouldBe` "Data.List.reverse, when applied twice, reverses a list"-- describe "stdGenToInteger" $ do- it "is inverse to stdGenFromInteger" $ property $- \(NonNegative i) -> (stdGenToInteger . stdGenFromInteger) i `shouldBe` i-- describe "stdGenFromInteger" $ do- it "is inverse to stdGenToInteger" $ property $- \stdGen -> (stdGenFromInteger . stdGenToInteger) stdGen `shouldBe` stdGen--instance Eq StdGen where- a == b = show a == show b--instance Arbitrary StdGen where- arbitrary = do- (Positive a, Positive b) <- arbitrary- return $ read (show (a :: Int32) ++ " " ++ show (b :: Int32))