Test that the linkables are being produced

haskell · Oct 24, 2021 · ed4413c · ed4413c
1 parent c3d1fae
commit ed4413c
Show file tree

Hide file tree

Showing 3 changed files with 25 additions and 4 deletions.
diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal
@@ -100,7 +100,7 @@ test-suite tests
   default-language: Haskell2010
   hs-source-dirs:   test
   main-is:          Main.hs
-  ghc-options:      -threaded -rtsopts -with-rtsopts=-N
+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts
   build-depends:
     , aeson
     , base

diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs
@@ -27,7 +27,7 @@ module Ide.Plugin.Eval.CodeLens (
 
 import           Control.Applicative             (Alternative ((<|>)))
 import           Control.Arrow                   (second, (>>>))
-import           Control.Exception               (try)
+import           Control.Exception               (assert, try)
 import qualified Control.Exception               as E
 import           Control.Lens                    (_1, _3, (%~), (<&>), (^.))
 import           Control.Monad                   (guard, join, void, when)
@@ -38,7 +38,7 @@ import           Data.Char                       (isSpace)
 import qualified Data.HashMap.Strict             as HashMap
 import           Data.List                       (dropWhileEnd, find,
                                                   intercalate, intersperse)
-import           Data.Maybe                      (catMaybes, fromMaybe)
+import           Data.Maybe                      (catMaybes, fromMaybe, isJust)
 import           Data.String                     (IsString)
 import           Data.Text                       (Text)
 import qualified Data.Text                       as T
@@ -539,6 +539,7 @@ ghcSessionDepsDefinition env file = do
         deps <- use_ GetDependencies file
         let tdeps = transitiveModuleDeps deps
         ifaces <- uses_ GetModIface tdeps
+        liftIO $ assert (all (isJust . hm_linkable . hirHomeMod) ifaces) $ pure ()
 
         -- Currently GetDependencies returns things in topological order so A comes before B if A imports B.
         -- We need to reverse this as GHC gets very unhappy otherwise and complains about broken interfaces.

diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs
@@ -7,7 +7,8 @@ module Main
   ( main
   ) where
 
-import           Control.Lens            (_Just, preview, toListOf, view)
+import           Control.Lens            (_Just, folded, preview, toListOf,
+                                          view, (^..))
 import           Data.Aeson              (fromJSON)
 import           Data.Aeson.Types        (Result (Success))
 import           Data.List               (isInfixOf)
@@ -177,6 +178,25 @@ tests =
         "Ord Foo" `isInfixOf` output                @? "Output does not include instance Ord Foo"
         not ("Baz Foo" `isInfixOf` output)          @? "Output includes instance Baz Foo"
     ]
+
+
+  , testCase "Interfaces are reused after Eval" $ do
+      runS evalPlugin testDataDir $ do
+        doc <- openDoc "TLocalImport.hs" "haskell"
+        waitForTypecheck doc
+        lenses <- getCodeLenses doc
+        let ~cmds@[cmd] = lenses^..folded.command._Just
+        liftIO $ cmds^..folded.title @?= ["Evaluate..."]
+
+        executeCmd cmd
+
+        -- trigger a rebuild and check that dependency interfaces are not rebuilt
+        changeDoc doc []
+        waitForTypecheck doc
+        Right keys <- getLastBuildKeys
+        let ifaceKeys = filter ("GetModIface" `T.isPrefixOf`) keys
+        liftIO $ ifaceKeys @?= []
+
   ]
 
 goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree