git.iko.soy/ghcide
on master help sign in
ghcide: make tests fail on unexpected diagnostic messages (#2813) (#2823)

This has the downside of relying on a timeout, experimentally tuned to be 0.5s, as we have no other way of knowing when the server has finished sending us messages.

commit61760936f9a96e42bbd73b2d0b5def0ce663a89f authorGanesh Sittampalam <ganesh@earth.li> dateMon 9 Sep 2019, 19:24 (7 years ago) parent5da86c3
3 files changed+38−1
compare with master
unifiedsplit
test/BUILD.bazel+1 test/exe/Main.hs+9−1 test/src/Development/IDE/Test.hs+28
test/BUILD.bazel+1
@@ -12,6 +12,7 @@ da_haskell_library(
1212 srcs = glob(["src/**/*.hs"]),
1313 hackage_deps = [
1414 "base",
15+ "extra",
1516 "containers",
1617 "haskell-lsp-types",
1718 "lens",
test/exe/Main.hs+9−1
@@ -147,7 +147,15 @@ diagnosticTests = testGroup "diagnostics"
147147
148148
149149testSession :: String -> Session () -> TestTree
150−testSession name = testCase name . run
150+testSession name =
151+ testCase name . run .
152+ -- Check that any diagnostics produced were already consumed by the test case.
153+ --
154+ -- If in future we add test cases where we don't care about checking the diagnostics,
155+ -- this could move elsewhere.
156+ --
157+ -- Experimentally, 0.5s seems to be long enough to wait for any final diagnostics to appear.
158+ ( >> expectNoMoreDiagnostics 0.5)
151159
152160
153161run :: Session a -> IO a
test/src/Development/IDE/Test.hs+28
@@ -6,6 +6,7 @@ module Development.IDE.Test
66 , cursorPosition
77 , requireDiagnostic
88 , expectDiagnostics
9+ , expectNoMoreDiagnostics
910 ) where
1011
1112import Control.Applicative.Combinators
@@ -18,6 +19,7 @@ import Language.Haskell.LSP.Test hiding (message, openDoc')
1819import qualified Language.Haskell.LSP.Test as LspTest
1920import Language.Haskell.LSP.Types
2021import Language.Haskell.LSP.Types.Lens as Lsp
22+import System.Time.Extra
2123import Test.Tasty.HUnit
2224
2325
@@ -41,6 +43,32 @@ requireDiagnostic actuals expected@(severity, cursor, expectedMsg) = do
4143 && standardizeQuotes (T.toLower expectedMsg) `T.isInfixOf`
4244 standardizeQuotes (T.toLower $ d ^. message)
4345
46+-- |wait for @timeout@ seconds and report an assertion failure
47+-- if any diagnostic messages arrive in that period
48+expectNoMoreDiagnostics :: Seconds -> Session ()
49+expectNoMoreDiagnostics timeout = do
50+ -- Give any further diagnostic messages time to arrive.
51+ liftIO $ sleep timeout
52+ -- Send a dummy message to provoke a response from the server.
53+ -- This guarantees that we have at least one message to
54+ -- process, so message won't block or timeout.
55+ void $ sendRequest (CustomClientMethod "non-existent-method") ()
56+ handleMessages
57+ where
58+ handleMessages = handleDiagnostic <|> handleCustomMethodResponse <|> ignoreOthers
59+ handleDiagnostic = do
60+ diagsNot <- LspTest.message :: Session PublishDiagnosticsNotification
61+ let fileUri = diagsNot ^. params . uri
62+ actual = diagsNot ^. params . diagnostics
63+ liftIO $ assertFailure $
64+ "Got unexpected diagnostics for " <> show fileUri <>
65+ " got " <> show actual
66+ handleCustomMethodResponse =
67+ -- the CustomClientMethod triggers a log message about ignoring it
68+ -- handle that and then exit
69+ void (LspTest.message :: Session LogMessageNotification)
70+ ignoreOthers = void anyMessage >> handleMessages
71+
4472expectDiagnostics :: [(FilePath, [(DiagnosticSeverity, Cursor, T.Text)])] -> Session ()
4573expectDiagnostics expected = do
4674 expected' <- Map.fromListWith (<>) <$> traverseOf (traverse . _1) (fmap toNormalizedUri . getDocUri) expected