|
| 1 | +-- | Regression test: edits that break typechecking can leave HLS's |
| 2 | +-- shared 'ExternalPackageState' ('EPS') polluted with interfaces and |
| 3 | +-- instances from /home-package/ modules. The next successful typecheck |
| 4 | +-- of a module that also legitimately has those home modules in its HPT |
| 5 | +-- reports \"Overlapping instance\" with both matches pointing at the |
| 6 | +-- same source location, because 'tcGetInstEnvs' returns the same |
| 7 | +-- 'ClsInst' twice (once via @ie_global@ from the EPS, once via |
| 8 | +-- @ie_local@ from 'hptInstancesBelow'). |
| 9 | +-- |
| 10 | +-- The pollution enters through 'Development.IDE.Spans.Documentation.mkDocMap'. |
| 11 | +-- Its 'Rules.GetDocMap' rule reads three inputs via independent |
| 12 | +-- @useWithStale_@ calls: 'TypeCheck', 'GhcSessionDeps' and 'GetHieAst'. |
| 13 | +-- These three can diverge: an edit that merely changes imports lets |
| 14 | +-- 'GhcSessionDeps' re-evaluate (fresh, with a different HPT) while |
| 15 | +-- 'TypeCheck' and 'GetHieAst' fall back to their last-successful values. |
| 16 | +-- If the stale 'RefMap' references a name whose module is no longer in |
| 17 | +-- the fresh HPT, 'mkDocMap' asks 'getDocsBatch' for its docs; |
| 18 | +-- 'loadSysInterface' does not find the module in the HUG and calls |
| 19 | +-- 'loadInterface', which puts the home-module interface -- /with its |
| 20 | +-- instance environment/ -- into the shared EPS @IORef@. The EPS never |
| 21 | +-- evicts anything, so the pollution is permanent for the session. |
| 22 | +module EpsPollutionTests (tests) where |
| 23 | + |
| 24 | +import Config (runWithExtraFiles) |
| 25 | +import Control.Lens ((^.)) |
| 26 | +import Control.Monad.IO.Class (liftIO) |
| 27 | +import qualified Data.Text as T |
| 28 | +import Development.IDE.GHC.Util (readFileUtf8) |
| 29 | +import Development.IDE.Test (waitForTypecheck) |
| 30 | +import qualified Language.LSP.Protocol.Lens as L |
| 31 | +import Language.LSP.Protocol.Types |
| 32 | +import Language.LSP.Test |
| 33 | +import System.FilePath |
| 34 | +import Test.Hls (expectFailBecause, |
| 35 | + waitForDiagnosticsFrom) |
| 36 | +import Test.Tasty |
| 37 | +import Test.Tasty.HUnit |
| 38 | + |
| 39 | +tests :: TestTree |
| 40 | +tests = testGroup "eps-pollution" |
| 41 | + [ expectFailBecause |
| 42 | + "The EPS gets polluted with a home-module instance via GetDocMap's \ |
| 43 | + \inconsistent stale-value snapshot; the next successful typecheck \ |
| 44 | + \sees the instance twice." |
| 45 | + staleHieProvokesOverlapping |
| 46 | + ] |
| 47 | + |
| 48 | +-- The fixture at ghcide-test/data/multi-unit-eps-pollution/ sets up two |
| 49 | +-- home units: unit @a@ provides module @A@ which defines @MyClass@ and |
| 50 | +-- @instance MyClass AType@; unit @c@ provides module @C@ which imports |
| 51 | +-- @A@ and uses @myMethod@ on an @AType@ value (forcing instance |
| 52 | +-- resolution). |
| 53 | + |
| 54 | +staleHieProvokesOverlapping :: TestTree |
| 55 | +staleHieProvokesOverlapping = |
| 56 | + testCase "Stale RefMap must not provoke overlapping-instance error" $ |
| 57 | + runWithExtraFiles "multi-unit-eps-pollution" $ \dir -> do |
| 58 | + let cPath = dir </> "c" </> "C.hs" |
| 59 | + originalC <- liftIO $ readFileUtf8 cPath |
| 60 | + let brokenC = T.replace "import A\n" "" originalC |
| 61 | + cdoc <- openDoc cPath "haskell" |
| 62 | + True <- waitForTypecheck cdoc |
| 63 | + -- Hovering triggers the hover pipeline, which forces GetDocMap. |
| 64 | + -- While C is healthy this populates GetHieAst with a RefMap |
| 65 | + -- referencing A's names -- the stale value we rely on below. |
| 66 | + _ <- getHover cdoc (hoverOnMyMethod originalC) |
| 67 | + -- Break C's import of A. C fails to typecheck, but GhcSessionDeps |
| 68 | + -- re-evaluates successfully (it only needs the import list) with an |
| 69 | + -- HPT that no longer contains A. A further hover forces GetDocMap |
| 70 | + -- to run with the fresh GhcSessionDeps alongside the stale RefMap; |
| 71 | + -- loadSysInterface(A) then runs and pollutes the EPS. |
| 72 | + changeDoc cdoc [TextDocumentContentChangeEvent . InR . |
| 73 | + TextDocumentContentChangeWholeDocument $ brokenC] |
| 74 | + _ <- getHover cdoc (hoverOnMyMethod brokenC) |
| 75 | + _ <- waitForDiagnosticsFrom cdoc -- let the broken state settle |
| 76 | + -- Repair C. The next typecheck legitimately has A in its HPT; with |
| 77 | + -- the polluted EPS it also has A's ClsInst in eps_inst_env, so |
| 78 | + -- instance resolution for 'myMethod x :: AType -> String' finds |
| 79 | + -- two matches with identical source locations. |
| 80 | + changeDoc cdoc [TextDocumentContentChangeEvent . InR . |
| 81 | + TextDocumentContentChangeWholeDocument $ originalC] |
| 82 | + diags <- waitForDiagnosticsFrom cdoc |
| 83 | + liftIO $ assertBool |
| 84 | + ("Expected no overlapping-instance errors, got diagnostics:\n" |
| 85 | + ++ unlines (map (T.unpack . (^. L.message)) diags)) |
| 86 | + (not (any isOverlappingInstance diags)) |
| 87 | + where |
| 88 | + isOverlappingInstance d = |
| 89 | + "Overlapping instance" `T.isInfixOf` (d ^. L.message) |
| 90 | + |
| 91 | +-- | 'Position' at the first occurrence of @myMethod@ in the given source. |
| 92 | +-- Computed rather than hard-coded because the broken variant has one |
| 93 | +-- fewer line than the original. |
| 94 | +hoverOnMyMethod :: T.Text -> Position |
| 95 | +hoverOnMyMethod src = |
| 96 | + case [ Position row (fromIntegral (T.length prefix)) |
| 97 | + | (row, line) <- zip [0..] (T.lines src) |
| 98 | + , let (prefix, rest) = T.breakOn "myMethod" line |
| 99 | + , not (T.null rest) |
| 100 | + ] of |
| 101 | + p : _ -> p |
| 102 | + [] -> error "hoverOnMyMethod: no occurrence of 'myMethod'" |
0 commit comments