doctest 0.21.1 → 0.22.0

raw patch · 23 files changed

+156/−110 lines, 23 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.markdown +3/−0
• LICENSE +1/−1
• doctest.cabal +23/−4
• src/Extract.hs +2/−2
• src/Interpreter.hs +0/−1
• src/Language/Haskell/GhciWrapper.hs +0/−1
• src/Location.hs +1/−1
• src/Options.hs +25/−15
• src/Parse.hs +11/−7
• src/Property.hs +0/−1
• src/Run.hs +43/−25
• src/Runner.hs +2/−0
• src/Test/DocTest.hs +1/−2
• src/Test/DocTest/Internal/Extract.hs +4/−0
• src/Test/DocTest/Internal/Location.hs +4/−0
• src/Test/DocTest/Internal/Parse.hs +4/−0
• src/Test/DocTest/Internal/Run.hs +4/−0
• test/ExtractSpec.hs +0/−2
• test/MainSpec.hs +3/−4
• test/OptionsSpec.hs +13/−13
• test/Orphans.hs +0/−16
• test/ParseSpec.hs +8/−10
• test/RunSpec.hs +4/−5

@@ -1,3 +1,6 @@+Changes in 0.22.0+  - Export more internals+ Changes in 0.21.1   - GHC 9.6 compatibility. 

@@ -1,4 +1,4 @@-Copyright (c) 2009-2022 Simon Hengel <sol@typeful.net>+Copyright (c) 2009-2023 Simon Hengel <sol@typeful.net>  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           doctest-version:        0.21.1+version:        0.22.0 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)@@ -18,9 +18,9 @@ homepage:       https://github.com/sol/doctest#readme license:        MIT license-file:   LICENSE-copyright:      (c) 2009-2022 Simon Hengel+copyright:      (c) 2009-2023 Simon Hengel author:         Simon Hengel <sol@typeful.net>-maintainer:     quasicomputational@gmail.com, Andreas Abel+maintainer:     Simon Hengel <sol@typeful.net> build-type:     Simple extra-source-files:     example/example.cabal@@ -111,8 +111,16 @@   ghc-options: -Wall   hs-source-dirs:       src+  default-extensions:+      NamedFieldPuns+      RecordWildCards+      DeriveFunctor   exposed-modules:       Test.DocTest+      Test.DocTest.Internal.Extract+      Test.DocTest.Internal.Location+      Test.DocTest.Internal.Parse+      Test.DocTest.Internal.Run   other-modules:       Extract       GhcUtil@@ -151,6 +159,10 @@   ghc-options: -Wall -threaded   hs-source-dirs:       driver+  default-extensions:+      NamedFieldPuns+      RecordWildCards+      DeriveFunctor   build-depends:       base >=4.5 && <5     , base-compat >=0.7.0@@ -177,7 +189,6 @@       LocationSpec       MainSpec       OptionsSpec-      Orphans       PackageDBsSpec       ParseSpec       PropertySpec@@ -199,6 +210,10 @@       Runner       Runner.Example       Test.DocTest+      Test.DocTest.Internal.Extract+      Test.DocTest.Internal.Location+      Test.DocTest.Internal.Parse+      Test.DocTest.Internal.Run       Util       Paths_doctest   type: exitcode-stdio-1.0@@ -207,6 +222,10 @@   hs-source-dirs:       test       src+  default-extensions:+      NamedFieldPuns+      RecordWildCards+      DeriveFunctor   c-sources:       test/integration/with-cbits/foo.c   build-tool-depends:

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}+{-# LANGUAGE CPP #-} module Extract (Module(..), extract) where  import           Prelude hiding (mod, concat)@@ -83,7 +83,7 @@   moduleName    :: String , moduleSetup   :: Maybe a , moduleContent :: [a]-} deriving (Eq, Functor)+} deriving (Eq, Show, Functor)  instance NFData a => NFData (Module a) where   rnf (Module name setup content) = name `deepseq` setup `deepseq` content `deepseq` ()

@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}- module Interpreter (   Interpreter , safeEval

@@ -1,4 +1,3 @@-{-# LANGUAGE RecordWildCards #-} module Language.Haskell.GhciWrapper (   Interpreter , Config(..)

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, DeriveFunctor #-}+{-# LANGUAGE CPP #-} module Location where  import           Control.DeepSeq (deepseq, NFData(rnf))

@@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFunctor #-} module Options (   Result(..) , Run(..)+, Config(..)+, defaultConfig , parseOptions #ifdef TEST , defaultRun@@ -42,20 +43,32 @@   , "  --info         output machine-readable version information and exit"   ] -data Result a = RunGhc [String] | Output String | Result a+data Result a = ProxyToGhc [String] | Output String | Result a   deriving (Eq, Show, Functor)  type Warning = String  data Run = Run {   runWarnings :: [Warning]-, runOptions :: [String] , runMagicMode :: Bool-, runFastMode :: Bool-, runPreserveIt :: Bool-, runVerbose :: Bool+, runConfig :: Config } deriving (Eq, Show) +data Config = Config {+  ghcOptions :: [String]+, fastMode :: Bool+, preserveIt :: Bool+, verbose :: Bool+} deriving (Eq, Show)++defaultConfig :: Config+defaultConfig = Config {+  ghcOptions = []+, fastMode = False+, preserveIt = False+, verbose = False+}+ nonInteractiveGhcOptions :: [String] nonInteractiveGhcOptions = [     "--numeric-version"@@ -72,37 +85,34 @@ defaultRun :: Run defaultRun = Run {   runWarnings = []-, runOptions = [] , runMagicMode = False-, runFastMode = False-, runPreserveIt = False-, runVerbose = False+, runConfig = defaultConfig }  modifyWarnings :: ([String] -> [String]) -> Run -> Run modifyWarnings f run = run { runWarnings = f (runWarnings run) }  setOptions :: [String] -> Run -> Run-setOptions opts run = run { runOptions = opts }+setOptions ghcOptions run@Run{..} = run { runConfig = runConfig { ghcOptions } }  setMagicMode :: Bool -> Run -> Run setMagicMode magic run = run { runMagicMode = magic }  setFastMode :: Bool -> Run -> Run-setFastMode fast run = run { runFastMode = fast }+setFastMode fastMode run@Run{..} = run { runConfig = runConfig { fastMode } }  setPreserveIt :: Bool -> Run -> Run-setPreserveIt preserveIt run = run { runPreserveIt = preserveIt }+setPreserveIt preserveIt run@Run{..} = run { runConfig = runConfig { preserveIt } }  setVerbose :: Bool -> Run -> Run-setVerbose verbose run = run { runVerbose = verbose }+setVerbose verbose run@Run{..} = run { runConfig = runConfig { verbose } }  parseOptions :: [String] -> Result Run parseOptions args   | on "--info" = Output info   | on "--interactive" = runRunOptionsParser (discard "--interactive" args) defaultRun $ do       commonRunOptions-  | on `any` nonInteractiveGhcOptions = RunGhc args+  | on `any` nonInteractiveGhcOptions = ProxyToGhc args   | on "--help" = Output usage   | on "--version" = Output versionInfo   | otherwise = runRunOptionsParser args defaultRun {runMagicMode = True} $ do

@@ -1,19 +1,20 @@-{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Parse (   Module (..) , DocTest (..)-, Interaction , Expression , ExpectedResult , ExpectedLine (..) , LineChunk (..)-, getDocTests+, extractDocTests+, parseModules --- * exported for testing+#ifdef TEST , parseInteractions , parseProperties , mkLineChunks+#endif ) where  import           Data.Char (isSpace)@@ -44,12 +45,15 @@  type Interaction = (Expression, ExpectedResult) - -- | -- Extract 'DocTest's from all given modules and all modules included by the -- given modules.-getDocTests :: [String] -> IO [Module [Located DocTest]]  -- ^ Extracted 'DocTest's-getDocTests args = parseModules <$> extract args+--+-- @+-- extractDocTests = fmap `parseModules` . `extract`+-- @+extractDocTests  :: [String] -> IO [Module [Located DocTest]]  -- ^ Extracted 'DocTest's+extractDocTests = fmap parseModules . extract  parseModules :: [Module (Located String)] -> [Module [Located DocTest]] parseModules = filter (not . isEmpty) . map parseModule

@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE PatternGuards #-} module Property (   runProperty , PropertyResult (..)

@@ -1,9 +1,19 @@ {-# LANGUAGE CPP #-} module Run (   doctest++, Config(..)+, defaultConfig+, doctestWith++, Result+, Summary(..)+, isSuccess+, evaluateResult+, doctestWithResult++, runDocTests #ifdef TEST-, doctestWithOptions-, Summary , expandDirs #endif ) where@@ -11,7 +21,7 @@ import           Prelude () import           Prelude.Compat -import           Control.Monad (when, unless)+import           Control.Monad import           System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents) import           System.Environment (getEnvironment) import           System.Exit (exitFailure, exitSuccess)@@ -30,8 +40,10 @@  import           PackageDBs import           Parse-import           Options+import           Options hiding (Result(..))+import qualified Options import           Runner+import           Location import qualified Interpreter  -- | Run doctest with given list of arguments.@@ -49,9 +61,9 @@ -- inside of it, ignoring hidden entries. doctest :: [String] -> IO () doctest args0 = case parseOptions args0 of-  RunGhc args -> rawSystem Interpreter.ghc args >>= E.throwIO-  Output s -> putStr s-  Result (Run warnings args_ magicMode fastMode preserveIt verbose) -> do+  Options.ProxyToGhc args -> rawSystem Interpreter.ghc args >>= E.throwIO+  Options.Output s -> putStr s+  Options.Result (Run warnings magicMode config) -> do     mapM_ (hPutStrLn stderr) warnings     hFlush stderr @@ -60,22 +72,14 @@       hPutStrLn stderr "WARNING: GHC does not support --interactive, skipping tests"       exitSuccess -    args <- case magicMode of-      False -> return args_+    opts <- case magicMode of+      False -> return (ghcOptions config)       True -> do-        expandedArgs <- concat <$> mapM expandDirs args_+        expandedArgs <- concat <$> mapM expandDirs (ghcOptions config)         packageDBArgs <- getPackageDBArgs         addDistArgs <- getAddDistArgs         return (addDistArgs $ packageDBArgs ++ expandedArgs)--    r <- doctestWithOptions fastMode preserveIt verbose args `E.catch` \e -> do-      case fromException e of-        Just (UsageError err) -> do-          hPutStrLn stderr ("doctest: " ++ err)-          hPutStrLn stderr "Try `doctest --help' for more information."-          exitFailure-        _ -> E.throwIO e-    when (not $ isSuccess r) exitFailure+    doctestWith config{ghcOptions = opts}  -- | Expand a reference to a directory to all .hs and .lhs files within it. expandDirs :: String -> IO [String]@@ -128,14 +132,28 @@                     else id) rest         else return id -isSuccess :: Summary -> Bool+doctestWith :: Config -> IO ()+doctestWith = doctestWithResult >=> evaluateResult++type Result = Summary++isSuccess :: Result -> Bool isSuccess s = sErrors s == 0 && sFailures s == 0 -doctestWithOptions :: Bool -> Bool -> Bool -> [String] -> IO Summary-doctestWithOptions fastMode preserveIt verbose args = do+evaluateResult :: Result -> IO ()+evaluateResult r = when (not $ isSuccess r) exitFailure -  -- get examples from Haddock comments-  modules <- getDocTests args+doctestWithResult :: Config -> IO Result+doctestWithResult config = do+  (extractDocTests (ghcOptions config) >>= runDocTests config) `E.catch` \e -> do+    case fromException e of+      Just (UsageError err) -> do+        hPutStrLn stderr ("doctest: " ++ err)+        hPutStrLn stderr "Try `doctest --help' for more information."+        exitFailure+      _ -> E.throwIO e -  Interpreter.withInterpreter args $ \repl -> withCP65001 $ do+runDocTests :: Config -> [Module [Located DocTest]] -> IO Result+runDocTests Config{..} modules = do+  Interpreter.withInterpreter ghcOptions $ \repl -> withCP65001 $ do     runModules fastMode preserveIt verbose repl modules

@@ -215,6 +215,8 @@     examples :: [Located Interaction]     examples = [Located loc (e, r) | Located loc (Example e r) <- tests] +type Interaction = (Expression, ExpectedResult)+ -- | -- Execute all expressions from given example in given 'Interpreter' and verify -- the output.

@@ -1,5 +1,4 @@ module Test.DocTest (   doctest ) where--import           Run+import Test.DocTest.Internal.Run

@@ -0,0 +1,4 @@+module Test.DocTest.Internal.Extract (+  module Extract+) where+import Extract

@@ -0,0 +1,4 @@+module Test.DocTest.Internal.Location (+  module Location+) where+import Location

@@ -0,0 +1,4 @@+module Test.DocTest.Internal.Parse (+  module Parse+) where+import Parse

@@ -0,0 +1,4 @@+module Test.DocTest.Internal.Run (+  module Run+) where+import Run

@@ -18,8 +18,6 @@ import           Location import           System.FilePath -import           Orphans ()- shouldGive :: HasCallStack => (String, String) -> [Module String] -> Assertion (d, m) `shouldGive` expected = do   r <- map (fmap unLoc) `fmap` extract ["-i" ++ dir, dir </> m]

@@ -8,7 +8,6 @@ import           Control.Exception import           System.Directory (getCurrentDirectory, setCurrentDirectory) import           System.FilePath-import           Runner (Summary(..)) import           Run hiding (doctest) import           System.IO.Silently import           System.IO@@ -24,11 +23,11 @@ doctest = doctestWithPreserveIt False  doctestWithPreserveIt :: HasCallStack => Bool -> FilePath -> [String] -> Summary -> Assertion-doctestWithPreserveIt preserveIt workingDir args expected = do-  actual <- withCurrentDirectory ("test/integration" </> workingDir) (hSilence [stderr] $ doctestWithOptions False preserveIt False args)+doctestWithPreserveIt preserveIt workingDir ghcOptions expected = do+  actual <- withCurrentDirectory ("test/integration" </> workingDir) (hSilence [stderr] $ doctestWithResult defaultConfig {ghcOptions, preserveIt})   assertEqual label expected actual   where-    label = workingDir ++ " " ++ show args+    label = workingDir ++ " " ++ show ghcOptions  cases :: Int -> Summary cases n = Summary n n 0 0

@@ -5,7 +5,7 @@ import           Data.List.Compat  import           Test.Hspec-import           Test.QuickCheck+import           Test.QuickCheck hiding (verbose)  import           Options @@ -20,10 +20,10 @@   describe "parseOptions" $ do     let       run :: [String] -> Run-      run options = defaultRun {+      run ghcOptions = defaultRun {         runWarnings = ["WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."]-      , runOptions = options       , runMagicMode = True+      , runConfig = defaultConfig { ghcOptions }       }      it "strips --optghc" $@@ -33,10 +33,10 @@       parseOptions ["--optghc=foobar"] `shouldBe` Result (run ["foobar"])      context "with ghc options that are not valid with --interactive" $ do-      it "returns RunGhc" $ do+      it "returns ProxyToGhc" $ do         property $ \ (NonInteractive x) xs -> do           let options = x : xs-          parseOptions options `shouldBe` RunGhc options+          parseOptions options `shouldBe` ProxyToGhc options      context "with --interactive" $ do       let options = ["--interactive", "--foo", "--bar"]@@ -45,10 +45,10 @@         runMagicMode <$> parseOptions options `shouldBe` Result False        it "filters out --interactive" $ do-        runOptions <$> parseOptions options `shouldBe` Result ["--foo", "--bar"]+        ghcOptions . runConfig <$> parseOptions options `shouldBe` Result ["--foo", "--bar"]        it "accepts --fast" $ do-        runFastMode <$> parseOptions ("--fast" : options) `shouldBe` Result True+        fastMode . runConfig <$> parseOptions ("--fast" : options) `shouldBe` Result True      describe "--no-magic" $ do       context "without --no-magic" $ do@@ -62,20 +62,20 @@     describe "--fast" $ do       context "without --fast" $ do         it "disables fast mode" $ do-          runFastMode <$> parseOptions [] `shouldBe` Result False+          fastMode . runConfig <$> parseOptions [] `shouldBe` Result False        context "with --fast" $ do         it "enabled fast mode" $ do-          runFastMode <$> parseOptions ["--fast"] `shouldBe` Result True+          fastMode . runConfig <$> parseOptions ["--fast"] `shouldBe` Result True      describe "--preserve-it" $ do       context "without --preserve-it" $ do         it "does not preserve the `it` variable" $ do-          runPreserveIt <$> parseOptions [] `shouldBe` Result False+          preserveIt . runConfig <$> parseOptions [] `shouldBe` Result False        context "with --preserve-it" $ do         it "preserves the `it` variable" $ do-          runPreserveIt <$> parseOptions ["--preserve-it"] `shouldBe` Result True+          preserveIt . runConfig <$> parseOptions ["--preserve-it"] `shouldBe` Result True      context "with --help" $ do       it "outputs usage information" $ do@@ -92,8 +92,8 @@     describe "--verbose" $ do       context "without --verbose" $ do         it "is not verbose by default" $ do-          runVerbose <$> parseOptions [] `shouldBe` Result False+          verbose . runConfig <$> parseOptions [] `shouldBe` Result False        context "with --verbose" $ do         it "parses verbose option" $ do-          runVerbose <$> parseOptions ["--verbose"] `shouldBe` Result True+          verbose . runConfig <$> parseOptions ["--verbose"] `shouldBe` Result True

@@ -1,16 +0,0 @@-{-# LANGUAGE StandaloneDeriving, FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Orphans where--import           Parse-import           Location---- The generic form------ > deriving instance Show a => Show (Module a)------ fails with GHC 7.0.1 due to an overlapping instance (leaked by the GHC API),--- this is why we derive the things we need individually.-deriving instance Show (Module String)-deriving instance Show (Module [DocTest])-deriving instance Show (Module [Located DocTest])

@@ -9,8 +9,6 @@ import           Parse import           Location -import           Orphans ()- main :: IO () main = hspec spec @@ -31,9 +29,9 @@  spec :: Spec spec = do-  describe "getDocTests" $ do+  describe "extractDocTests" $ do     it "extracts properties from a module" $ do-      getDocTests ["test/parse/property/Fib.hs"] `shouldGive` do+      extractDocTests ["test/parse/property/Fib.hs"] `shouldGive` do         module_ "Fib" $ do           group $ do             prop_ "foo"@@ -41,7 +39,7 @@             prop_ "baz"      it "extracts examples from a module" $ do-      getDocTests ["test/parse/simple/Fib.hs"] `shouldGive` do+      extractDocTests ["test/parse/simple/Fib.hs"] `shouldGive` do         module_ "Fib" $ do           group $ do             ghci "putStrLn \"foo\""@@ -52,7 +50,7 @@               "baz"      it "extracts examples from documentation for non-exported names" $ do-      getDocTests ["test/parse/non-exported/Fib.hs"] `shouldGive` do+      extractDocTests ["test/parse/non-exported/Fib.hs"] `shouldGive` do         module_ "Fib" $ do           group $ do             ghci "putStrLn \"foo\""@@ -63,7 +61,7 @@               "baz"      it "extracts multiple examples from a module" $ do-      getDocTests ["test/parse/multiple-examples/Foo.hs"] `shouldGive` do+      extractDocTests ["test/parse/multiple-examples/Foo.hs"] `shouldGive` do         module_ "Foo" $ do           group $ do             ghci "foo"@@ -73,17 +71,17 @@               "42"      it "returns an empty list, if documentation contains no examples" $ do-      getDocTests ["test/parse/no-examples/Fib.hs"] >>= (`shouldBe` [])+      extractDocTests ["test/parse/no-examples/Fib.hs"] >>= (`shouldBe` [])      it "sets setup code to Nothing, if it does not contain any tests" $ do-      getDocTests ["test/parse/setup-empty/Foo.hs"] `shouldGive` do+      extractDocTests ["test/parse/setup-empty/Foo.hs"] `shouldGive` do         module_ "Foo" $ do           group $ do             ghci "foo"               "23"      it "keeps modules that only contain setup code" $ do-      getDocTests ["test/parse/setup-only/Foo.hs"] `shouldGive` do+      extractDocTests ["test/parse/setup-only/Foo.hs"] `shouldGive` do         tell [Module "Foo" (Just [Example "foo" ["23"]]) []]    describe "parseInteractions (an internal function)" $ do

@@ -19,9 +19,6 @@  import           Run -doctestWithDefaultOptions :: [String] -> IO Summary-doctestWithDefaultOptions = doctestWithOptions False False False- withCurrentDirectory :: FilePath -> IO a -> IO a withCurrentDirectory workingDir action = do   E.bracket getCurrentDirectory setCurrentDirectory $ \_ -> do@@ -119,9 +116,11 @@       hSilence [stderr] $ doctest ["-fdiagnostics-color=always", "test/integration/color/Foo.hs"] #endif -  describe "doctestWithOptions" $ do+  describe "doctestWithResult" $ do     context "on parse error" $ do-      let action = withCurrentDirectory "test/integration/parse-error" (doctestWithDefaultOptions ["Foo.hs"])+      let+        action = withCurrentDirectory "test/integration/parse-error" $ do+          doctestWithResult defaultConfig { ghcOptions = ["Foo.hs"] }        it "aborts with (ExitFailure 1)" $ do         hSilence [stderr] action `shouldThrow` (== ExitFailure 1)