Skip to content

Commit 986bc04

Browse files
jacgcocreature
authored andcommitted
Stop waiting in tests which don't need to (#145)
A while ago, `testSession` was modified to include a 0.5s wait, for the sake of tests which were looking for a specific and complete set of diagnostics, in order to ensure that all the incoming diagnostics had been received before the comparison was made. This made sense at a time when the vast majority of tests fit this pattern. Today we have plenty of tests which have no need for this. Hence: + `testSession` has been renamed to `testSessionWait` + a new `testSession` has been added, which does not wait at all + all tests which use `expectDiagnostics` have been modified to use `testSessionWait`, all other tests use the new delayless `testSession`. Locally this knocks almost 25% off the runtime of the full test suite.
1 parent 3284878 commit 986bc04

File tree

1 file changed

+18
-16
lines changed

1 file changed

+18
-16
lines changed

test/exe/Main.hs

Lines changed: 18 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -100,7 +100,7 @@ initializeResponseTests = withResource acquire release tests where
100100

101101
diagnosticTests :: TestTree
102102
diagnosticTests = testGroup "diagnostics"
103-
[ testSession "fix syntax error" $ do
103+
[ testSessionWait "fix syntax error" $ do
104104
let content = T.unlines [ "module Testing wher" ]
105105
doc <- openDoc' "Testing.hs" "haskell" content
106106
expectDiagnostics [("Testing.hs", [(DsError, (0, 15), "parse error")])]
@@ -111,7 +111,7 @@ diagnosticTests = testGroup "diagnostics"
111111
}
112112
changeDoc doc [change]
113113
expectDiagnostics [("Testing.hs", [])]
114-
, testSession "introduce syntax error" $ do
114+
, testSessionWait "introduce syntax error" $ do
115115
let content = T.unlines [ "module Testing where" ]
116116
doc <- openDoc' "Testing.hs" "haskell" content
117117
void (message :: Session ProgressStartNotification)
@@ -122,7 +122,7 @@ diagnosticTests = testGroup "diagnostics"
122122
}
123123
changeDoc doc [change]
124124
expectDiagnostics [("Testing.hs", [(DsError, (0, 15), "parse error")])]
125-
, testSession "variable not in scope" $ do
125+
, testSessionWait "variable not in scope" $ do
126126
let content = T.unlines
127127
[ "module Testing where"
128128
, "foo :: Int -> Int -> Int"
@@ -138,7 +138,7 @@ diagnosticTests = testGroup "diagnostics"
138138
]
139139
)
140140
]
141-
, testSession "type error" $ do
141+
, testSessionWait "type error" $ do
142142
let content = T.unlines
143143
[ "module Testing where"
144144
, "foo :: Int -> String -> Int"
@@ -150,7 +150,7 @@ diagnosticTests = testGroup "diagnostics"
150150
, [(DsError, (2, 14), "Couldn't match type '[Char]' with 'Int'")]
151151
)
152152
]
153-
, testSession "typed hole" $ do
153+
, testSessionWait "typed hole" $ do
154154
let content = T.unlines
155155
[ "module Testing where"
156156
, "foo :: Int -> String"
@@ -177,7 +177,7 @@ diagnosticTests = testGroup "diagnostics"
177177
expectedDs aMessage =
178178
[ ("A.hs", [(DsError, (2,4), aMessage)])
179179
, ("B.hs", [(DsError, (3,4), bMessage)])]
180-
deferralTest title binding msg = testSession title $ do
180+
deferralTest title binding msg = testSessionWait title $ do
181181
_ <- openDoc' "A.hs" "haskell" $ sourceA binding
182182
_ <- openDoc' "B.hs" "haskell" sourceB
183183
expectDiagnostics $ expectedDs msg
@@ -188,7 +188,7 @@ diagnosticTests = testGroup "diagnostics"
188188
, deferralTest "message shows error" "True" "A.hs:3:5: error:"
189189
]
190190

191-
, testSession "remove required module" $ do
191+
, testSessionWait "remove required module" $ do
192192
let contentA = T.unlines [ "module ModuleA where" ]
193193
docA <- openDoc' "ModuleA.hs" "haskell" contentA
194194
let contentB = T.unlines
@@ -203,7 +203,7 @@ diagnosticTests = testGroup "diagnostics"
203203
}
204204
changeDoc docA [change]
205205
expectDiagnostics [("ModuleB.hs", [(DsError, (1, 0), "Could not find module")])]
206-
, testSession "add missing module" $ do
206+
, testSessionWait "add missing module" $ do
207207
let contentB = T.unlines
208208
[ "module ModuleB where"
209209
, "import ModuleA"
@@ -213,7 +213,7 @@ diagnosticTests = testGroup "diagnostics"
213213
let contentA = T.unlines [ "module ModuleA where" ]
214214
_ <- openDoc' "ModuleA.hs" "haskell" contentA
215215
expectDiagnostics [("ModuleB.hs", [])]
216-
, testSession "cyclic module dependency" $ do
216+
, testSessionWait "cyclic module dependency" $ do
217217
let contentA = T.unlines
218218
[ "module ModuleA where"
219219
, "import ModuleB"
@@ -232,7 +232,7 @@ diagnosticTests = testGroup "diagnostics"
232232
, [(DsError, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
233233
)
234234
]
235-
, testSession "cyclic module dependency with hs-boot" $ do
235+
, testSessionWait "cyclic module dependency with hs-boot" $ do
236236
let contentA = T.unlines
237237
[ "module ModuleA where"
238238
, "import {-# SOURCE #-} ModuleB"
@@ -248,7 +248,7 @@ diagnosticTests = testGroup "diagnostics"
248248
_ <- openDoc' "ModuleB.hs" "haskell" contentB
249249
_ <- openDoc' "ModuleB.hs-boot" "haskell" contentBboot
250250
expectDiagnostics []
251-
, testSession "correct reference used with hs-boot" $ do
251+
, testSessionWait "correct reference used with hs-boot" $ do
252252
let contentB = T.unlines
253253
[ "module ModuleB where"
254254
, "import {-# SOURCE #-} ModuleA"
@@ -273,7 +273,7 @@ diagnosticTests = testGroup "diagnostics"
273273
_ <- openDoc' "ModuleA.hs-boot" "haskell" contentAboot
274274
_ <- openDoc' "ModuleC.hs" "haskell" contentC
275275
expectDiagnostics []
276-
, testSession "redundant import" $ do
276+
, testSessionWait "redundant import" $ do
277277
let contentA = T.unlines ["module ModuleA where"]
278278
let contentB = T.unlines
279279
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
@@ -287,7 +287,7 @@ diagnosticTests = testGroup "diagnostics"
287287
, [(DsWarning, (2, 0), "The import of 'ModuleA' is redundant")]
288288
)
289289
]
290-
, testSession "package imports" $ do
290+
, testSessionWait "package imports" $ do
291291
let thisDataListContent = T.unlines
292292
[ "module Data.List where"
293293
, "x = 123"
@@ -311,7 +311,7 @@ diagnosticTests = testGroup "diagnostics"
311311
]
312312
)
313313
]
314-
, testSession "unqualified warnings" $ do
314+
, testSessionWait "unqualified warnings" $ do
315315
let fooContent = T.unlines
316316
[ "{-# OPTIONS_GHC -Wredundant-constraints #-}"
317317
, "module Foo where"
@@ -768,8 +768,10 @@ xfail = flip expectFailBecause
768768

769769

770770
testSession :: String -> Session () -> TestTree
771-
testSession name =
772-
testCase name . run .
771+
testSession name = testCase name . run
772+
773+
testSessionWait :: String -> Session () -> TestTree
774+
testSessionWait name = testSession name .
773775
-- Check that any diagnostics produced were already consumed by the test case.
774776
--
775777
-- If in future we add test cases where we don't care about checking the diagnostics,

0 commit comments

Comments
 (0)