diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,8 @@ +Changes in 0.20.0 + - Allow doctest to be invoked via `cabal repl --with-ghc=doctest` + - Include `ghc --info` output in `--info` + - Make `--info` output formatting consistent with GHC + Changes in 0.19.0 - Better support for `cabal v2-*` diff --git a/doctest.cabal b/doctest.cabal --- a/doctest.cabal +++ b/doctest.cabal @@ -1,11 +1,11 @@ -cabal-version: 2.0 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack name: doctest -version: 0.19.0 +version: 0.20.0 synopsis: Test interactive Haskell examples description: The doctest program checks examples in source code comments. It is modeled after doctest for Python (). @@ -20,18 +20,6 @@ author: Simon Hengel maintainer: quasicomputational@gmail.com, Andreas Abel build-type: Simple -tested-with: - GHC == 7.6.3 - , GHC == 7.8.4 - , GHC == 7.10.3 - , GHC == 8.0.2 - , GHC == 8.2.2 - , GHC == 8.4.4 - , GHC == 8.6.5 - , GHC == 8.8.4 - , GHC == 8.10.7 - , GHC == 9.0.1 - , GHC == 9.2.1 extra-source-files: example/example.cabal example/src/Example.hs @@ -127,6 +115,7 @@ other-modules: Extract GhcUtil + Info Interpreter Location Options @@ -138,6 +127,7 @@ Runner.Example Util Language.Haskell.GhciWrapper + Paths_doctest build-depends: base >=4.5 && <5 , base-compat >=0.7.0 @@ -155,6 +145,8 @@ executable doctest main-is: Main.hs + other-modules: + Paths_doctest ghc-options: -Wall -threaded hs-source-dirs: driver @@ -174,32 +166,11 @@ , transformers default-language: Haskell2010 -test-suite doctests - main-is: doctests.hs - type: exitcode-stdio-1.0 - ghc-options: -Wall -threaded - hs-source-dirs: - test - build-depends: - base >=4.5 && <5 - , base-compat >=0.7.0 - , code-page >=0.1 - , deepseq - , directory - , doctest - , exceptions - , filepath - , ghc >=7.0 && <9.3 - , ghc-paths >=0.1.0.9 - , process - , syb >=0.3 - , transformers - default-language: Haskell2010 - test-suite spec main-is: Spec.hs other-modules: ExtractSpec + InfoSpec InterpreterSpec LocationSpec MainSpec @@ -214,6 +185,7 @@ UtilSpec Extract GhcUtil + Info Interpreter Location Options @@ -226,6 +198,7 @@ Test.DocTest Util Language.Haskell.GhciWrapper + Paths_doctest type: exitcode-stdio-1.0 ghc-options: -Wall -threaded cpp-options: -DTEST diff --git a/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs b/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs --- a/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs +++ b/ghci-wrapper/src/Language/Haskell/GhciWrapper.hs @@ -54,23 +54,25 @@ setMode stdin_ setMode stdout_ let interpreter = Interpreter {hIn = stdin_, hOut = stdout_, process = processHandle} - _ <- eval interpreter "import qualified System.IO" - _ <- eval interpreter "import qualified GHC.IO.Handle" + evalThrow interpreter "import qualified System.IO" + evalThrow interpreter "import qualified GHC.IO.Encoding" + evalThrow interpreter "import qualified GHC.IO.Handle" -- The buffering of stdout and stderr is NoBuffering - _ <- eval interpreter "GHC.IO.Handle.hDuplicateTo System.IO.stdout System.IO.stderr" + evalThrow interpreter "GHC.IO.Handle.hDuplicateTo System.IO.stdout System.IO.stderr" -- Now the buffering of stderr is BlockBuffering Nothing -- In this situation, GHC 7.7 does not flush the buffer even when -- error happens. - _ <- eval interpreter "GHC.IO.Handle.hSetBuffering System.IO.stdout GHC.IO.Handle.LineBuffering" - _ <- eval interpreter "GHC.IO.Handle.hSetBuffering System.IO.stderr GHC.IO.Handle.LineBuffering" + evalThrow interpreter "GHC.IO.Handle.hSetBuffering System.IO.stdout GHC.IO.Handle.LineBuffering" + evalThrow interpreter "GHC.IO.Handle.hSetBuffering System.IO.stderr GHC.IO.Handle.LineBuffering" -- this is required on systems that don't use utf8 as default encoding (e.g. -- Windows) - _ <- eval interpreter "GHC.IO.Handle.hSetEncoding System.IO.stdout GHC.IO.Handle.utf8" - _ <- eval interpreter "GHC.IO.Handle.hSetEncoding System.IO.stderr GHC.IO.Handle.utf8" + evalThrow interpreter "GHC.IO.Handle.hSetEncoding System.IO.stdout GHC.IO.Encoding.utf8" + evalThrow interpreter "GHC.IO.Handle.hSetEncoding System.IO.stderr GHC.IO.Encoding.utf8" - _ <- eval interpreter ":m - System.IO" - _ <- eval interpreter ":m - GHC.IO.Handle" + evalThrow interpreter ":m - System.IO" + evalThrow interpreter ":m - GHC.IO.Encoding" + evalThrow interpreter ":m - GHC.IO.Handle" return interpreter where @@ -82,6 +84,13 @@ hSetBinaryMode h False hSetBuffering h LineBuffering hSetEncoding h utf8 + + evalThrow :: Interpreter -> String -> IO () + evalThrow interpreter expr = do + output <- eval interpreter expr + unless (null output || configVerbose) $ do + close interpreter + throwIO (ErrorCall output) close :: Interpreter -> IO () close repl = do diff --git a/src/Info.hs b/src/Info.hs new file mode 100644 --- /dev/null +++ b/src/Info.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE CPP #-} +module Info ( + versionInfo +, info +#ifdef TEST +, formatInfo +#endif +) where + +import Data.List.Compat +import System.Process +import System.IO.Unsafe + +#if __GLASGOW_HASKELL__ < 900 +import Config as GHC +#else +import GHC.Settings.Config as GHC +#endif + +import Data.Version (showVersion) +import qualified Paths_doctest + +import Interpreter (ghc) + +version :: String +version = showVersion Paths_doctest.version + +ghcVersion :: String +ghcVersion = GHC.cProjectVersion + +versionInfo :: String +versionInfo = unlines [ + "doctest version " ++ version + , "using version " ++ ghcVersion ++ " of the GHC API" + , "using " ++ ghc + ] + +info :: String +info = formatInfo $ + ("version", version) + : ("ghc_version", ghcVersion) + : ("ghc", ghc) + : ghcInfo + +type Info = [(String, String)] + +ghcInfo :: Info +ghcInfo = read $ unsafePerformIO (readProcess ghc ["--info"] "") + +formatInfo :: Info -> String +formatInfo xs = " [" ++ (intercalate "\n ," $ map show xs) ++ "\n ]\n" diff --git a/src/Interpreter.hs b/src/Interpreter.hs --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -47,6 +47,7 @@ -- Example: -- -- >>> withInterpreter [] $ \i -> eval i "23 + 42" +-- ... -- "65\n" withInterpreter :: [String] -- ^ List of flags, passed to GHC diff --git a/src/Options.hs b/src/Options.hs --- a/src/Options.hs +++ b/src/Options.hs @@ -12,6 +12,7 @@ , usage , info , versionInfo +, nonInteractiveGhcOptions #endif ) where @@ -22,16 +23,10 @@ import qualified Control.Monad.Trans.RWS as RWS import Control.Monad (when) -import Data.List.Compat (intercalate, stripPrefix) +import Data.List.Compat (stripPrefix) import Data.Monoid (Endo (Endo)) -#if __GLASGOW_HASKELL__ < 900 -import Config as GHC -#else -import GHC.Settings.Config as GHC -#endif - -import Interpreter (ghc) +import Info usage :: String usage = unlines [ @@ -50,31 +45,7 @@ , " --info output machine-readable version information and exit" ] -version :: String -#ifdef CURRENT_PACKAGE_VERSION -version = CURRENT_PACKAGE_VERSION -#else -version = "unknown" -#endif - -ghcVersion :: String -ghcVersion = GHC.cProjectVersion - -versionInfo :: String -versionInfo = unlines [ - "doctest version " ++ version - , "using version " ++ ghcVersion ++ " of the GHC API" - , "using " ++ ghc - ] - -info :: String -info = "[ " ++ (intercalate "\n, " . map show $ [ - ("version", version) - , ("ghc_version", ghcVersion) - , ("ghc", ghc) - ]) ++ "\n]\n" - -data Result a = Output String | Result a +data Result a = RunGhc [String] | Output String | Result a deriving (Eq, Show, Functor) type Warning = String @@ -88,6 +59,19 @@ , runVerbose :: Bool } deriving (Eq, Show) +nonInteractiveGhcOptions :: [String] +nonInteractiveGhcOptions = [ + "--numeric-version" + , "--supported-languages" + , "--info" + , "--print-global-package-db" + , "--print-libdir" + , "-c" + , "-o" + , "--make" + , "--abi-hash" + ] + defaultMagic :: Bool defaultMagic = True @@ -130,8 +114,17 @@ parseOptions :: [String] -> Result Run parseOptions args - | "--help" `elem` args = Output usage | "--info" `elem` args = Output info + | "--interactive" `elem` args = Result Run { + runWarnings = [] + , runOptions = filter (/= "--interactive") args + , runMagicMode = False + , runFastMode = False + , runPreserveIt = False + , runVerbose = False + } + | any (`elem` nonInteractiveGhcOptions) args = RunGhc args + | "--help" `elem` args = Output usage | "--version" `elem` args = Output versionInfo | otherwise = case execRWS parse () args of (xs, Endo setter) -> diff --git a/src/Run.hs b/src/Run.hs --- a/src/Run.hs +++ b/src/Run.hs @@ -18,6 +18,7 @@ import System.FilePath ((), takeExtension) import System.IO import System.IO.CodePage (withCP65001) +import System.Process (rawSystem) import qualified Control.Exception as E @@ -38,6 +39,7 @@ -- Example: -- -- >>> doctest ["-iexample/src", "example/src/Example.hs"] +-- ... -- Examples: 2 Tried: 2 Errors: 0 Failures: 0 -- -- This can be used to create a Cabal test suite that runs doctest for your @@ -47,6 +49,7 @@ -- 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 mapM_ (hPutStrLn stderr) warnings diff --git a/test/InfoSpec.hs b/test/InfoSpec.hs new file mode 100644 --- /dev/null +++ b/test/InfoSpec.hs @@ -0,0 +1,15 @@ +module InfoSpec (spec) where + +import Test.Hspec + +import System.Process + +import Info (formatInfo) +import Interpreter (ghc) + +spec :: Spec +spec = do + describe "formatInfo" $ do + it "formats --info output" $ do + info <- readProcess ghc ["--info"] "" + formatInfo (read info) `shouldBe` info diff --git a/test/OptionsSpec.hs b/test/OptionsSpec.hs --- a/test/OptionsSpec.hs +++ b/test/OptionsSpec.hs @@ -2,23 +2,43 @@ import Prelude () import Prelude.Compat +import Data.List.Compat import Test.Hspec import Test.QuickCheck import Options +newtype NonInteractive = NonInteractive String + deriving (Eq, Show) + +instance Arbitrary NonInteractive where + arbitrary = NonInteractive <$> elements (nonInteractiveGhcOptions \\ ["--info"]) + spec :: Spec spec = do describe "parseOptions" $ do 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 defaultVerbose) + parseOptions ["--optghc", "foobar"] `shouldBe` Result (Run warning ["foobar"] 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 defaultVerbose) + parseOptions ["--optghc=foobar"] `shouldBe` Result (Run warning ["foobar"] defaultMagic defaultFastMode defaultPreserveIt defaultVerbose) + + context "with ghc options that are not valid with --interactive" $ do + it "returns RunGhc" $ do + property $ \ (NonInteractive x) xs -> do + let options = x : xs + parseOptions options `shouldBe` RunGhc options + + context "with --interactive" $ do + let options = ["--interactive", "--foo", "--bar"] + + it "disables magic mode" $ do + runMagicMode <$> parseOptions options `shouldBe` Result False + + it "filters out --interactive" $ do + runOptions <$> parseOptions options `shouldBe` Result ["--foo", "--bar"] describe "--no-magic" $ do context "without --no-magic" $ do diff --git a/test/doctests.hs b/test/doctests.hs deleted file mode 100644 --- a/test/doctests.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Main where - -import Test.DocTest - -main :: IO () -main = doctest [ - "-packageghc" - , "-isrc" - , "-ighci-wrapper/src" - , "src/Run.hs" - , "src/PackageDBs.hs" - ]