doctest-0.25.0: test/RunSpec.hs

{-# LANGUAGE CPP #-}
module RunSpec (main, spec) where

import           Imports

import           Test.Hspec
import           System.Exit

import qualified Control.Exception as E
import           System.FilePath
import           System.Directory (getCurrentDirectory, setCurrentDirectory)
import           System.IO.Temp (withSystemTempDirectory)
import           Data.List (isPrefixOf, sort)

import           System.IO.Silently
import           System.IO (stderr)
import qualified Options

import           Run

withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory workingDir action = do
  E.bracket getCurrentDirectory setCurrentDirectory $ \_ -> do
    setCurrentDirectory workingDir
    action

main :: IO ()
main = hspec spec


removeLoadedPackageEnvironment :: String -> String
#if __GLASGOW_HASKELL__ < 810
removeLoadedPackageEnvironment = unlines . filter (not . isPrefixOf "Loaded package environment from ") . lines
#else
removeLoadedPackageEnvironment = id
#endif

verboseFibOutput :: String
verboseFibOutput = unlines [
    "### Started execution at test/integration/testSimple/Fib.hs:5."
  , "### example:"
  , "fib 10"
  , "### Successful!"
  , ""
  , "# Final summary:"
  , "Examples: 1  Tried: 1  Errors: 0  Failures: 0"
  ]

spec :: Spec
spec = do
  describe "doctest" $ do
    it "exits with ExitFailure if at least one test case fails" $ do
      hSilence [stderr] (doctest ["test/integration/failing/Foo.hs"]) `shouldThrow` (== ExitFailure 1)

    it "prints help on --help" $ do
      (r, ()) <- capture (doctest ["--help"])
      r `shouldBe` Options.usage

    it "prints version on --version" $ do
      (r, ()) <- capture (doctest ["--version"])
      lines r `shouldSatisfy` any (isPrefixOf "doctest version ")

    it "accepts arbitrary GHC options" $ do
      hSilence [stderr] $ doctest ["-cpp", "-DFOO", "test/integration/test-options/Foo.hs"]

    it "accepts GHC options with --optghc" $ do
      hSilence [stderr] $ doctest ["--optghc=-cpp", "--optghc=-DFOO", "test/integration/test-options/Foo.hs"]

    it "prints a deprecation message for --optghc" $ do
      (r, _) <- hCapture [stderr] $ doctest ["--optghc=-cpp", "--optghc=-DFOO", "test/integration/test-options/Foo.hs"]
      lines r `shouldSatisfy` isPrefixOf [
          "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options"
        , "directly."
        ]

    it "prints error message on invalid option" $ do
      (r, e) <- hCapture [stderr] . E.try $ doctest ["--foo", "test/integration/test-options/Foo.hs"]
      e `shouldBe` Left (ExitFailure 1)
      removeLoadedPackageEnvironment r `shouldBe` unlines [
          "doctest: unrecognized option `--foo'"
        , "Try `doctest --help' for more information."
        ]

    it "interprets GHC response files" $ do
      withSystemTempDirectory "hspec" $ \ dir -> do
        let file = dir </> "response-file"
        writeFile file $ unlines [
            "test/integration/testSimple/Fib.hs"
          ]
        (r, ()) <- hCapture [stderr] $ doctest ["--verbose", '@':file]
        removeLoadedPackageEnvironment r `shouldBe` verboseFibOutput

    it "prints verbose description of a specification" $ do
      (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/testSimple/Fib.hs"]
      removeLoadedPackageEnvironment r `shouldBe` verboseFibOutput

    it "prints verbose description of a property" $ do
      (r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/property-bool/Foo.hs"]
      removeLoadedPackageEnvironment 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)
      removeLoadedPackageEnvironment r `shouldBe` unlines [
              "### Started execution at test/integration/failing/Foo.hs:5."
            , "### example:"
            , "23"
            , "test/integration/failing/Foo.hs:5: failure in expression `23'"
            , "expected: 42"
            , " but got: 23"
            , "          ^"
            , ""
            , "# Final summary:"
            , "Examples: 1  Tried: 1  Errors: 0  Failures: 1"
        ]

#if __GLASGOW_HASKELL__ >= 802
    it "can deal with potentially problematic GHC options" $ do
      hSilence [stderr] $ doctest ["-fdiagnostics-color=always", "test/integration/color/Foo.hs"]
#endif

  describe "doctestWithResult" $ do
    context "on parse error" $ do
      let
        action :: IO Result
        action = withCurrentDirectory "test/integration/parse-error" $ do
          doctestWithResult defaultConfig {
              ghcOptions = [
                  "Foo.hs"

                -- This is necessary due to:
                --
                -- https://gitlab.haskell.org/ghc/ghc/-/commit/88f38b03025386f0f1e8f5861eed67d80495168a
                --
                -- It will be fixed by:
                --
                -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15995
                --
                , "-fdiagnostics-color=never"
#if __GLASGOW_HASKELL__ >= 910
                , "-fprint-error-index-links=never"
#endif
                ]
            }

      it "aborts with (ExitFailure 1)" $ do
        hSilence [stderr] action `shouldThrow` (== ExitFailure 1)

      it "prints a useful error message" $ do
        (r, _) <- hCapture [stderr] (E.try action :: IO (Either ExitCode Summary))
        removeLoadedPackageEnvironment r `shouldBe` unlines (
#if __GLASGOW_HASKELL__ < 910
          "" :
#endif
#if __GLASGOW_HASKELL__ >= 906
          [ "Foo.hs:6:1: error: [GHC-58481]"
#else
          [ "Foo.hs:6:1: error:"
#endif
          , "    parse error (possibly incorrect indentation or mismatched brackets)"
#if __GLASGOW_HASKELL__ >= 910
          , ""
#endif
          ])

  describe "expandDirs" $ do
    it "expands a directory" $ do
      res <- expandDirs "example"
      sort res `shouldBe`
        [ "example" </> "src" </> "Example.hs"
        , "example" </> "test" </> "doctests.hs"
        ]
    it "ignores files" $ do
      res <- expandDirs "doctest.cabal"
      res `shouldBe` ["doctest.cabal"]
    it "ignores random things" $ do
      let x = "foo bar baz bin"
      res <- expandDirs x
      res `shouldBe` [x]