added test run time limits

hspec-core/help.txt

@@ -16,6 +16,7 @@ RUNNER OPTIONS
  pending: fail on pending spec items
  empty-description: fail on empty descriptions
  --[no-]strict same as --fail-on=focused,pending
+ --[no-]timeout=N each test will run at most N seconds
  --[no-]fail-fast abort on first failure
  --[no-]randomize randomize execution order
  -r --rerun rerun all examples that failed in the previous

hspec-core/src/Test/Hspec/Core/Clock.hs

@@ -6,6 +6,7 @@ module Test.Hspec.Core.Clock (
 , toMicroseconds
 , getMonotonicTime
 , measure
+, measureWithTimeout
 , sleep
 , timeout
 ) where
@@ -42,9 +43,12 @@ getMonotonicTime = do
 #endif
 
 measure :: IO a -> IO (Seconds, a)
-measure action = do
+measure = fmap (second fromJust) . measureWithTimeout Nothing
+
+measureWithTimeout :: Maybe Seconds -> IO a -> IO (Seconds, Maybe a)
+measureWithTimeout maxTime action = do
  t0 <- getMonotonicTime
- a <- action
+ a <- maybe (fmap Just) timeout maxTime action
  t1 <- getMonotonicTime
  return (t1 - t0, a)
 

hspec-core/src/Test/Hspec/Core/Config/Definition.hs

@@ -26,7 +26,7 @@ import System.Directory (getTemporaryDirectory, removeFile)
 import System.IO (openTempFile, hClose)
 import System.Process (system)
 
-import Test.Hspec.Core.Format (Format, FormatConfig)
+import Test.Hspec.Core.Format (Format, FormatConfig, Seconds(Seconds))
 import Test.Hspec.Core.Formatters.Pretty (pretty2)
 import qualified Test.Hspec.Core.Formatters.V1.Monad as V1
 import Test.Hspec.Core.Util
@@ -48,6 +48,7 @@ data Config = Config {
 , configFailOnFocused :: Bool
 , configFailOnPending :: Bool
 , configFailOnEmptyDescription :: Bool
+, configTimeout :: Maybe Seconds
 , configPrintSlowItems :: Maybe Int
 , configPrintCpuTime :: Bool
 , configFailFast :: Bool
@@ -107,6 +108,7 @@ mkDefaultConfig formatters = Config {
 , configFailOnFocused = False
 , configFailOnPending = False
 , configFailOnEmptyDescription = False
+, configTimeout = Nothing
 , configPrintSlowItems = Nothing
 , configPrintCpuTime = False
 , configFailFast = False
@@ -304,6 +306,9 @@ setMaxShrinks n c = c {configQuickCheckMaxShrinks = Just n}
 setSeed :: Integer -> Config -> Config
 setSeed n c = c {configSeed = Just n}
 
+setTimeout :: Maybe Seconds -> Config -> Config
+setTimeout n c = c {configTimeout = n}
+
 data FailOn =
  FailOnEmpty
  | FailOnFocused
@@ -346,6 +351,9 @@ runnerOptions = [
  , mkOption "no-fail-on" Nothing (argument "ITEMS" readFailOnItems (setFailOnItems False)) helpForFailOn
  , flag "strict" setStrict $ "same as --fail-on=" <> showFailOnItems strict
 
+ , option "timeout" (argument "N" (fmap Seconds . readMaybe) (setTimeout . Just)) "each test will run at most N seconds"
+ , mkOptionNoArg "no-timeout" Nothing (setTimeout Nothing) "remove test time limits"
+
  , flag "fail-fast" setFailFast "abort on first failure"
  , flag "randomize" setRandomize "randomize execution order"
  , mkOptionNoArg "rerun" (Just 'r') setRerun "rerun all examples that failed in the previous test run (only works in combination with --failure-report or in GHCi)"

hspec-core/src/Test/Hspec/Core/Runner.hs

@@ -115,7 +115,7 @@ import qualified Test.QuickCheck as QC
 import Test.Hspec.Core.Util (Path)
 import Test.Hspec.Core.Clock
 import Test.Hspec.Core.Spec hiding (pruneTree, pruneForest)
-import Test.Hspec.Core.Tree (formatDefaultDescription)
+import Test.Hspec.Core.Tree (formatDefaultDescription, setItemTimeout)
 import Test.Hspec.Core.Config
 import Test.Hspec.Core.Format (Format, FormatConfig(..))
 import qualified Test.Hspec.Core.Formatters.V1 as V1
@@ -233,11 +233,14 @@ hspecWithResult config = fmap toSummary . hspecWithSpecResult config
 
 hspecWithSpecResult :: Config -> Spec -> IO SpecResult
 hspecWithSpecResult defaults spec = do
- (c, forest) <- evalSpec defaults spec
+ (c, f) <- evalSpec defaults spec
  config <- getArgs >>= readConfig c
  oldFailureReport <- readFailureReportOnRerun config
 
  let
+ forest :: [SpecTree ()]
+ forest = maybe id (fmap . fmap . setItemTimeout . Just) (configTimeout config) f
+
  normalMode :: IO SpecResult
  normalMode = doNotLeakCommandLineArgumentsToExamples $ runSpecForest_ oldFailureReport forest config
 
@@ -450,16 +453,22 @@ toEvalItemForest :: Params -> [SpecTree ()] -> [EvalItemTree]
 toEvalItemForest params = bimapForest id toEvalItem . filterForest itemIsFocused
  where
  toEvalItem :: Item () -> EvalItem
- toEvalItem (Item requirement loc isParallelizable _isFocused e) = EvalItem {
+ toEvalItem (Item requirement loc isParallelizable _isFocused e maxTime) = EvalItem {
  evalItemDescription = requirement
  , evalItemLocation = loc
  , evalItemConcurrency = if isParallelizable == Just True then Concurrent else Sequential
- , evalItemAction = \ progress -> measure $ e params withUnit progress
+ , evalItemAction = \ progress -> let
+ failResultTimeout = Result requirement $ Failure loc $ Reason "exceeded timeout"
+ resolveResult = fmap $ fmap $ fromMaybe failResultTimeout
+ measure' = measureWithTimeout maxTime
+ in resolveResult $ measure' $ e params withUnit progress
  }
 
  withUnit :: ActionWith () -> IO ()
  withUnit action = action ()
 
+
+
 dumpFailureReport :: Config -> Integer -> QC.Args -> [Path] -> IO ()
 dumpFailureReport config seed qcArgs xs = do
  writeFailureReport config FailureReport {

hspec-core/src/Test/Hspec/Core/Tree.hs

@@ -9,6 +9,7 @@ module Test.Hspec.Core.Tree (
  SpecTree
 , Tree (..)
 , Item (..)
+, setItemTimeout
 , specGroup
 , specItem
 , bimapTree
@@ -34,6 +35,7 @@ import System.FilePath
 import qualified Data.CallStack as CallStack
 
 import Test.Hspec.Core.Example
+import Test.Hspec.Core.Clock (Seconds)
 
 -- | Internal tree data structure
 data Tree c a =
@@ -116,8 +118,14 @@ data Item a = Item {
 
  -- | Example for behavior
 , itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
+
+-- | Maximum number of seconds the test can run for.
+, itemTimeout :: Maybe Seconds
 }
 
+setItemTimeout :: Maybe Seconds -> Item a -> Item a
+setItemTimeout x i = i {itemTimeout = x}
+
 -- | The @specGroup@ function combines a list of specs into a larger spec.
 specGroup :: HasCallStack => String -> [SpecTree a] -> SpecTree a
 specGroup s = Node msg
@@ -135,6 +143,7 @@ specItem s e = Leaf Item {
  , itemIsParallelizable = Nothing
  , itemIsFocused = False
  , itemExample = safeEvaluateExample e
+ , itemTimeout = Nothing
  }
 
 location :: HasCallStack => Maybe Location

hspec-core/test/Helper.hs

@@ -26,6 +26,7 @@ module Helper (
 , withTempDirectory
 , inTempDirectory
 
+, silentConfig
 , hspecSilent
 , hspecResultSilent
 , hspecCapture

hspec-core/test/Test/Hspec/Core/RunnerSpec.hs

@@ -387,6 +387,18 @@ spec = do
  , "2 examples, 1 failure"
  ]
 
+ describe "timeout" $ do
+ let success = Test.Hspec.Core.Runner.Result.isSuccess
+ it "exceeds timeout" $ do
+ s <- H.hspecWithResult (silentConfig {H.configTimeout = Just 0}) $
+ H.it "should fail from timeout" $ threadDelay 10000000
+ success s `shouldBe` False
+
+ it "within timeout" $ do
+ s <- H.hspecWithResult (silentConfig {H.configTimeout = Just 100}) $
+ H.it "should succeed" $ True `shouldBe` True
+ success s `shouldBe` True
+
  context "with --fail-fast" $ do
  it "stops after first failure" $ do
  hspecCapture ["--fail-fast", "--seed", "23"] $ do
@@ -1017,3 +1029,4 @@ spec = do
  context "on failure" $ do
  it "returns False" $ do
  H.rerunAll config (Just report) result { specResultSuccess = False } `shouldBe` False
+