Add --fail-fast

src/Options.hs

@@ -28,14 +28,16 @@ import Info
 usage :: String
 usage = unlines [
  "Usage:"
- , " doctest [ --fast | --preserve-it | --no-magic | --verbose | GHC OPTION | MODULE ]..."
+ , " doctest [ --fast | --preserve-it | --no-magic | --fail-fast | --verbose | GHC OPTION | MODULE ]..."
  , " doctest --help"
  , " doctest --version"
  , " doctest --info"
  , ""
  , "Options:"
  , " --fast disable :reload between example groups"
  , " --preserve-it preserve the `it` variable between examples"
+ , " --fail-fast abort on first failure"
+ , " --no-magic disable magic mode"
  , " --verbose print each test as it is run"
  , " --help display this help and exit"
  , " --version output version information and exit"
@@ -57,6 +59,7 @@ data Config = Config {
  ghcOptions :: [String]
 , fastMode :: Bool
 , preserveIt :: Bool
+, failFast :: Bool
 , verbose :: Bool
 , repl :: (String, [String])
 } deriving (Eq, Show)
@@ -66,6 +69,7 @@ defaultConfig = Config {
  ghcOptions = []
 , fastMode = False
 , preserveIt = False
+, failFast = False
 , verbose = False
 , repl = (ghc, ["--interactive"])
 }
@@ -99,6 +103,9 @@ setOptions ghcOptions run@Run{..} = run { runConfig = runConfig { ghcOptions } }
 setMagicMode :: Bool -> Run -> Run
 setMagicMode magic run = run { runMagicMode = magic }
 
+setFailFastMode :: Bool -> Run -> Run
+setFailFastMode failFast run@Run{..} = run { runConfig = runConfig { failFast } }
+
 setFastMode :: Bool -> Run -> Run
 setFastMode fastMode run@Run{..} = run { runConfig = runConfig { fastMode } }
 
@@ -119,6 +126,7 @@ parseOptions args
  | otherwise = runRunOptionsParser args defaultRun {runMagicMode = True} $ do
  commonRunOptions
  parseFlag "--no-magic" (setMagicMode False)
+ parseFlag "--fail-fast" (setFailFastMode True)
  parseOptGhc
  where
  on option = option `elem` args

src/Run.hs

@@ -158,5 +158,6 @@ runDocTests Config{..} modules = do
  runModules
  (if fastMode then FastMode else NoFastMode)
  (if preserveIt then PreserveIt else NoPreserveIt)
+ (if failFast then FailFast else NoFailFast)
  (if verbose then Verbose else NonVerbose)
  interpreter modules

src/Runner.hs

@@ -4,6 +4,7 @@ module Runner (
  runModules
 , FastMode(..)
 , PreserveIt(..)
+, FailFast(..)
 , Verbose(..)
 , Summary(..)
 , formatSummary
@@ -66,8 +67,8 @@ withLineBuffering h action = bracket (hGetBuffering h) (hSetBuffering h) $ \ _ -
  action
 
 -- | Run all examples from a list of modules.
-runModules :: FastMode -> PreserveIt -> Verbose -> Interpreter -> [Module [Located DocTest]] -> IO Summary
-runModules fastMode preserveIt verbose repl modules = withLineBuffering stderr $ do
+runModules :: FastMode -> PreserveIt -> FailFast -> Verbose -> Interpreter -> [Module [Located DocTest]] -> IO Summary
+runModules fastMode preserveIt failFast verbose repl modules = withLineBuffering stderr $ do
 
  interactive <- hIsTerminalDevice stderr <&> \ case
  False -> NonInteractive
@@ -84,7 +85,7 @@ runModules fastMode preserveIt verbose repl modules = withLineBuffering stderr $
  run :: IO ()
  run = flip evalStateT (ReportState interactive verbose summary) $ do
  reportProgress
- forM_ modules $ runModule fastMode preserveIt repl
+ forM_ modules $ runModule fastMode preserveIt failFast repl
  verboseReport "# Final summary:"
 
  run `finally` reportFinalResult
@@ -105,6 +106,8 @@ data FastMode = NoFastMode | FastMode
 
 data Verbose = NonVerbose | Verbose
 
+data FailFast = NoFailFast | FailFast
+
 data ReportState = ReportState {
  reportStateInteractive :: Interactive
 , reportStateVerbose :: Verbose
@@ -131,8 +134,8 @@ reportTransient msg = gets reportStateInteractive >>= \ case
  hPutStr stderr $ '\r' : (replicate (length msg) ' ') ++ "\r"
 
 -- | Run all examples from given module.
-runModule :: FastMode -> PreserveIt -> Interpreter -> Module [Located DocTest] -> Report ()
-runModule fastMode preserveIt repl (Module module_ setup examples) = do
+runModule :: FastMode -> PreserveIt -> FailFast -> Interpreter -> Module [Located DocTest] -> Report ()
+runModule fastMode preserveIt failFast repl (Module module_ setup examples) = do
 
  Summary _ _ e0 f0 <- getSummary
 
@@ -143,8 +146,7 @@ runModule fastMode preserveIt repl (Module module_ setup examples) = do
 
  -- only run tests, if setup does not produce any errors/failures
  when (e0 == e1 && f0 == f1) $
- forM_ examples $
- runTestGroup preserveIt repl setup_
+ runExamples examples
  where
  reload :: IO ()
  reload = do
@@ -169,6 +171,19 @@ runModule fastMode preserveIt repl (Module module_ setup examples) = do
  Property _ -> return ()
  Example e _ -> void $ safeEvalWith preserveIt repl e
 
+ -- run examples - optionally aborting if in stopOnFail mode and a failure occurs
+ runExamples :: [[Located DocTest]] -> Report ()
+ runExamples [] = return ()
+ runExamples (testGroup:moreGroups) = do
+ failures <- sFailures <$> getSummary
+ case failFast of
+ FailFast -> when (failures == 0) runAndContinue
+ NoFailFast -> runAndContinue
+ where
+ runAndContinue = do
+ runTestGroup preserveIt repl setup_ testGroup
+ runExamples moreGroups
+
 reportStart :: Location -> Expression -> String -> Report ()
 reportStart loc expression testType = do
  verboseReport (printf "### Started execution at %s.\n### %s:\n%s" (show loc) testType expression)

test/MainSpec.hs

@@ -21,11 +21,11 @@ withCurrentDirectory workingDir action = do
 
 -- | Construct a doctest specific 'Assertion'.
 doctest :: HasCallStack => FilePath -> [String] -> Summary -> Assertion
-doctest = doctestWithPreserveIt False
+doctest = doctestWithPreserveIt False False
 
-doctestWithPreserveIt :: HasCallStack => Bool -> FilePath -> [String] -> Summary -> Assertion
-doctestWithPreserveIt preserveIt workingDir ghcOptions expected = do
- actual <- withCurrentDirectory ("test/integration" </> workingDir) (hSilence [stderr] $ doctestWithResult defaultConfig {ghcOptions, preserveIt})
+doctestWithPreserveIt :: HasCallStack => Bool -> Bool -> FilePath -> [String] -> Summary -> Assertion
+doctestWithPreserveIt preserveIt failFast workingDir ghcOptions expected = do
+ actual <- withCurrentDirectory ("test/integration" </> workingDir) (hSilence [stderr] $ doctestWithResult defaultConfig {ghcOptions, preserveIt, failFast})
  assertEqual label (formatSummary expected) (formatSummary actual)
  where
  label = workingDir ++ " " ++ show ghcOptions
@@ -44,11 +44,11 @@ spec = do
  (cases 1)
 
  it "it-variable" $ do
- doctestWithPreserveIt True "." ["it/Foo.hs"]
+ doctestWithPreserveIt True False "." ["it/Foo.hs"]
  (cases 5)
 
  it "it-variable in $setup" $ do
- doctestWithPreserveIt True "." ["it/Setup.hs"]
+ doctestWithPreserveIt True False "." ["it/Setup.hs"]
  (cases 5)
 
  it "failing" $ do
@@ -59,6 +59,14 @@ spec = do
  doctest "." ["failing-multiple/Foo.hs"]
  (cases 4) {sTried = 2, sFailures = 1}
 
+ it "runs subsequent groups after an example in earlier group fails" $
+ doctest "." ["fail-fast/Foo.hs"]
+ (cases 3) {sTried = 3, sFailures = 1}
+
+ it "in --fail-fast mode, does not run subsequent groups after an example in earlier group fails" $
+ doctestWithPreserveIt False True "." ["fail-fast/Foo.hs","fail-fast/Bar.hs"]
+ (cases 4) {sTried = 2, sFailures = 1}
+
  it "testImport" $ do
  doctest "testImport" ["ModuleA.hs"]
  (cases 3)

test/OptionsSpec.hs

@@ -65,9 +65,18 @@ spec = do
  fastMode . runConfig <$> parseOptions [] `shouldBe` Result False
 
  context "with --fast" $ do
- it "enabled fast mode" $ do
+ it "enable fast mode" $ do
  fastMode . runConfig <$> parseOptions ["--fast"] `shouldBe` Result True
 
+ describe "--fail-fast" $ do
+ context "without --fail-fast" $ do
+ it "disables fail-fast mode" $ do
+ failFast . runConfig <$> parseOptions [] `shouldBe` Result False
+
+ context "with --fail-fast" $ do
+ it "enable fail-fast mode" $ do
+ failFast . runConfig <$> parseOptions ["--fail-fast"] `shouldBe` Result True
+
  describe "--preserve-it" $ do
  context "without --preserve-it" $ do
  it "does not preserve the `it` variable" $ do

test/integration/fail-fast/Bar.hs

@@ -0,0 +1,8 @@
+module Bar where
+
+-- | bar
+-- a passing test
+-- >>> bar
+-- 42
+bar :: Int
+bar = 42

test/integration/fail-fast/Foo.hs

@@ -0,0 +1,22 @@
+module Foo where
+
+-- | A passing example
+--
+-- >>> 23
+-- 23
+test1 :: a
+test1 = undefined
+
+-- | A failing example
+--
+-- >>> 23
+-- 42
+test2 :: a
+test2 = undefined
+
+-- | Another passing example
+--
+-- >>> 23
+-- 23
+test3 :: a
+test3 = undefined