Add a test

Author: pepeiborra

ghcide/src/Development/IDE/Core/Rules.hs

@@ -148,8 +148,6 @@ import           Ide.Plugin.Properties                        (HasProperty,
 import           Ide.PluginUtils                              (configForPlugin)
 import           Ide.Types                                    (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser),
                                                                PluginId)
-import System.FilePath ((<.>))
-import GHC (ms_mod_name)
 
 -- | This is useful for rules to convert rules that can only produce errors or
 -- a result into the more general IdeResult type that supports producing

ghcide/test/data/boot2/A.hs

@@ -0,0 +1,12 @@
+module A where
+
+-- E source imports B
+-- In interface file see source module dependencies: B {-# SOURCE #-}
+import E
+-- C imports B
+-- In interface file see source module dependencies: B
+import C
+
+-- Instance for B only available from B.hi not B.hi-boot, so tests we load
+-- that.
+main = print B

ghcide/test/data/boot2/B.hs

@@ -0,0 +1,8 @@
+module B where
+
+import D
+
+data B = B
+
+instance Show B where
+  show B = "B"

ghcide/test/data/boot2/B.hs-boot

@@ -0,0 +1,3 @@
+module B where
+
+data B = B

ghcide/test/data/boot2/C.hs

@@ -0,0 +1,3 @@
+module C where
+
+import B

ghcide/test/data/boot2/D.hs

@@ -0,0 +1,3 @@
+module D where
+
+import {-# SOURCE #-} B

ghcide/test/data/boot2/E.hs

@@ -0,0 +1,3 @@
+module E(B(B)) where
+
+import {-# SOURCE #-} B

ghcide/test/data/boot2/hie.yaml

@@ -0,0 +1 @@
+cradle: {direct: {arguments: ["A.hs", "B.hs-boot", "B.hs", "C.hs", "D.hs", "E.hs"]}}

ghcide/test/exe/Main.hs

@@ -5277,25 +5277,28 @@ ifaceTests = testGroup "Interface loading tests"
     ]
 
 bootTests :: TestTree
-bootTests = testCase "boot-def-test" $ runWithExtraFiles "boot" $ \dir -> do
-  let cPath = dir </> "C.hs"
-  cSource <- liftIO $ readFileUtf8 cPath
-
-  -- Dirty the cache
-  liftIO $ runInDir dir $ do
-    cDoc <- createDoc cPath "haskell" cSource
-    _ <- getHover cDoc $ Position 4 3
-    ~() <- skipManyTill anyMessage $ satisfyMaybe $ \case
-      FromServerMess (SCustomMethod "ghcide/reference/ready") (NotMess NotificationMessage{_params = fp}) -> do
-        A.Success fp' <- pure $ fromJSON fp
-        if equalFilePath fp' cPath then pure () else Nothing
-      _ -> Nothing
-    closeDoc cDoc
-
-  cdoc <- createDoc cPath "haskell" cSource
-  locs <- getDefinitions cdoc (Position 7 4)
-  let floc = mkR 9 0 9 1
-  checkDefs locs (pure [floc])
+bootTests = testGroup "boot"
+  [ testCase "boot-def-test" $ runWithExtraFiles "boot" $ \dir -> do
+        let cPath = dir </> "C.hs"
+        cSource <- liftIO $ readFileUtf8 cPath
+        -- Dirty the cache
+        liftIO $ runInDir dir $ do
+            cDoc <- createDoc cPath "haskell" cSource
+            _ <- getHover cDoc $ Position 4 3
+            ~() <- skipManyTill anyMessage $ satisfyMaybe $ \case
+                FromServerMess (SCustomMethod "ghcide/reference/ready") (NotMess NotificationMessage{_params = fp}) -> do
+                    A.Success fp' <- pure $ fromJSON fp
+                    if equalFilePath fp' cPath then pure () else Nothing
+                _ -> Nothing
+            closeDoc cDoc
+        cdoc <- createDoc cPath "haskell" cSource
+        locs <- getDefinitions cdoc (Position 7 4)
+        let floc = mkR 9 0 9 1
+        checkDefs locs (pure [floc])
+  , testCase "graph with boot modules" $ runWithExtraFiles "boot2" $ \dir -> do
+      _ <- openDoc (dir </> "A.hs") "haskell"
+      expectNoMoreDiagnostics 2
+  ]
 
 -- | test that TH reevaluates across interfaces
 ifaceTHTest :: TestTree