diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,9 @@ +Changes in 0.15.0 + - Add `--verbose` for printing each test as it is run + +Changes in 0.14.1 + - Add test assets to source tarball (see #189) + Changes in 0.14.0 - GHC 8.4 compatibility. diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -22,7 +22,9 @@ export PATH="$HOME/Library/Haskell/bin:$PATH" -On Windows it's `C:\Documents And Settings\user\Application Data\cabal\bin`. +On Windows: + + set PATH="%AppData%\cabal\bin\;%PATH%" For more information, see the [section on paths in the Cabal User Guide](http://www.haskell.org/cabal/users-guide/installing-packages.html#paths-in-the-simple-build-system). diff --git a/doctest.cabal b/doctest.cabal --- a/doctest.cabal +++ b/doctest.cabal @@ -1,11 +1,11 @@ --- This file has been generated from package.yaml by hpack version 0.26.0. +-- This file has been generated from package.yaml by hpack version 0.27.0. -- -- see: https://github.com/sol/hpack -- --- hash: 0a29aaff0365fc3bd51a91801874db9f7286c473371a385a2d6ec0c8dfb48e6e +-- hash: 03a9b0f4a629d8ae1361038b83b10eb6e4847761565ed78ae4d1b2046e6d0c0f name: doctest -version: 0.14.1 +version: 0.15.0 synopsis: Test interactive Haskell examples description: The doctest program checks examples in source code comments. It is modeled after doctest for Python (). @@ -130,7 +130,7 @@ Language.Haskell.GhciWrapper Paths_doctest build-depends: - base ==4.* + base >=4.5 && <5 , base-compat >=0.7.0 , code-page >=0.1 , deepseq @@ -151,7 +151,7 @@ hs-source-dirs: driver build-depends: - base ==4.* + base >=4.5 && <5 , base-compat >=0.7.0 , code-page >=0.1 , deepseq @@ -172,7 +172,7 @@ hs-source-dirs: test build-depends: - base ==4.* + base >=4.5 && <5 , base-compat >=0.7.0 , code-page >=0.1 , deepseq @@ -231,7 +231,7 @@ build-depends: HUnit , QuickCheck >=2.11.3 - , base ==4.* + , base >=4.5 && <5 , base-compat >=0.7.0 , code-page >=0.1 , deepseq diff --git a/src/Options.hs b/src/Options.hs --- a/src/Options.hs +++ b/src/Options.hs @@ -6,6 +6,7 @@ , defaultMagic , defaultFastMode , defaultPreserveIt +, defaultVerbose , parseOptions #ifdef TEST , usage @@ -28,7 +29,7 @@ usage :: String usage = unlines [ "Usage:" - , " doctest [ --fast | --preserve-it | --no-magic | GHC OPTION | MODULE ]..." + , " doctest [ --fast | --preserve-it | --no-magic | --verbose | GHC OPTION | MODULE ]..." , " doctest --help" , " doctest --version" , " doctest --info" @@ -36,6 +37,7 @@ , "Options:" , " --fast disable :reload between example groups" , " --preserve-it preserve the `it` variable between examples" + , " --verbose print each test as it is run" , " --help display this help and exit" , " --version output version information and exit" , " --info output machine-readable version information and exit" @@ -72,6 +74,7 @@ , runMagicMode :: Bool , runFastMode :: Bool , runPreserveIt :: Bool +, runVerbose :: Bool } deriving (Eq, Show) defaultMagic :: Bool @@ -83,17 +86,21 @@ defaultPreserveIt :: Bool defaultPreserveIt = False +defaultVerbose :: Bool +defaultVerbose = False + parseOptions :: [String] -> Result Run parseOptions args | "--help" `elem` args = Output usage | "--info" `elem` args = Output info | "--version" `elem` args = Output versionInfo - | otherwise = case fmap (fmap stripOptGhc) + | otherwise = case fmap (fmap (fmap stripOptGhc)) + . fmap (fmap stripVerbose) . fmap stripPreserveIt . stripFast <$> stripNoMagic args of - (magicMode, (fastMode, (preserveIt, (warning, xs)))) -> - Result (Run (maybeToList warning) xs magicMode fastMode preserveIt) + (magicMode, (fastMode, (preserveIt, (verbose, (warning, xs))))) -> + Result (Run (maybeToList warning) xs magicMode fastMode preserveIt verbose) stripNoMagic :: [String] -> (Bool, [String]) stripNoMagic = stripFlag (not defaultMagic) "--no-magic" @@ -103,6 +110,9 @@ stripPreserveIt :: [String] -> (Bool, [String]) stripPreserveIt = stripFlag (not defaultPreserveIt) "--preserve-it" + +stripVerbose :: [String] -> (Bool, [String]) +stripVerbose = stripFlag (not defaultVerbose) "--verbose" stripFlag :: Bool -> String -> [String] -> (Bool, [String]) stripFlag enableIt flag args = ((flag `elem` args) == enableIt, filter (/= flag) args) diff --git a/src/Run.hs b/src/Run.hs --- a/src/Run.hs +++ b/src/Run.hs @@ -43,7 +43,7 @@ doctest :: [String] -> IO () doctest args0 = case parseOptions args0 of Output s -> putStr s - Result (Run warnings args_ magicMode fastMode preserveIt) -> do + Result (Run warnings args_ magicMode fastMode preserveIt verbose) -> do mapM_ (hPutStrLn stderr) warnings hFlush stderr @@ -60,7 +60,7 @@ addDistArgs <- getAddDistArgs return (addDistArgs $ packageDBArgs ++ expandedArgs) - r <- doctestWithOptions fastMode preserveIt args `E.catch` \e -> do + r <- doctestWithOptions fastMode preserveIt verbose args `E.catch` \e -> do case fromException e of Just (UsageError err) -> do hPutStrLn stderr ("doctest: " ++ err) @@ -123,11 +123,11 @@ isSuccess :: Summary -> Bool isSuccess s = sErrors s == 0 && sFailures s == 0 -doctestWithOptions :: Bool -> Bool -> [String] -> IO Summary -doctestWithOptions fastMode preserveIt args = do +doctestWithOptions :: Bool -> Bool -> Bool -> [String] -> IO Summary +doctestWithOptions fastMode preserveIt verbose args = do -- get examples from Haddock comments modules <- getDocTests args Interpreter.withInterpreter args $ \repl -> withCP65001 $ do - runModules fastMode preserveIt repl modules + runModules fastMode preserveIt verbose repl modules diff --git a/src/Runner.hs b/src/Runner.hs --- a/src/Runner.hs +++ b/src/Runner.hs @@ -59,13 +59,13 @@ (Summary x1 x2 x3 x4) (Summary y1 y2 y3 y4) = Summary (x1 + y1) (x2 + y2) (x3 + y3) (x4 + y4) -- | Run all examples from a list of modules. -runModules :: Bool -> Bool -> Interpreter -> [Module [Located DocTest]] -> IO Summary -runModules fastMode preserveIt repl modules = do +runModules :: Bool -> Bool -> Bool -> Interpreter -> [Module [Located DocTest]] -> IO Summary +runModules fastMode preserveIt verbose repl modules = do isInteractive <- hIsTerminalDevice stderr - ReportState _ _ s <- (`execStateT` ReportState 0 isInteractive mempty {sExamples = c}) $ do + ReportState _ _ _ s <- (`execStateT` ReportState 0 isInteractive verbose mempty {sExamples = c}) $ do forM_ modules $ runModule fastMode preserveIt repl - -- report final summary + verboseReport "# Final summary:" gets (show . reportStateSummary) >>= report return s @@ -82,6 +82,7 @@ data ReportState = ReportState { reportStateCount :: Int -- ^ characters on the current line , reportStateInteractive :: Bool -- ^ should intermediate results be printed? +, reportStateVerbose :: Bool , reportStateSummary :: Summary -- ^ test summary } @@ -151,26 +152,44 @@ Property _ -> return () Example e _ -> void $ safeEvalWith preserveIt repl e -reportFailure :: Location -> Expression -> Report () -reportFailure loc expression = do +reportStart :: Location -> Expression -> String -> Report () +reportStart loc expression testType = do + verboseReport (printf "### Started execution at %s.\n### %s:\n%s" (show loc) testType expression) + +reportFailure :: Location -> Expression -> [String] -> Report () +reportFailure loc expression err = do report (printf "### Failure in %s: expression `%s'" (show loc) expression) + mapM_ report err + report "" updateSummary (Summary 0 1 0 1) reportError :: Location -> Expression -> String -> Report () reportError loc expression err = do report (printf "### Error in %s: expression `%s'" (show loc) expression) report err + report "" updateSummary (Summary 0 1 1 0) reportSuccess :: Report () -reportSuccess = +reportSuccess = do + verboseReport "### Successful!\n" updateSummary (Summary 0 1 0 0) +verboseReport :: String -> Report () +verboseReport xs = do + verbose <- gets reportStateVerbose + when verbose $ report xs + updateSummary :: Summary -> Report () updateSummary summary = do - ReportState n f s <- get - put (ReportState n f $ s `mappend` summary) + ReportState n f v s <- get + put (ReportState n f v $ s `mappend` summary) +reportProgress :: Report () +reportProgress = do + verbose <- gets reportStateVerbose + when (not verbose) $ gets (show . reportStateSummary) >>= report_ + -- | Run given test group. -- -- The interpreter state is zeroed with @:reload@ first. This means that you @@ -178,24 +197,23 @@ runTestGroup :: Bool -> Interpreter -> IO () -> [Located DocTest] -> Report () runTestGroup preserveIt repl setup tests = do - -- report intermediate summary - gets (show . reportStateSummary) >>= report_ + reportProgress liftIO setup runExampleGroup preserveIt repl examples forM_ properties $ \(loc, expression) -> do - r <- liftIO $ do - setup - runProperty repl expression + r <- do + liftIO setup + reportStart loc expression "property" + liftIO $ runProperty repl expression case r of Success -> reportSuccess Error err -> do reportError loc expression err Failure msg -> do - reportFailure loc expression - report msg + reportFailure loc expression [msg] where properties = [(loc, p) | Located loc (Property p) <- tests] @@ -209,14 +227,14 @@ runExampleGroup preserveIt repl = go where go ((Located loc (expression, expected)) : xs) = do + reportStart loc expression "example" r <- fmap lines <$> liftIO (safeEvalWith preserveIt repl expression) case r of Left err -> do reportError loc expression err Right actual -> case mkResult expected actual of NotEqual err -> do - reportFailure loc expression - mapM_ report err + reportFailure loc expression err Equal -> do reportSuccess go xs diff --git a/test/MainSpec.hs b/test/MainSpec.hs --- a/test/MainSpec.hs +++ b/test/MainSpec.hs @@ -26,7 +26,7 @@ doctestWithPreserveIt :: WithLocation (Bool -> FilePath -> [String] -> Summary -> Assertion) doctestWithPreserveIt preserveIt workingDir args expected = do - actual <- withCurrentDirectory ("test/integration" workingDir) (hSilence [stderr] $ doctestWithOptions defaultFastMode preserveIt args) + actual <- withCurrentDirectory ("test/integration" workingDir) (hSilence [stderr] $ doctestWithOptions defaultFastMode preserveIt defaultVerbose args) assertEqual label expected actual where label = workingDir ++ " " ++ show args diff --git a/test/OptionsSpec.hs b/test/OptionsSpec.hs --- a/test/OptionsSpec.hs +++ b/test/OptionsSpec.hs @@ -14,11 +14,11 @@ let warning = ["WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."] it "strips --optghc" $ property $ \xs ys -> - parseOptions (xs ++ ["--optghc", "foobar"] ++ ys) `shouldBe` Result (Run warning (xs ++ ["foobar"] ++ ys) defaultMagic defaultFastMode defaultPreserveIt) + parseOptions (xs ++ ["--optghc", "foobar"] ++ ys) `shouldBe` Result (Run warning (xs ++ ["foobar"] ++ ys) defaultMagic defaultFastMode defaultPreserveIt defaultVerbose) it "strips --optghc=" $ property $ \xs ys -> - parseOptions (xs ++ ["--optghc=foobar"] ++ ys) `shouldBe` Result (Run warning (xs ++ ["foobar"] ++ ys) defaultMagic defaultFastMode defaultPreserveIt) + parseOptions (xs ++ ["--optghc=foobar"] ++ ys) `shouldBe` Result (Run warning (xs ++ ["foobar"] ++ ys) defaultMagic defaultFastMode defaultPreserveIt defaultVerbose) describe "--no-magic" $ do context "without --no-magic" $ do @@ -58,3 +58,12 @@ context "with --info" $ do it "outputs machine readable version information" $ do parseOptions ["--info"] `shouldBe` Output info + + describe "--verbose" $ do + context "without --verbose" $ do + it "is not verbose by default" $ do + runVerbose <$> parseOptions [] `shouldBe` Result False + + context "with --verbose" $ do + it "parses verbose option" $ do + runVerbose <$> parseOptions ["--verbose"] `shouldBe` Result True diff --git a/test/RunSpec.hs b/test/RunSpec.hs --- a/test/RunSpec.hs +++ b/test/RunSpec.hs @@ -25,7 +25,7 @@ import Run doctestWithDefaultOptions :: [String] -> IO Summary -doctestWithDefaultOptions = doctestWithOptions Options.defaultFastMode Options.defaultPreserveIt +doctestWithDefaultOptions = doctestWithOptions Options.defaultFastMode Options.defaultPreserveIt Options.defaultVerbose withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory workingDir action = do @@ -96,6 +96,45 @@ `E.finally` do rmDir "test/integration/custom-package-conf/packages/" rmDir "test/integration/custom-package-conf/foo/dist/" + + it "prints verbose description of a specification" $ do + (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/testSimple/Fib.hs"] + r `shouldBe` unlines [ + "### Started execution at test/integration/testSimple/Fib.hs:5." + , "### example:" + , "fib 10" + , "### Successful!" + , "" + , "# Final summary:" + , "Examples: 1 Tried: 1 Errors: 0 Failures: 0" + ] + + it "prints verbose description of a property" $ do + (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/property-bool/Foo.hs"] + r `shouldBe` unlines [ + "### Started execution at test/integration/property-bool/Foo.hs:4." + , "### property:" + , "True" + , "### Successful!" + , "" + , "# Final summary:" + , "Examples: 1 Tried: 1 Errors: 0 Failures: 0" + ] + + it "prints verbose error" $ do + (r, e) <- hCapture [stderr] . E.try $ doctest ["--verbose", "test/integration/failing/Foo.hs"] + e `shouldBe` Left (ExitFailure 1) + r `shouldBe` unlines [ + "### Started execution at test/integration/failing/Foo.hs:5." + , "### example:" + , "23" + , "### Failure in test/integration/failing/Foo.hs:5: expression `23'" + , "expected: 42" + , " but got: 23" + , "" + , "# Final summary:" + , "Examples: 1 Tried: 1 Errors: 0 Failures: 1" + ] describe "doctestWithOptions" $ do context "on parse error" $ do diff --git a/test/RunnerSpec.hs b/test/RunnerSpec.hs --- a/test/RunnerSpec.hs +++ b/test/RunnerSpec.hs @@ -16,11 +16,11 @@ main = hspec spec capture :: Report a -> IO String -capture = fmap fst . hCapture [stderr] . (`execStateT` ReportState 0 True mempty) +capture = fmap fst . hCapture [stderr] . (`execStateT` ReportState 0 True False mempty) -- like capture, but with interactivity set to False capture_ :: Report a -> IO String -capture_ = fmap fst . hCapture [stderr] . (`execStateT` ReportState 0 False mempty) +capture_ = fmap fst . hCapture [stderr] . (`execStateT` ReportState 0 False False mempty) spec :: Spec spec = do