Skip to content

Commit ed4413c

Browse files
committed
Test that the linkables are being produced
1 parent c3d1fae commit ed4413c

File tree

3 files changed

+25
-4
lines changed

3 files changed

+25
-4
lines changed

plugins/hls-eval-plugin/hls-eval-plugin.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -100,7 +100,7 @@ test-suite tests
100100
default-language: Haskell2010
101101
hs-source-dirs: test
102102
main-is: Main.hs
103-
ghc-options: -threaded -rtsopts -with-rtsopts=-N
103+
ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts
104104
build-depends:
105105
, aeson
106106
, base

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ module Ide.Plugin.Eval.CodeLens (
2727

2828
import Control.Applicative (Alternative ((<|>)))
2929
import Control.Arrow (second, (>>>))
30-
import Control.Exception (try)
30+
import Control.Exception (assert, try)
3131
import qualified Control.Exception as E
3232
import Control.Lens (_1, _3, (%~), (<&>), (^.))
3333
import Control.Monad (guard, join, void, when)
@@ -38,7 +38,7 @@ import Data.Char (isSpace)
3838
import qualified Data.HashMap.Strict as HashMap
3939
import Data.List (dropWhileEnd, find,
4040
intercalate, intersperse)
41-
import Data.Maybe (catMaybes, fromMaybe)
41+
import Data.Maybe (catMaybes, fromMaybe, isJust)
4242
import Data.String (IsString)
4343
import Data.Text (Text)
4444
import qualified Data.Text as T
@@ -539,6 +539,7 @@ ghcSessionDepsDefinition env file = do
539539
deps <- use_ GetDependencies file
540540
let tdeps = transitiveModuleDeps deps
541541
ifaces <- uses_ GetModIface tdeps
542+
liftIO $ assert (all (isJust . hm_linkable . hirHomeMod) ifaces) $ pure ()
542543

543544
-- Currently GetDependencies returns things in topological order so A comes before B if A imports B.
544545
-- We need to reverse this as GHC gets very unhappy otherwise and complains about broken interfaces.

plugins/hls-eval-plugin/test/Main.hs

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,8 @@ module Main
77
( main
88
) where
99

10-
import Control.Lens (_Just, preview, toListOf, view)
10+
import Control.Lens (_Just, folded, preview, toListOf,
11+
view, (^..))
1112
import Data.Aeson (fromJSON)
1213
import Data.Aeson.Types (Result (Success))
1314
import Data.List (isInfixOf)
@@ -177,6 +178,25 @@ tests =
177178
"Ord Foo" `isInfixOf` output @? "Output does not include instance Ord Foo"
178179
not ("Baz Foo" `isInfixOf` output) @? "Output includes instance Baz Foo"
179180
]
181+
182+
183+
, testCase "Interfaces are reused after Eval" $ do
184+
runS evalPlugin testDataDir $ do
185+
doc <- openDoc "TLocalImport.hs" "haskell"
186+
waitForTypecheck doc
187+
lenses <- getCodeLenses doc
188+
let ~cmds@[cmd] = lenses^..folded.command._Just
189+
liftIO $ cmds^..folded.title @?= ["Evaluate..."]
190+
191+
executeCmd cmd
192+
193+
-- trigger a rebuild and check that dependency interfaces are not rebuilt
194+
changeDoc doc []
195+
waitForTypecheck doc
196+
Right keys <- getLastBuildKeys
197+
let ifaceKeys = filter ("GetModIface" `T.isPrefixOf`) keys
198+
liftIO $ ifaceKeys @?= []
199+
180200
]
181201

182202
goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree

0 commit comments

Comments
 (0)