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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
module MainSpec (main, spec) where
import Imports
import Test.Hspec
import Test.HUnit (assertEqual, Assertion)
import Control.Exception
import System.Directory (getCurrentDirectory, setCurrentDirectory)
import System.FilePath
import Run hiding (doctest)
import System.IO.Silently
import System.IO
withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory workingDir action = do
bracket getCurrentDirectory setCurrentDirectory $ \_ -> do
setCurrentDirectory workingDir
action
-- | Construct a doctest specific 'Assertion'.
doctest :: HasCallStack => FilePath -> [String] -> Summary -> Assertion
doctest = doctestWithPreserveIt False
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
where
label = workingDir ++ " " ++ show ghcOptions
cases :: Int -> Summary
cases n = Summary n n 0 0
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "doctest" $ do
it "testSimple" $ do
doctest "." ["testSimple/Fib.hs"]
(cases 1)
it "it-variable" $ do
doctestWithPreserveIt True "." ["it/Foo.hs"]
(cases 5)
it "it-variable in $setup" $ do
doctestWithPreserveIt True "." ["it/Setup.hs"]
(cases 5)
it "failing" $ do
doctest "." ["failing/Foo.hs"]
(cases 1) {sFailures = 1}
it "skips subsequent examples from the same group if an example fails" $
doctest "." ["failing-multiple/Foo.hs"]
(cases 4) {sTried = 2, sFailures = 1}
it "testImport" $ do
doctest "testImport" ["ModuleA.hs"]
(cases 3)
doctest ".." ["-iintegration/testImport", "integration/testImport/ModuleA.hs"]
(cases 3)
it "testCommentLocation" $ do
doctest "." ["testCommentLocation/Foo.hs"]
(cases 11)
it "testPutStr" $ do
doctest "testPutStr" ["Fib.hs"]
(cases 3)
it "fails on multi-line expressions, introduced with :{" $ do
doctest "testFailOnMultiline" ["Fib.hs"]
(cases 2) {sErrors = 2}
it "testBlankline" $ do
doctest "testBlankline" ["Fib.hs"]
(cases 1)
it "examples from the same Haddock comment share the same scope" $ do
doctest "testCombinedExample" ["Fib.hs"]
(cases 4)
it "testDocumentationForArguments" $ do
doctest "testDocumentationForArguments" ["Fib.hs"]
(cases 1)
it "template-haskell" $ do
doctest "template-haskell" ["Foo.hs"]
(cases 2)
it "handles source files with CRLF line endings" $ do
doctest "dos-line-endings" ["Fib.hs"]
(cases 1)
it "runs $setup before each test group" $ do
doctest "setup" ["Foo.hs"]
(cases 2)
it "skips subsequent tests from a module, if $setup fails" $ do
doctest "setup-skip-on-failure" ["Foo.hs"]
(cases 3) {sTried = 1, sFailures = 1}
-- Andreas, 2021-02-27, see issue #294.
-- This test case contains a hard-wired path that does not work
-- with v2-cabal.
-- I tested it under v2-cabal with a very non-portable path.
-- Deactivating the test case until a systematic solution is found...
--
-- it "works with additional object files" $ do
-- -- -- Path for v1-cabal:
-- -- doctest "with-cbits" ["Bar.hs", "../../../dist/build/spec/spec-tmp/test/integration/with-cbits/foo.o"]
-- -- -- Path for v2-cabal with ghc-9.0.1
-- -- doctest "with-cbits" ["Bar.hs", "../../../dist-newstyle/build/x86_64-osx/ghc-9.0.1/doctest-0.19/t/spec/build/spec/spec-tmp/Test/integration/with-cbits/foo.o"]
-- (cases 1)
it "ignores trailing whitespace when matching test output" $ do
doctest "trailing-whitespace" ["Foo.hs"]
(cases 1)
describe "doctest as a runner for QuickCheck properties" $ do
it "runs a boolean property" $ do
doctest "property-bool" ["Foo.hs"]
(cases 1)
it "runs an explicitly quantified property" $ do
doctest "property-quantified" ["Foo.hs"]
(cases 1)
it "runs an implicitly quantified property" $ do
doctest "property-implicitly-quantified" ["Foo.hs"]
(cases 1)
it "reports a failing property" $ do
doctest "property-failing" ["Foo.hs"]
(cases 1) {sFailures = 1}
it "runs a boolean property with an explicit type signature" $ do
doctest "property-bool-with-type-signature" ["Foo.hs"]
(cases 1)
it "runs $setup before each property" $ do
doctest "property-setup" ["Foo.hs"]
(cases 3)
describe "doctest (regression tests)" $ do
it "bugfixWorkingDirectory" $ do
doctest "bugfixWorkingDirectory" ["Fib.hs"]
(cases 1)
doctest "bugfixWorkingDirectory" ["examples/Fib.hs"]
(cases 2)
it "bugfixOutputToStdErr" $ do
doctest "bugfixOutputToStdErr" ["Fib.hs"]
(cases 2)
it "bugfixImportHierarchical" $ do
doctest "bugfixImportHierarchical" ["ModuleA.hs", "ModuleB.hs"]
(cases 3)
it "bugfixMultipleModules" $ do
doctest "bugfixMultipleModules" ["ModuleA.hs"]
(cases 5)
it "testCPP" $ do
doctest "testCPP" ["-cpp", "Foo.hs"]
(cases 1) {sFailures = 1}
doctest "testCPP" ["-cpp", "-DFOO", "Foo.hs"]
(cases 1)
it "template-haskell-bugfix" $ do
doctest "template-haskell-bugfix" ["Main.hs"]
(cases 2)
it "doesn't clash with user bindings of stdout/stderr" $ do
doctest "local-stderr-binding" ["A.hs"]
(cases 1)
it "doesn't get confused by doctests using System.IO imports" $ do
doctest "system-io-imported" ["A.hs"]
(cases 1)
|
