1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
{-# 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 Data.List (isPrefixOf, sort)
import Data.Char
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
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 "prints verbose description of a specification" $ do
(r, ()) <- hCapture [stderr] $ doctest ["--verbose", "test/integration/testSimple/Fib.hs"]
removeLoadedPackageEnvironment 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"]
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 = withCurrentDirectory "test/integration/parse-error" $ do
doctestWithResult defaultConfig { ghcOptions = ["Foo.hs"] }
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))
stripAnsiColors (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]
stripAnsiColors :: String -> String
stripAnsiColors xs = case xs of
'\ESC' : '[' : ';' : ys | 'm' : zs <- dropWhile isNumber ys -> stripAnsiColors zs
'\ESC' : '[' : ys | 'm' : zs <- dropWhile isNumber ys -> stripAnsiColors zs
y : ys -> y : stripAnsiColors ys
[] -> []
|
