on master help sign in
Add more hie-core diagnostics tests (#2535)

* hie-core test: missing modules * hie-core test: variable not in scope * hie-core test: cyclic module dependency * hie-core test: redundant import * hie-core test: type error * hie-core test: reorganise test * hie-core test: factor out diagnostic tests * Display unexpected diagnostics

commitf8985134dbb00b804d5c9bea2ae6474182d7b1fa authorAndreas Herrmann <42969706+aherrmann-da@users.noreply.github.com> dateThu 15 Aug 2019, 11:35 (7 years ago) parentafcd1d9
2 files changed+99−4
test/exe/Main.hs+93−1 test/src/Development/IDE/Test.hs+6−3
test/exe/Main.hs+93−1
@@ -25,7 +25,13 @@ main = defaultMain $ testGroup "HIE"
2525 void (message :: Session ProgressStartNotification)
2626 closeDoc doc
2727 void (message :: Session ProgressDoneNotification)
28− , testSession "fix syntax error" $ do
28+ , diagnosticTests
29+ ]
30+
31+
32+diagnosticTests :: TestTree
33+diagnosticTests = testGroup "diagnostics"
34+ [ testSession "fix syntax error" $ do
2935 let content = T.unlines [ "module Testing wher" ]
3036 doc <- openDoc' "Testing.hs" "haskell" content
3137 expectDiagnostics [("Testing.hs", [(DsError, (0, 15), "parse error")])]
@@ -47,6 +53,92 @@ main = defaultMain $ testGroup "HIE"
4753 }
4854 changeDoc doc [change]
4955 expectDiagnostics [("Testing.hs", [(DsError, (0, 15), "parse error")])]
56+ , testSession "variable not in scope" $ do
57+ let content = T.unlines
58+ [ "module Testing where"
59+ , "foo :: Int -> Int -> Int"
60+ , "foo a b = a + ab"
61+ , "bar :: Int -> Int -> Int"
62+ , "bar a b = cd + b"
63+ ]
64+ _ <- openDoc' "Testing.hs" "haskell" content
65+ expectDiagnostics
66+ [ ( "Testing.hs"
67+ , [ (DsError, (2, 14), "Variable not in scope: ab")
68+ , (DsError, (4, 10), "Variable not in scope: cd")
69+ ]
70+ )
71+ ]
72+ , testSession "type error" $ do
73+ let content = T.unlines
74+ [ "module Testing where"
75+ , "foo :: Int -> String -> Int"
76+ , "foo a b = a + b"
77+ ]
78+ _ <- openDoc' "Testing.hs" "haskell" content
79+ expectDiagnostics
80+ [ ( "Testing.hs"
81+ , [(DsError, (2, 14), "Couldn't match type '[Char]' with 'Int'")]
82+ )
83+ ]
84+ , testSession "remove required module" $ do
85+ let contentA = T.unlines [ "module ModuleA where" ]
86+ docA <- openDoc' "ModuleA.hs" "haskell" contentA
87+ let contentB = T.unlines
88+ [ "module ModuleB where"
89+ , "import ModuleA"
90+ ]
91+ _ <- openDoc' "ModuleB.hs" "haskell" contentB
92+ let change = TextDocumentContentChangeEvent
93+ { _range = Just (Range (Position 0 0) (Position 0 20))
94+ , _rangeLength = Nothing
95+ , _text = ""
96+ }
97+ changeDoc docA [change]
98+ expectDiagnostics [("ModuleB.hs", [(DsError, (1, 0), "Could not find module")])]
99+ , testSession "add missing module" $ do
100+ let contentB = T.unlines
101+ [ "module ModuleB where"
102+ , "import ModuleA"
103+ ]
104+ _ <- openDoc' "ModuleB.hs" "haskell" contentB
105+ expectDiagnostics [("ModuleB.hs", [(DsError, (1, 7), "Could not find module")])]
106+ let contentA = T.unlines [ "module ModuleA where" ]
107+ _ <- openDoc' "ModuleA.hs" "haskell" contentA
108+ expectDiagnostics [("ModuleB.hs", [])]
109+ , testSession "cyclic module dependency" $ do
110+ let contentA = T.unlines
111+ [ "module ModuleA where"
112+ , "import ModuleB"
113+ ]
114+ let contentB = T.unlines
115+ [ "module ModuleB where"
116+ , "import ModuleA"
117+ ]
118+ _ <- openDoc' "ModuleA.hs" "haskell" contentA
119+ _ <- openDoc' "ModuleB.hs" "haskell" contentB
120+ expectDiagnostics
121+ [ ( "ModuleA.hs"
122+ , [(DsError, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
123+ )
124+ , ( "ModuleB.hs"
125+ , [(DsError, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
126+ )
127+ ]
128+ , testSession "redundant import" $ do
129+ let contentA = T.unlines ["module ModuleA where"]
130+ let contentB = T.unlines
131+ [ "{-# OPTIONS_GHC -Wunused-imports #-}"
132+ , "module ModuleB where"
133+ , "import ModuleA"
134+ ]
135+ _ <- openDoc' "ModuleA.hs" "haskell" contentA
136+ _ <- openDoc' "ModuleB.hs" "haskell" contentB
137+ expectDiagnostics
138+ [ ( "ModuleB.hs"
139+ , [(DsWarning, (2, 0), "The import of 'ModuleA' is redundant")]
140+ )
141+ ]
50142 ]
51143
52144
test/src/Development/IDE/Test.hs+6−3
@@ -52,9 +52,12 @@ expectDiagnostics expected = do
5252 diagsNot <- skipManyTill anyMessage LspTest.message :: Session PublishDiagnosticsNotification
5353 let fileUri = diagsNot ^. params . uri
5454 case Map.lookup (diagsNot ^. params . uri . to toNormalizedUri) m of
55− Nothing -> liftIO $ assertFailure $
56− "Got diagnostics for " <> show fileUri <>
57− " but only expected diagnostics for " <> show (Map.keys m)
55+ Nothing -> do
56+ let actual = diagsNot ^. params . diagnostics
57+ liftIO $ assertFailure $
58+ "Got diagnostics for " <> show fileUri <>
59+ " but only expected diagnostics for " <> show (Map.keys m) <>
60+ " got " <> show actual
5861 Just expected -> do
5962 let actual = diagsNot ^. params . diagnostics
6063 liftIO $ mapM_ (requireDiagnostic actual) expected