on master help sign in
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.

commit986bc04014ecf144f4de97c206be2724ed11f9f0 authorJacek Generowicz <jacg@my-post-office.net> dateTue 1 Oct 2019, 14:52 (7 years ago) parent3284878
1 file changed+18−16
test/exe/Main.hs+18−16
test/exe/Main.hs+18−16
@@ -100,7 +100,7 @@ initializeResponseTests = withResource acquire release tests where
100100
101101diagnosticTests :: TestTree
102102diagnosticTests = 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
770770testSession :: 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,