doctest 0.22.9 → 0.22.10

raw patch · 11 files changed

+117/−131 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGES.markdown +3/−0
• doctest.cabal +1/−1
• src/Extract.hs +0/−1
• src/Imports.hs +12/−1
• src/Interpreter.hs +0/−1
• src/Language/Haskell/GhciWrapper.hs +0/−1
• src/Run.hs +4/−1
• src/Runner.hs +81/−63
• test/Language/Haskell/GhciWrapperSpec.hs +0/−1
• test/MainSpec.hs +1/−2
• test/RunnerSpec.hs +15/−59

@@ -1,3 +1,6 @@+Changes in 0.22.10+  - Make progress reporting more robust+ Changes in 0.22.9   - Use `-fprint-error-index-links=never` for GHC `>=9.10` 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           doctest-version:        0.22.9+version:        0.22.10 synopsis:       Test interactive Haskell examples description:    `doctest` is a tool that checks [examples](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744)                 and [properties](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810771856)

@@ -2,7 +2,6 @@ module Extract (Module(..), extract) where  import           Imports hiding (mod, concat)-import           Control.Exception import           Data.List (partition, isSuffixOf)  import           Control.DeepSeq (deepseq, NFData(rnf))

@@ -1,15 +1,26 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} module Imports (module Imports) where  import           Prelude as Imports import           Data.Monoid as Imports import           Data.Maybe as Imports-import           Control.Monad as Imports+import           Control.Monad as Imports hiding (forM_)+import           Control.Exception as Imports+import           Data.Foldable as Imports (forM_) import           Control.Arrow as Imports  import           Data.Char import           System.Exit import           System.Process++#if __GLASGOW_HASKELL__ >= 804+import           Data.Functor as Imports ((<&>))+#else+infixl 1 <&>+(<&>) :: Functor f => f a -> (a -> b) -> f b+(<&>) = flip fmap+#endif  pass :: Monad m => m () pass = return ()

@@ -17,7 +17,6 @@  import           System.Process import           System.Directory (getPermissions, executable)-import           Control.Exception hiding (handle) import           GHC.Paths (ghc)  import           Language.Haskell.GhciWrapper

@@ -14,7 +14,6 @@ import           System.IO hiding (stdin, stdout, stderr) import           System.Process import           System.Exit-import           Control.Exception import           Data.List (isSuffixOf)  data Config = Config {

@@ -9,6 +9,7 @@  , Result , Summary(..)+, formatSummary , isSuccess , evaluateResult , doctestWithResult@@ -154,4 +155,6 @@ runDocTests :: Config -> [Module [Located DocTest]] -> IO Result runDocTests Config{..} modules = do   Interpreter.withInterpreter ((<> ghcOptions) <$> repl) $ \ interpreter -> withCP65001 $ do-    runModules fastMode preserveIt verbose interpreter modules+    let+      v = if verbose then Verbose else NonVerbose+    runModules fastMode preserveIt v interpreter modules

@@ -1,25 +1,29 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} module Runner (   runModules+, Verbose(..) , Summary(..)+, formatSummary  #ifdef TEST , Report-, ReportState (..)+, ReportState(..)+, Interactive(..) , report-, report_+, reportTransient #endif ) where -import           Prelude hiding (putStr, putStrLn, error)+import           Prelude ()+import           Imports hiding (putStr, putStrLn, error) -import           Control.Monad hiding (forM_) import           Text.Printf (printf)-import           System.IO (hPutStrLn, hPutStr, stderr, hIsTerminalDevice)-import           Data.Foldable (forM_)+import           System.IO hiding (putStr, putStrLn)  import           Control.Monad.Trans.State import           Control.Monad.IO.Class+import           Data.IORef  import           Interpreter (Interpreter) import qualified Interpreter@@ -30,17 +34,18 @@  -- | Summary of a test run. data Summary = Summary {-  sExamples :: Int-, sTried    :: Int-, sErrors   :: Int-, sFailures :: Int+  sExamples :: !Int+, sTried    :: !Int+, sErrors   :: !Int+, sFailures :: !Int } deriving Eq --- | Format a summary. instance Show Summary where-  show (Summary examples tried errors failures) =-    printf "Examples: %d  Tried: %d  Errors: %d  Failures: %d" examples tried errors failures+  show = formatSummary +formatSummary :: Summary -> String+formatSummary (Summary examples tried errors failures) =+  printf "Examples: %d  Tried: %d  Errors: %d  Failures: %d" examples tried errors failures  -- | Sum up summaries. instance Monoid Summary where@@ -53,72 +58,85 @@ #endif     (Summary x1 x2 x3 x4) (Summary y1 y2 y3 y4) = Summary (x1 + y1) (x2 + y2) (x3 + y3) (x4 + y4) +withLineBuffering :: Handle -> IO c -> IO c+withLineBuffering h action = bracket (hGetBuffering h) (hSetBuffering h) $ \ _ -> do+  hSetBuffering h LineBuffering+  action+ -- | Run all examples from a list of modules.-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 verbose mempty {sExamples = c}) $ do-    forM_ modules $ runModule fastMode preserveIt repl+runModules :: Bool -> Bool -> Verbose -> Interpreter -> [Module [Located DocTest]] -> IO Summary+runModules fastMode preserveIt verbose repl modules = withLineBuffering stderr $ do -    verboseReport "# Final summary:"-    gets (show . reportStateSummary) >>= report+  interactive <- hIsTerminalDevice stderr <&> \ case+    False -> NonInteractive+    True -> Interactive -  return s+  summary <- newIORef mempty {sExamples = n}++  let+    reportFinalResult :: IO ()+    reportFinalResult = do+      final <- readIORef summary+      hPutStrLn stderr (formatSummary final)++    run :: IO ()+    run = flip evalStateT (ReportState interactive verbose summary) $ do+      reportProgress+      forM_ modules $ runModule fastMode preserveIt repl+      verboseReport "# Final summary:"++  run `finally` reportFinalResult++  readIORef summary   where-    c = (sum . map count) modules+    n :: Int+    n = sum (map countExpressions modules) --- | Count number of expressions in given module.-count :: Module [Located DocTest] -> Int-count (Module _ setup tests) = sum (map length tests) + maybe 0 length setup+countExpressions :: Module [Located DocTest] -> Int+countExpressions (Module _ setup tests) = sum (map length tests) + maybe 0 length setup --- | A monad for generating test reports. type Report = StateT ReportState IO +data Interactive = NonInteractive | Interactive++data Verbose = NonVerbose | Verbose+  deriving (Eq, Show)+ data ReportState = ReportState {-  reportStateCount        :: Int     -- ^ characters on the current line-, reportStateInteractive  :: Bool    -- ^ should intermediate results be printed?-, reportStateVerbose      :: Bool-, reportStateSummary      :: Summary -- ^ test summary+  reportStateInteractive :: Interactive+, reportStateVerbose :: Verbose+, reportStateSummary :: IORef Summary } +getSummary :: Report Summary+getSummary = gets reportStateSummary >>= liftIO . readIORef+ -- | Add output to the report. report :: String -> Report ()-report msg = do-  overwrite msg--  -- add a newline, this makes the output permanent-  liftIO $ hPutStrLn stderr ""-  modify (\st -> st {reportStateCount = 0})+report = liftIO . hPutStrLn stderr  -- | Add intermediate output to the report. -- -- This will be overwritten by subsequent calls to `report`/`report_`. -- Intermediate out may not contain any newlines.-report_ :: String -> Report ()-report_ msg = do-  f <- gets reportStateInteractive-  when f $ do-    overwrite msg-    modify (\st -> st {reportStateCount = length msg})---- | Add output to the report, overwrite any intermediate out.-overwrite :: String -> Report ()-overwrite msg = do-  n <- gets reportStateCount-  let str | 0 < n     = "\r" ++ msg ++ replicate (n - length msg) ' '-          | otherwise = msg-  liftIO (hPutStr stderr str)+reportTransient :: String -> Report ()+reportTransient msg = gets reportStateInteractive >>= \ case+  NonInteractive -> pass+  Interactive -> liftIO $ do+    hPutStr stderr msg+    hFlush stderr+    hPutStr stderr $ '\r' : (replicate (length msg) ' ') ++ "\r"  -- | Run all examples from given module. runModule :: Bool -> Bool -> Interpreter -> Module [Located DocTest] -> Report () runModule fastMode preserveIt repl (Module module_ setup examples) = do -  Summary _ _ e0 f0 <- gets reportStateSummary+  Summary _ _ e0 f0 <- getSummary    forM_ setup $     runTestGroup preserveIt repl reload -  Summary _ _ e1 f1 <- gets reportStateSummary+  Summary _ _ e1 f1 <- getSummary    -- only run tests, if setup does not produce any errors/failures   when (e0 == e1 && f0 == f1) $@@ -171,19 +189,22 @@   updateSummary (Summary 0 1 0 0)  verboseReport :: String -> Report ()-verboseReport xs = do-  verbose <- gets reportStateVerbose-  when verbose $ report xs+verboseReport msg = gets reportStateVerbose >>= \ case+  NonVerbose -> pass+  Verbose -> report msg  updateSummary :: Summary -> Report () updateSummary summary = do-  ReportState n f v s <- get-  put (ReportState n f v $ s `mappend` summary)+  ref <- gets reportStateSummary+  liftIO $ modifyIORef' ref $ mappend summary+  reportProgress  reportProgress :: Report ()-reportProgress = do-  verbose <- gets reportStateVerbose-  when (not verbose) $ gets (show . reportStateSummary) >>= report_+reportProgress = gets reportStateVerbose >>= \ case+  NonVerbose -> do+    summary <- getSummary+    reportTransient (formatSummary summary)+  Verbose -> pass  -- | Run given test group. --@@ -191,9 +212,6 @@ -- can reuse the same 'Interpreter' for several test groups. runTestGroup :: Bool -> Interpreter -> IO () -> [Located DocTest] -> Report () runTestGroup preserveIt repl setup tests = do--  reportProgress-   liftIO setup   runExampleGroup preserveIt repl examples 

@@ -6,7 +6,6 @@ import           Test.Hspec import           System.IO.Silently -import           Control.Exception import           Data.List  import           Language.Haskell.GhciWrapper (Interpreter, Config(..), defaultConfig)

@@ -7,7 +7,6 @@ import           Test.Hspec import           Test.HUnit (assertEqual, Assertion) -import           Control.Exception import           System.Directory (getCurrentDirectory, setCurrentDirectory) import           System.FilePath import           Run hiding (doctest)@@ -27,7 +26,7 @@ doctestWithPreserveIt :: HasCallStack => Bool -> FilePath -> [String] -> Summary -> Assertion doctestWithPreserveIt preserveIt workingDir ghcOptions expected = do   actual <- withCurrentDirectory ("test/integration" </> workingDir) (hSilence [stderr] $ doctestWithResult defaultConfig {ghcOptions, preserveIt})-  assertEqual label expected actual+  assertEqual label (formatSummary expected) (formatSummary actual)   where     label = workingDir ++ " " ++ show ghcOptions 

@@ -1,89 +1,45 @@ {-# LANGUAGE CPP, OverloadedStrings #-}-module RunnerSpec (main, spec) where+module RunnerSpec (spec) where  import           Imports  import           Test.Hspec +import           Data.IORef import           System.IO-import           System.IO.Silently (hCapture)+import           System.IO.Silently (hCapture_) import           Control.Monad.Trans.State import           Runner -main :: IO ()-main = hspec spec--capture :: Report a -> IO String-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 False mempty)+capture :: Interactive -> Report a -> IO String+capture interactive action = do+  ref <- newIORef mempty+  hCapture_ [stderr] (evalStateT action (ReportState interactive NonVerbose ref))  spec :: Spec spec = do-   describe "report" $ do-     context "when mode is interactive" $ do-       it "writes to stderr" $ do-        capture $ do+        capture Interactive $ do           report "foobar"         `shouldReturn` "foobar\n" -      it "overwrites any intermediate output" $ do-        capture $ do-          report_ "foo"-          report  "bar"-        `shouldReturn` "foo\rbar\n"--      it "blank out intermediate output if necessary" $ do-        capture $ do-          report_ "foobar"-          report  "baz"-        `shouldReturn` "foobar\rbaz   \n"-     context "when mode is non-interactive" $ do       it "writes to stderr" $ do-        capture_ $ do+        capture NonInteractive $ do           report "foobar"         `shouldReturn` "foobar\n"    describe "report_" $ do-     context "when mode is interactive" $ do-      it "writes intermediate output to stderr" $ do-        capture $ do-          report_ "foobar"-        `shouldReturn` "foobar"--      it "overwrites any intermediate output" $ do-        capture $ do-          report_ "foo"-          report_ "bar"-        `shouldReturn` "foo\rbar"--      it "blank out intermediate output if necessary" $ do-        capture $ do-          report_ "foobar"-          report_  "baz"-        `shouldReturn` "foobar\rbaz   "+      it "writes transient output to stderr" $ do+        capture Interactive $ do+          reportTransient "foobar"+        `shouldReturn` "foobar\r      \r"      context "when mode is non-interactive" $ do       it "is ignored" $ do-        capture_ $ do-          report_ "foobar"+        capture NonInteractive $ do+          reportTransient "foobar"         `shouldReturn` ""--      it "does not influence a subsequent call to `report`" $ do-        capture_ $ do-          report_ "foo"-          report  "bar"-        `shouldReturn` "bar\n"--      it "does not require `report` to blank out any intermediate output" $ do-        capture_ $ do-          report_ "foobar"-          report  "baz"-        `shouldReturn` "baz\n"