Merge pull request #3814 from fendor/fix/flaky-hie-bios-test

Fix flaky hie bios test
haskell · Sep 20, 2023 · 552be36 · 552be36
2 parents a734e1a + d1a1471
commit 552be36
Show file tree

Hide file tree

Showing 5 changed files with 15 additions and 29 deletions.
diff --git a/test/functional/HieBios.hs b/test/functional/HieBios.hs
@@ -5,32 +5,15 @@ import           Control.Lens               ((^.))
 import           Control.Monad.IO.Class
 import qualified Data.Text                  as T
 import qualified Language.LSP.Protocol.Lens as L
-import           System.FilePath            ((</>))
 import           Test.Hls
 import           Test.Hls.Command
 
-
 tests :: TestTree
-tests = testGroup "hie-bios" [
-    testCase "loads modules inside main-is" $ do
-        writeFile (hieBiosErrorPath </> "hie.yaml") ""
-        runSession hlsCommand fullCaps "test/testdata/hieBiosMainIs" $ do
-            doc <- openDoc "Main.hs" "haskell"
-            Just mainHoverText <- getHover doc (Position 3 1)
-            let hoverContents = mainHoverText ^. L.contents
-            case hoverContents of
-                 (InL (MarkupContent _ x)) -> do
-                    liftIO $ "main :: IO ()" `T.isInfixOf` x
-                            @? "found hover text for main"
-                 _ -> error $ "Unexpected hover contents: " ++ show hoverContents
-
-    , expectFailBecause "hie-bios 0.11 has poor error messages" $ testCase "reports errors in hie.yaml" $ do
-        writeFile (hieBiosErrorPath </> "hie.yaml") ""
-        runSession hlsCommand fullCaps hieBiosErrorPath $ do
-            _ <- openDoc "Foo.hs" "haskell"
-            (diag:_) <- waitForDiagnostics
-            liftIO $ "Expected a cradle: key containing the preferences" `T.isInfixOf` (diag ^. L.message)
-                     @? "Error reported"
-    ]
-    where
-        hieBiosErrorPath = "test/testdata/hieBiosError"
+tests = testGroup "hie-bios"
+  [ testCase "loads main-is module" $ do
+    runSession hlsCommand fullCaps "test/testdata/hieBiosMainIs" $ do
+      _ <- openDoc "Main.hs" "haskell"
+      (diag:_) <- waitForDiagnostics
+      liftIO $ "Top-level binding with no type signature:" `T.isInfixOf` (diag ^. L.message)
+        @? "Expected missing top-level binding diagnostic"
+  ]
diff --git a/test/testdata/hieBiosError/Foo.hs b/test/testdata/hieBiosError/Foo.hs
diff --git a/test/testdata/hieBiosMainIs/Main.hs b/test/testdata/hieBiosMainIs/Main.hs
@@ -1,4 +1,6 @@
-module Main where
+module Main (main) where
 
 main :: IO ()
-main = putStrLn "Hello, Haskell!"
+main = print foo
+
+foo = 5 :: Int
diff --git a/test/testdata/hieBiosMainIs/cabal.project b/test/testdata/hieBiosMainIs/cabal.project
@@ -0,0 +1 @@
+packages: .
diff --git a/test/testdata/hieBiosMainIs/hieBiosMainIs.cabal b/test/testdata/hieBiosMainIs/hieBiosMainIs.cabal
@@ -4,5 +4,6 @@ version:             0.1.0.0
 build-type:          Simple
 executable hieBiosMainIs
   main-is:             Main.hs
-  build-depends:       base >=4.12 && <4.13
+  build-depends:       base
   default-language:    Haskell2010
+  ghc-options:         -Wall