packages feed

hspec-meta 2.1.7 → 2.2.0

raw patch · 10 files changed

+151/−48 lines, 10 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

hspec-core/src/Test/Hspec/Compat.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} module Test.Hspec.Compat (-  showType+  getDefaultConcurrentJobs+, showType , showFullType , readMaybe , lookupEnv@@ -56,10 +57,18 @@  #if MIN_VERSION_base(4,4,0) import           Data.Typeable.Internal (tyConModule, tyConName)+import           Control.Concurrent #endif  #if !MIN_VERSION_base(4,6,0) import qualified Text.ParserCombinators.ReadP as P+#endif++getDefaultConcurrentJobs :: IO Int+#if MIN_VERSION_base(4,4,0)+getDefaultConcurrentJobs = getNumCapabilities+#else+getDefaultConcurrentJobs = return 1 #endif  #if !MIN_VERSION_base(4,6,0)
hspec-core/src/Test/Hspec/Core/Example.hs view
@@ -7,11 +7,13 @@ , Progress , ProgressCallback , Result (..)+, Location (..)+, LocationAccuracy (..) ) where  import           Data.Maybe (fromMaybe) import           Data.List (isPrefixOf)-import           Test.HUnit.Lang (HUnitFailure(..))+import qualified Test.HUnit.Lang as HUnit import qualified Control.Exception as E import           Data.Typeable (Typeable) import qualified Test.QuickCheck as QC@@ -50,23 +52,52 @@ type ActionWith a = a -> IO ()  -- | The result of running an example-data Result = Success | Pending (Maybe String) | Fail String+data Result = Success | Pending (Maybe String) | Fail (Maybe Location) String   deriving (Eq, Show, Read, Typeable)  instance E.Exception Result +-- | @Location@ is used to represent source locations.+data Location = Location {+  locationFile :: FilePath+, locationLine :: Int+, locationColumn :: Int+, locationAccuracy :: LocationAccuracy+} deriving (Eq, Show, Read)++-- | A marker for source locations+data LocationAccuracy =+  -- | The source location is accurate+  ExactLocation |+  -- | The source location was determined on a best-effort basis and my be+  -- wrong or inaccurate+  BestEffort+  deriving (Eq, Show, Read)+ instance Example Bool where   type Arg Bool = ()-  evaluateExample b _ _ _ = if b then return Success else return (Fail "")+  evaluateExample b _ _ _ = if b then return Success else return (Fail Nothing "")  instance Example Expectation where   type Arg Expectation = ()   evaluateExample e = evaluateExample (\() -> e) +hunitFailureToResult :: HUnit.HUnitFailure -> Result+hunitFailureToResult e = case e of+#if MIN_VERSION_HUnit(1,3,0)+  HUnit.HUnitFailure loc err -> Fail location err+    where+      location = case loc of+        Nothing -> Nothing+        Just (HUnit.Location f l c) -> Just $ Location f l c ExactLocation+#else+  HUnit.HUnitFailure err -> Fail Nothing err+#endif+ instance Example (a -> Expectation) where   type Arg (a -> Expectation) = a   evaluateExample e _ action _ = (action e >> return Success) `E.catches` [-      E.Handler (\(HUnitFailure err) -> return (Fail err))+      E.Handler (return . hunitFailureToResult)     , E.Handler (return :: Result -> IO Result)     ] @@ -85,11 +116,11 @@     return $       case r of         QC.Success {}               -> Success-        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")+        QC.Failure {QC.output = m}  -> fromMaybe (Fail Nothing $ sanitizeFailureMessage r) (parsePending m)+        QC.GaveUp {QC.numTests = n} -> Fail Nothing ("Gave up after " ++ pluralize n "test" )+        QC.NoExpectedFailure {}     -> Fail Nothing ("No expected failure") #if MIN_VERSION_QuickCheck(2,8,0)-        QC.InsufficientCoverage {}  -> Fail ("Insufficient coverage")+        QC.InsufficientCoverage {}  -> Fail Nothing ("Insufficient coverage") #endif     where       qcProgressCallback = QCP.PostTest QCP.NotCounterexample $
hspec-core/src/Test/Hspec/Core/Hooks.hs view
@@ -35,15 +35,13 @@ beforeAll :: IO a -> SpecWith a -> Spec beforeAll action spec = do   mvar <- runIO (newMVar Nothing)-  let action_ = memoize mvar action-  before action_ spec+  before (memoize mvar action) spec  -- | Run a custom action before the first spec item. beforeAll_ :: IO () -> SpecWith a -> SpecWith a beforeAll_ action spec = do   mvar <- runIO (newMVar Nothing)-  let action_ = memoize mvar action-  before_ action_ spec+  before_ (memoize mvar action) spec  memoize :: MVar (Maybe a) -> IO a -> IO a memoize mvar action = modifyMVar mvar $ \ma -> case ma of
hspec-core/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 -> getDefaultConcurrentJobs+      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
hspec-core/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)@@ -91,9 +98,9 @@   where     forceResult :: Result -> Result     forceResult r = case r of-      Success   -> r+      Success -> r       Pending m -> m `deepseq` r-      Fail    m -> m `deepseq` r+      Fail _ m -> m `deepseq` r  data Message = Done | Run (FormatM ()) @@ -140,7 +147,7 @@             Right (Pending reason) -> do               increasePendingCount               examplePending formatter path reason-            Right (Fail err) -> failed loc path (Right err)+            Right (Fail loc_ err) -> failed (loc_ <|> loc) path (Right err)             Left err         -> failed loc path (Left  err)      failed loc path err = do
hspec-core/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
hspec-core/src/Test/Hspec/Core/Tree.hs view
@@ -1,16 +1,26 @@ {-# 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 (   SpecTree , Tree (..) , Item (..)-, Location (..)-, LocationAccuracy (..) , specGroup , specItem ) where +#ifdef HAS_SOURCE_LOCATIONS+import           GHC.SrcLoc+import           GHC.Stack+#endif+ import           Prelude () import           Test.Hspec.Compat @@ -67,23 +77,6 @@ , itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result } --- | @Location@ is used to represent source locations.-data Location = Location {-  locationFile :: String-, locationLine :: Int-, locationColumn :: Int-, locationAccuracy :: LocationAccuracy-} deriving (Eq, Show)---- | A marker for source locations-data LocationAccuracy =-  -- | The source location is accurate-  ExactLocation |-  -- | The source location was determined on a best-effort basis and my be-  -- wrong or inaccurate-  BestEffort-  deriving (Eq, Show)- -- | The @specGroup@ function combines a list of specs into a larger spec. specGroup :: String -> [SpecTree a] -> SpecTree a specGroup s = Node msg@@ -93,9 +86,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
hspec-core/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}
hspec-meta.cabal view
@@ -1,5 +1,5 @@ name:             hspec-meta-version:          2.1.7+version:          2.2.0 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2015 Simon Hengel,
src/Test/Hspec/QuickCheck.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE CPP #-}+#if MIN_VERSION_base(4,8,1)+#define HAS_SOURCE_LOCATIONS+{-# LANGUAGE ImplicitParams #-}+#endif module Test.Hspec.QuickCheck ( -- * Params   modifyMaxSuccess@@ -8,6 +13,10 @@ , prop ) where +#ifdef HAS_SOURCE_LOCATIONS+import           GHC.Stack+#endif+ import           Test.Hspec import           Test.QuickCheck import           Test.Hspec.Core.QuickCheck@@ -20,5 +29,9 @@ -- -- > it ".." $ property $ -- >   ..-prop :: Testable prop => String -> prop -> Spec+#ifdef HAS_SOURCE_LOCATIONS+prop :: (?loc :: CallStack, Testable prop) => String -> prop -> Spec+#else+prop :: (Testable prop) => String -> prop -> Spec+#endif prop s = it s . property