Skip to content

Commit acbe401

Browse files
committed
Enable CI for hls-eval-plugin and fix a bug due to clearing of mi_globals
1 parent f17707c commit acbe401

File tree

3 files changed

+27
-12
lines changed

3 files changed

+27
-12
lines changed

.github/workflows/test.yml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -148,7 +148,7 @@ jobs:
148148
name: Test hls-pragmas-plugin
149149
run: cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-pragmas-plugin --test-options="$TEST_OPTS"
150150

151-
- if: matrix.test && matrix.ghc != '9.4.4'
151+
- if: matrix.test
152152
name: Test hls-eval-plugin
153153
run: cabal test hls-eval-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="$TEST_OPTS"
154154

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

Lines changed: 17 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,9 @@ import qualified Data.Text as T
4747
import Data.Typeable (Typeable)
4848
import Development.IDE.Core.RuleTypes
4949
( NeedsCompilation(NeedsCompilation),
50-
LinkableResult(linkableHomeMod) )
50+
LinkableResult(linkableHomeMod),
51+
tmrTypechecked,
52+
TypeCheck(..))
5153
import Development.IDE.Core.Rules ( runAction, IdeState )
5254
import Development.IDE.Core.Shake
5355
( useWithStale_,
@@ -253,7 +255,18 @@ initialiseSessionForEval needs_quickcheck st nfp = do
253255

254256
linkables_needed <- reachableModules <$> use_ GetDependencyInformation nfp
255257
linkables <- uses_ GetLinkable linkables_needed
256-
let linkable_hsc = loadModulesHome (map linkableHomeMod linkables) deps_hsc
258+
-- We unset the global rdr env in mi_globals when we generate interfaces
259+
-- See Note [Clearing mi_globals after generating an iface]
260+
-- However, the eval plugin (setContext specifically) requires the rdr_env
261+
-- for the current module - so get it from the Typechecked Module and add
262+
-- it back to the iface for the current module.
263+
rdr_env <- tcg_rdr_env . tmrTypechecked <$> use_ TypeCheck nfp
264+
let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc
265+
addRdrEnv hmi
266+
| iface <- hm_iface hmi
267+
, ms_mod ms == mi_module iface
268+
= hmi { hm_iface = iface { mi_globals = Just rdr_env } }
269+
| otherwise = hmi
257270

258271
return (ms, linkable_hsc)
259272
-- Bit awkward we need to use evalGhcEnv here but setContext requires to run
@@ -262,6 +275,8 @@ initialiseSessionForEval needs_quickcheck st nfp = do
262275
setContext [Compat.IIModule (moduleName (ms_mod ms))]
263276
let df = flip xopt_set LangExt.ExtendedDefaultRules
264277
. flip xopt_unset LangExt.MonomorphismRestriction
278+
. flip gopt_set Opt_ImplicitImportQualified
279+
. flip gopt_unset Opt_DiagnosticsShowCaret
265280
$ (ms_hspp_opts ms) {
266281
useColor = Never
267282
, canUseColor = False }

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

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -74,29 +74,29 @@ tests =
7474
evalInFile "T8.hs" "-- >>> noFunctionWithThisName" "-- Variable not in scope: noFunctionWithThisName"
7575
evalInFile "T8.hs" "-- >>> res = \"a\" + \"bc\"" $
7676
if
77-
| ghcVersion == GHC92 -> "-- No instance for (Num String) arising from a use of `+'\n-- In the expression: \"a\" + \"bc\"\n-- In an equation for `res': res = \"a\" + \"bc\""
77+
| ghcVersion >= GHC92 -> "-- No instance for (Num String) arising from a use of `+'\n-- In the expression: \"a\" + \"bc\"\n-- In an equation for `res': res = \"a\" + \"bc\""
7878
| ghcVersion == GHC90 -> "-- No instance for (Num String) arising from a use of ‘+’"
7979
| otherwise -> "-- No instance for (Num [Char]) arising from a use of ‘+’"
8080
evalInFile "T8.hs" "-- >>> \"" "-- lexical error in string/character literal at end of input"
8181
evalInFile "T8.hs" "-- >>> 3 `div` 0" "-- divide by zero" -- The default for marking exceptions is False
8282
, goldenWithEval "Applies file LANGUAGE extensions" "T9" "hs"
83-
, goldenWithEval' "Evaluate a type with :kind!" "T10" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
83+
, goldenWithEval' "Evaluate a type with :kind!" "T10" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected")
8484
, goldenWithEval' "Reports an error for an incorrect type with :kind!" "T11" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
85-
, goldenWithEval' "Shows a kind with :kind" "T12" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
85+
, goldenWithEval' "Shows a kind with :kind" "T12" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected")
8686
, goldenWithEval' "Reports an error for an incorrect type with :kind" "T13" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
8787
, goldenWithEval "Returns a fully-instantiated type for :type" "T14" "hs"
8888
, knownBrokenForGhcVersions [GHC92] "type +v does not work anymore with 9.2" $ goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs"
8989
, goldenWithEval "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" "T16" "hs"
90-
, goldenWithEval' ":type reports an error when given with unknown +x option" "T17" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
90+
, goldenWithEval' ":type reports an error when given with unknown +x option" "T17" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected")
9191
, goldenWithEval "Reports an error when given with unknown command" "T18" "hs"
9292
, goldenWithEval "Returns defaulted type for :type +d reflecting the default declaration specified in the >>> prompt" "T19" "hs"
9393
, expectFailBecause "known issue - see a note in P.R. #361" $
94-
goldenWithEval' ":type +d reflects the `default' declaration of the module" "T20" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
94+
goldenWithEval' ":type +d reflects the `default' declaration of the module" "T20" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected")
9595
, testCase ":type handles a multilined result properly" $
9696
evalInFile "T21.hs" "-- >>> :type fun" $ T.unlines [
9797
"-- fun",
9898
if
99-
| ghcVersion == GHC92 -> "-- :: forall {k1} (k2 :: Nat) (n :: Nat) (a :: k1)."
99+
| ghcVersion >= GHC92 -> "-- :: forall {k1} (k2 :: Nat) (n :: Nat) (a :: k1)."
100100
| ghcVersion == GHC90 -> "-- :: forall {k1} {k2 :: Nat} {n :: Nat} {a :: k1}."
101101
| otherwise -> "-- :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).",
102102
"-- (KnownNat k2, KnownNat n, Typeable a) =>",
@@ -106,7 +106,7 @@ tests =
106106
, testCase ":type does \"dovetails\" for short identifiers" $
107107
evalInFile "T23.hs" "-- >>> :type f" $ T.unlines [
108108
if
109-
| ghcVersion == GHC92 -> "-- f :: forall {k1} (k2 :: Nat) (n :: Nat) (a :: k1)."
109+
| ghcVersion >= GHC92 -> "-- f :: forall {k1} (k2 :: Nat) (n :: Nat) (a :: k1)."
110110
| ghcVersion == GHC90 -> "-- f :: forall {k1} {k2 :: Nat} {n :: Nat} {a :: k1}."
111111
| otherwise -> "-- f :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).",
112112
"-- (KnownNat k2, KnownNat n, Typeable a) =>",
@@ -125,11 +125,11 @@ tests =
125125
, goldenWithEval "Transitive local dependency" "TTransitive" "hs"
126126
-- , goldenWithEval "Local Modules can be imported in a test" "TLocalImportInTest" "hs"
127127
, goldenWithEval "Setting language option TupleSections" "TLanguageOptionsTupleSections" "hs"
128-
, goldenWithEval' ":set accepts ghci flags" "TFlags" "hs" (if ghcVersion == GHC92 then "ghc92.expected" else "expected")
128+
, goldenWithEval' ":set accepts ghci flags" "TFlags" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected")
129129
, testCase ":set -fprint-explicit-foralls works" $ do
130130
evalInFile "T8.hs" "-- >>> :t id" "-- id :: a -> a"
131131
evalInFile "T8.hs" "-- >>> :set -fprint-explicit-foralls\n-- >>> :t id"
132-
(if ghcVersion == GHC92
132+
(if ghcVersion >= GHC92
133133
then "-- id :: forall a. a -> a"
134134
else "-- id :: forall {a}. a -> a")
135135
, goldenWithEval "The default language extensions for the eval plugin are the same as those for ghci" "TSameDefaultLanguageExtensionsAsGhci" "hs"

0 commit comments

Comments
 (0)