Skip to content

Commit 254b4b6

Browse files
committed
Test that the linkables are being produced
1 parent 6a4eece commit 254b4b6

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
@@ -101,7 +101,7 @@ test-suite tests
101101
default-language: Haskell2010
102102
hs-source-dirs: test
103103
main-is: Main.hs
104-
ghc-options: -threaded -rtsopts -with-rtsopts=-N
104+
ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts
105105
build-depends:
106106
, aeson
107107
, 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)
@@ -178,6 +179,25 @@ tests =
178179
"Ord Foo" `isInfixOf` output @? "Output does not include instance Ord Foo"
179180
not ("Baz Foo" `isInfixOf` output) @? "Output includes instance Baz Foo"
180181
]
182+
183+
184+
, testCase "Interfaces are reused after Eval" $ do
185+
runS evalPlugin testDataDir $ do
186+
doc <- openDoc "TLocalImport.hs" "haskell"
187+
waitForTypecheck doc
188+
lenses <- getCodeLenses doc
189+
let ~cmds@[cmd] = lenses^..folded.command._Just
190+
liftIO $ cmds^..folded.title @?= ["Evaluate..."]
191+
192+
executeCmd cmd
193+
194+
-- trigger a rebuild and check that dependency interfaces are not rebuilt
195+
changeDoc doc []
196+
waitForTypecheck doc
197+
Right keys <- getLastBuildKeys
198+
let ifaceKeys = filter ("GetModIface" `T.isPrefixOf`) keys
199+
liftIO $ ifaceKeys @?= []
200+
181201
]
182202

183203
goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree

0 commit comments

Comments
 (0)