diff options
-rw-r--r-- | compiler/GHC/Iface/Ext/Ast.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Iface/Ext/Utils.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/hiefile/should_compile/T18425.hs | 18 | ||||
-rw-r--r-- | testsuite/tests/hiefile/should_compile/T18425.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/hiefile/should_compile/all.T | 3 |
5 files changed, 29 insertions, 7 deletions
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs index 43cd29bc1c..affe0e7ca4 100644 --- a/compiler/GHC/Iface/Ext/Ast.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -1583,7 +1583,7 @@ instance ToHie (Located [LocatedAn NoEpAnns (HsDerivingClause GhcRn)]) where instance ToHie (LocatedAn NoEpAnns (HsDerivingClause GhcRn)) where toHie (L span cl) = concatM $ makeNodeA cl span : case cl of HsDerivingClause _ strat dct -> - [ toHie strat + [ toHie (RS (mkLScopeA dct) <$> strat) , toHie dct ] @@ -1592,12 +1592,12 @@ instance ToHie (LocatedC (DerivClauseTys GhcRn)) where DctSingle _ ty -> [ toHie $ TS (ResolvedScopes []) ty ] DctMulti _ tys -> [ toHie $ map (TS (ResolvedScopes [])) tys ] -instance ToHie (LocatedAn NoEpAnns (DerivStrategy GhcRn)) where - toHie (L span strat) = concatM $ makeNodeA strat span : case strat of +instance ToHie (RScoped (LocatedAn NoEpAnns (DerivStrategy GhcRn))) where + toHie (RS sc (L span strat)) = concatM $ makeNodeA strat span : case strat of StockStrategy _ -> [] AnyclassStrategy _ -> [] NewtypeStrategy _ -> [] - ViaStrategy s -> [ toHie (TS (ResolvedScopes []) s) ] + ViaStrategy s -> [ toHie (TS (ResolvedScopes [sc]) s) ] instance ToHie (LocatedP OverlapMode) where toHie (L span _) = locOnly (locA span) @@ -1970,7 +1970,7 @@ instance ToHie (LocatedA (DerivDecl GhcRn)) where toHie (L span decl) = concatM $ makeNodeA decl span : case decl of DerivDecl _ typ strat overlap -> [ toHie $ TS (ResolvedScopes []) typ - , toHie strat + , toHie $ (RS (mkScopeA span) <$> strat) , toHie overlap ] diff --git a/compiler/GHC/Iface/Ext/Utils.hs b/compiler/GHC/Iface/Ext/Utils.hs index 20d047d150..aece9ed044 100644 --- a/compiler/GHC/Iface/Ext/Utils.hs +++ b/compiler/GHC/Iface/Ext/Utils.hs @@ -296,8 +296,9 @@ getNameBindingInClass -> Maybe Span getNameBindingInClass n sp asts = do ast <- M.lookup (HiePath (srcSpanFile sp)) asts + clsNode <- selectLargestContainedBy sp ast getFirst $ foldMap First $ do - child <- flattenAst ast + child <- flattenAst clsNode dets <- maybeToList $ M.lookup (Right n) $ sourcedNodeIdents $ sourcedNodeInfo child let binding = foldMap (First . getBindSiteFromContext) (identInfo dets) diff --git a/testsuite/tests/hiefile/should_compile/T18425.hs b/testsuite/tests/hiefile/should_compile/T18425.hs new file mode 100644 index 0000000000..dae38f64cf --- /dev/null +++ b/testsuite/tests/hiefile/should_compile/T18425.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +module Bug where + +newtype List a = MkList [a] +deriving via forall a. [a] instance Eq a => Eq (List a) + +class C a where + m :: forall b. a -> b -> b + m _ = undefined @_ @a `seq` id @b + +instance C [a] where + m :: forall b. [a] -> b -> b + m _ = undefined @_ @a `seq` id @b diff --git a/testsuite/tests/hiefile/should_compile/T18425.stderr b/testsuite/tests/hiefile/should_compile/T18425.stderr new file mode 100644 index 0000000000..f31d37d99f --- /dev/null +++ b/testsuite/tests/hiefile/should_compile/T18425.stderr @@ -0,0 +1,2 @@ +Got valid scopes +Got no roundtrip errors diff --git a/testsuite/tests/hiefile/should_compile/all.T b/testsuite/tests/hiefile/should_compile/all.T index 86fbd6e20f..73b98a1f94 100644 --- a/testsuite/tests/hiefile/should_compile/all.T +++ b/testsuite/tests/hiefile/should_compile/all.T @@ -20,4 +20,5 @@ test('CPP', normal, compile, ['-fno-code -fwrite-ide- test('Constructors', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info']) test('Scopes', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info']) # See https://gitlab.haskell.org/ghc/ghc/-/issues/18425 and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2464#note_301989 -test('ScopesBug', expect_broken(18425), compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
\ No newline at end of file +test('ScopesBug', expect_broken(18425), compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info']) +test('T18425', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info']) |