packages feed

hspec-meta 1.5.1 → 1.5.2

raw patch · 8 files changed

+153/−53 lines, 8 filesdep +deepseqdep +randomPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, random

API changes (from Hackage documentation)

Files

hspec-meta.cabal view
@@ -1,5 +1,5 @@ name:             hspec-meta-version:          1.5.1+version:          1.5.2 license:          BSD3 license-file:     LICENSE copyright:        (c) 2011-2013 Simon Hengel, (c) 2011-2012 Trystan Spangler, (c) 2011 Greg Weber@@ -46,10 +46,12 @@       src   build-depends:       base          == 4.*+    , random        == 1.0.*     , setenv     , ansi-terminal >= 0.5     , time     , transformers  >= 0.2.2.0 && < 0.4.0+    , deepseq     , HUnit         >= 1.2.5     , QuickCheck    >= 2.5.1     , quickcheck-io
src/Test/Hspec/Config.hs view
@@ -4,6 +4,10 @@ , defaultConfig , getConfig , configAddFilter+, configSetSeed++-- exported to silence warnings+, Arg (..) ) where  import           Control.Monad (unless)@@ -69,37 +73,58 @@     p  = maybe p1 (\p0 path -> p0 path || p1 path) mp     mp = configFilterPredicate c -setQC_MaxSuccess :: String -> Result -> Result-setQC_MaxSuccess n x = (\c -> c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.maxSuccess = read n}}) <$> x+setMaxSuccess :: Int -> Config -> Config+setMaxSuccess n c = c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.maxSuccess = n}} +configSetSeed :: Integer -> Config -> Config+configSetSeed n c = c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.replay = Just (stdGenFromInteger n, 0)}}+++data Arg a = Arg {+  argumentName   :: String+, argumentParser :: String -> Maybe a+, argumentSetter :: a -> Config -> Config+}++mkOption :: [Char] -> [Char] -> Arg a -> String -> OptDescr (Result -> Result)+mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help+  where+    arg :: String -> Result -> Result+    arg input x = x >>= \c -> case parser input of+      Just n -> Right (setter n c)+      Nothing -> Left (InvalidArgument name input)+ addLineBreaks :: String -> [String] addLineBreaks = lineBreaksAt 44  options :: [OptDescr (Result -> Result)] options = [-    Option []  ["help"]                    (NoArg (const $ Left Help))        (h "display this help and exit")-  , Option "m" ["match"]                   (ReqArg setFilter "PATTERN")       (h "only run examples that match given PATTERN")-  , Option []  ["color"]                   (OptArg setColor "WHEN")           (h "colorize the output; WHEN defaults to `always' or can be `never' or `auto'")-  , Option "f" ["format"]                  (ReqArg setFormatter "FORMATTER")  formatHelp-  , Option "a" ["qc-max-success"]          (ReqArg setQC_MaxSuccess "N")      (h "maximum number of successful tests before a QuickCheck property succeeds")-  , Option []  ["print-cpu-time"]          (NoArg setPrintCpuTime)            (h "include used CPU time in summary")-  , 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   []  ["help"]             (NoArg (const $ Left Help))         (h "display this help and exit")+  , mkOption "m"  "match"             (Arg "PATTERN" return setFilter)    (h "only run examples that match given PATTERN")+  , Option   []  ["color"]            (OptArg setColor "WHEN")            (h "colorize the output; WHEN defaults to `always' or can be `never' or `auto'")+  , mkOption "f"  "format"            (Arg "FORMATTER" readFormatter setFormatter) formatHelp+  , mkOption "a"  "qc-max-success"    (Arg "N" readMaybe setMaxSuccess)   (h "maximum number of successful tests before a QuickCheck property succeeds")+  , mkOption []   "seed"              (Arg "N" readMaybe configSetSeed)   (h "used seed for QuickCheck properties")+  , Option   []  ["print-cpu-time"]   (NoArg setPrintCpuTime)             (h "include used CPU time in summary")+  , Option   []  ["dry-run"]          (NoArg setDryRun)                   (h "pretend that everything passed; don't verify anything")+  , Option   []  ["fail-fast"]        (NoArg setFastFail)                 (h "abort on first failure")   ]   where     h = unlines . addLineBreaks -    setFilter :: String -> Result -> Result-    setFilter pattern x = configAddFilter (filterPredicate pattern) <$> x+    setFilter :: String -> Config -> Config+    setFilter = configAddFilter . filterPredicate +    readFormatter :: String -> Maybe Formatter+    readFormatter = (`lookup` formatters)++    setFormatter :: Formatter -> Config -> Config+    setFormatter f c = c {configFormatter = f}+     setPrintCpuTime x = x >>= \c -> return c {configPrintCpuTime = True}     setDryRun       x = x >>= \c -> return c {configDryRun       = True}     setFastFail     x = x >>= \c -> return c {configFastFail     = True} -    setFormatter name x = x >>= \c -> case lookup name formatters of-      Nothing -> Left (InvalidArgument "format" name)-      Just f  -> return c {configFormatter = f}-     setColor mValue x = x >>= \c -> parseColor mValue >>= \v -> return c {configColorMode = v}       where         parseColor s = case s of@@ -114,7 +139,7 @@     Option "r" ["re-run"]                  (NoArg  setReRun)                  "only re-run examples that previously failed"      -- for compatibility with test-framework-  , Option ""  ["maximum-generated-tests"] (ReqArg setQC_MaxSuccess "NUMBER") "how many automated tests something like QuickCheck should try, by default"+  , mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default"      -- undocumented for now, as we probably want to change this to produce a     -- standalone HTML report in the future
src/Test/Hspec/Core/Type.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.Core.Type (   Spec , SpecM (..)@@ -13,6 +12,7 @@  , describe , it+, forceResult  , pending , pendingWith@@ -35,6 +35,7 @@ import qualified Test.QuickCheck.IO ()  import           Test.Hspec.Compat (isUserInterrupt)+import           Control.DeepSeq (deepseq)   type Spec = SpecM ()@@ -54,6 +55,12 @@ -- | The result of running an example. data Result = Success | Pending (Maybe String) | Fail String   deriving (Eq, Show, Read, Typeable)++forceResult :: Result -> Result+forceResult r = case r of+  Success   -> r `seq` r+  Pending m -> r `seq` m `deepseq` r+  Fail    m -> r `seq` m `deepseq` r  instance E.Exception Result
src/Test/Hspec/FailureReport.hs view
@@ -1,16 +1,21 @@-module Test.Hspec.FailureReport where+module Test.Hspec.FailureReport (+  writeFailureReport+, readFailureReport+) where  import           System.IO import           System.SetEnv+import qualified Test.QuickCheck as QC import           Test.Hspec.Config-import           Test.Hspec.Util (safeEvaluate, readMaybe, getEnv)+import           Test.Hspec.Util (Path, safeTry, readMaybe, getEnv) -writeFailureReport :: String -> IO ()+type Seed = Integer++writeFailureReport :: (Seed, [Path]) -> IO () writeFailureReport x = do   -- on Windows this can throw an exception when the input is too large, hence-  -- we use `safeEvaluate` here-  r <- safeEvaluate (setEnv "HSPEC_FAILURES" x)-  either onError return r+  -- we use `safeTry` here+  safeTry (setEnv "HSPEC_FAILURES" $ show x) >>= either onError return   where     onError err = do       hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")")@@ -22,5 +27,12 @@     Nothing -> do       hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--re-run' is ignored!"       return c-    Just xs -> do-      return $ configAddFilter (`elem` xs) c+    Just (seed, xs) -> do+      (return . setSeed seed . configAddFilter (`elem` xs)) c++setSeed :: Seed -> Config -> Config+setSeed seed c+  | hasSeed = c+  | otherwise = configSetSeed seed c+  where+    hasSeed = maybe False (const True) (QC.replay $ configQuickCheckArgs c)
src/Test/Hspec/Formatters.hs view
@@ -29,6 +29,7 @@  , FailureRecord (..) , getFailMessages+, usedSeed  , getCPUTime , getRealTime@@ -72,6 +73,7 @@    , FailureRecord (..)   , getFailMessages+  , usedSeed    , getCPUTime   , getRealTime@@ -161,6 +163,8 @@    forM_ (zip [1..] failures) $ \x -> do     formatFailure x+    writeLine ""+    write "Randomized with seed " >> usedSeed >>= writeLine . show     writeLine ""   where     formatFailure :: (Int, FailureRecord) -> FormatM ()
src/Test/Hspec/Formatters/Internal.hs view
@@ -12,6 +12,7 @@  , FailureRecord (..) , getFailMessages+, usedSeed  , getCPUTime , getRealTime@@ -76,10 +77,15 @@ , pendingCount    :: Int , failCount       :: Int , failMessages    :: [FailureRecord]+, stateUsedSeed   :: Integer , cpuStartTime    :: Maybe Integer , startTime       :: POSIXTime } +-- | The random seed that is used for QuickCheck.+usedSeed :: FormatM Integer+usedSeed = gets stateUsedSeed+ -- | The total number of examples encountered so far. totalCount :: FormatterState -> Int totalCount s = successCount s + pendingCount s + failCount s@@ -89,11 +95,11 @@ newtype FormatM a = FormatM (StateT (IORef FormatterState) IO a)   deriving (Functor, Applicative, Monad) -runFormatM :: Bool -> Bool -> Bool -> Handle -> FormatM a -> IO a-runFormatM useColor produceHTML_ printCpuTime handle (FormatM action) = do+runFormatM :: Bool -> Bool -> Bool -> Integer -> Handle -> FormatM a -> IO a+runFormatM useColor produceHTML_ printCpuTime seed handle (FormatM action) = do   time <- getPOSIXTime   cpuTime <- if printCpuTime then Just <$> CPUTime.getCPUTime else pure Nothing-  st <- newIORef (FormatterState handle useColor produceHTML_ False 0 0 0 [] cpuTime time)+  st <- newIORef (FormatterState handle useColor produceHTML_ False 0 0 0 [] seed cpuTime time)   evalStateT action st  -- | Increase the counter for successful examples
src/Test/Hspec/Runner.hs view
@@ -21,14 +21,18 @@ import           System.IO import           System.Environment import           System.Exit+import qualified Control.Exception as E -import           Test.Hspec.Util (Path, safeEvaluate)+import           System.Console.ANSI (hHideCursor, hShowCursor)+import qualified Test.QuickCheck as QC+import           System.Random (newStdGen)++import           Test.Hspec.Util import           Test.Hspec.Core.Type import           Test.Hspec.Config import           Test.Hspec.Formatters import           Test.Hspec.Formatters.Internal import           Test.Hspec.FailureReport-import           System.Console.ANSI (hHideCursor, hShowCursor) import           Test.Hspec.Timer  -- | Filter specs by given predicate.@@ -60,9 +64,10 @@       unless (configFastFail c && fails /= 0) $ do         xs `each` f +    eval :: IO Result -> FormatM (Either E.SomeException Result)     eval       | configDryRun c = \_ -> return (Right Success)-      | otherwise      = liftIO . safeEvaluate+      | otherwise      = liftIO . safeTry . fmap forceResult      go :: [String] -> (Int, SpecTree) -> FormatM ()     go rGroups (n, SpecGroup group xs) = do@@ -110,6 +115,25 @@     r <- hspecWith c spec     unless (summaryFailures r == 0) exitFailure +handleReRun :: Config -> IO Config+handleReRun c = do+  if configReRun c+    then do+      readFailureReport c+    else do+      return c++-- Add a StdGen to configQuickCheckArgs if there is none.  That way the same+-- seed is used for all properties.  This helps with --seed and --re-run.+ensureStdGen :: Config -> IO Config+ensureStdGen c = case QC.replay qcArgs of+  Nothing -> do+    stdGen <- newStdGen+    return c {configQuickCheckArgs = qcArgs {QC.replay = Just (stdGen, 0)}}+  _       -> return c+  where+    qcArgs = configQuickCheckArgs c+ -- | Run given spec with custom options. -- This is similar to `hspec`, but more flexible. --@@ -119,30 +143,32 @@ hspecWith :: Config -> Spec -> IO Summary hspecWith c_ spec = do   -- read failure report on --re-run-  c <- if configReRun c_-    then do-      readFailureReport c_-    else do-      return c_+  c <- handleReRun c_ >>= ensureStdGen    let formatter = configFormatter c       h = configHandle c+      seed = (stdGenToInteger . fst . fromJust . QC.replay . configQuickCheckArgs) c    useColor <- doesUseColor h c-  when useColor (hHideCursor h)-  runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) h $ do-    runFormatter useColor c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_` do-      failedFormatter formatter-      liftIO $ when useColor (hShowCursor h) -    footerFormatter formatter+  withHiddenCursor useColor h $+    runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do+      runFormatter useColor c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_` do+        failedFormatter formatter -    -- dump failure report-    xs <- map failureRecordPath <$> getFailMessages-    liftIO $ writeFailureReport (show xs)+      footerFormatter formatter -    Summary <$> getTotalCount <*> getFailCount+      -- dump failure report+      xs <- map failureRecordPath <$> getFailMessages+      liftIO $ writeFailureReport (seed, xs)++      Summary <$> getTotalCount <*> getFailCount   where+    withHiddenCursor :: Bool -> Handle -> IO a -> IO a+    withHiddenCursor useColor h+      | useColor  = E.bracket_ (hHideCursor h) (hShowCursor h)+      | otherwise = id+     doesUseColor :: Handle -> Config -> IO Bool     doesUseColor h c = case configColorMode c of       ColorAuto  -> hIsTerminalDevice h
src/Test/Hspec/Util.hs view
@@ -1,21 +1,25 @@ module Test.Hspec.Util (   quantify , lineBreaksAt-, safeEvaluate+, safeTry , Path , filterPredicate , formatRequirement , readMaybe , getEnv , strip+, stdGenToInteger+, stdGenFromInteger ) where +import           Data.Int (Int32) import           Data.List import           Data.Maybe import           Data.Char (isSpace) import           Control.Applicative import qualified Control.Exception as E import qualified System.Environment as Environment+import           System.Random (StdGen)  -- | Create a more readable display of a quantity of something. --@@ -33,13 +37,13 @@ quantify 1 s = "1 " ++ s quantify n s = show n ++ " " ++ s ++ "s" -safeEvaluate :: IO a -> IO (Either E.SomeException a)-safeEvaluate action = (Right <$> (action >>= E.evaluate)) `E.catches` [+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.throw (e :: E.AsyncException)+    E.Handler $ \e -> E.throwIO (e :: E.AsyncException)    , E.Handler $ \e -> (return . Left) (e :: E.SomeException)   ]@@ -79,7 +83,7 @@ readMaybe = fmap fst . listToMaybe . reads  getEnv :: String -> IO (Maybe String)-getEnv key = either (const Nothing) Just <$> safeEvaluate (Environment.getEnv key)+getEnv key = either (const Nothing) Just <$> safeTry (Environment.getEnv key)  -- ensure that lines are not longer then given `n`, insert line beraks at word -- boundaries@@ -98,3 +102,17 @@  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)