diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 5368dd75625a594f766c56a5460d48cbe29810f8..cebd7c082e1f09b8777da343d3b9b80b61c6a27d 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -464,9 +464,12 @@ hsScopedKvs (L _ HsForAllTy { hst_tele = HsForAllInvis { hsf_invis_bndrs = bndr
hsScopedKvs _ = []
---------------------
+hsTyVarLName :: HsTyVarBndr flag (GhcPass p) -> LIdP (GhcPass p)
+hsTyVarLName (UserTyVar _ _ n) = n
+hsTyVarLName (KindedTyVar _ _ n _) = n
+
hsTyVarName :: HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
-hsTyVarName (UserTyVar _ _ (L _ n)) = n
-hsTyVarName (KindedTyVar _ _ (L _ n) _) = n
+hsTyVarName = unLoc . hsTyVarLName
hsLTyVarName :: LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName = hsTyVarName . unLoc
@@ -488,10 +491,12 @@ hsAllLTyVarNames (HsQTvs { hsq_ext = kvs
, hsq_explicit = tvs })
= kvs ++ hsLTyVarNames tvs
-hsLTyVarLocName :: LHsTyVarBndr flag (GhcPass p) -> LocatedN (IdP (GhcPass p))
-hsLTyVarLocName (L l a) = L (l2l l) (hsTyVarName a)
+hsLTyVarLocName :: Anno (IdGhcP p) ~ SrcSpanAnnN
+ => LHsTyVarBndr flag (GhcPass p) -> LocatedN (IdP (GhcPass p))
+hsLTyVarLocName (L _ a) = hsTyVarLName a
-hsLTyVarLocNames :: LHsQTyVars (GhcPass p) -> [LocatedN (IdP (GhcPass p))]
+hsLTyVarLocNames :: Anno (IdGhcP p) ~ SrcSpanAnnN
+ => LHsQTyVars (GhcPass p) -> [LocatedN (IdP (GhcPass p))]
hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)
-- | Get the kind signature of a type, ignoring parentheses:
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index d14a6a2070cf4c6c5ef056e7a36a9910d5c9c3bd..0fb917b96b6853b65e41e1e7adc5b303986fa3b0 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -1039,7 +1039,7 @@ realSrcSpan :: SrcSpan -> RealSrcSpan
realSrcSpan (RealSrcSpan s _) = s
realSrcSpan _ = mkRealSrcSpan l l -- AZ temporary
where
- l = mkRealSrcLoc (fsLit "foo") (-1) (-1)
+ l = mkRealSrcLoc (fsLit "realSrcSpan") (-1) (-1)
srcSpan2e :: SrcSpan -> EpaLocation
srcSpan2e (RealSrcSpan s mb) = EpaSpan s mb
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 2395fa1de515700191dbc50ad33ef17f50f62a46..a47ca1b031b332d57fc92e83b80971325a6f5c62 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -963,19 +963,30 @@ checkTyVars pp_what equals_or_where tc tparms
= let
an = (reverse ops) ++ cps
in
- return (L (widenLocatedAn (l Semi.<> annt) an)
- (KindedTyVar (addAnns (annk Semi.<> ann) an cs) bvis (L lv tv) k))
+ return (L (widenLocatedAn (l Semi.<> annt) (for_widening bvis:an))
+ (KindedTyVar (addAnns (annk Semi.<> ann Semi.<> for_widening_ann bvis) an cs)
+ bvis (L lv tv) k))
chk ops cps cs bvis (L l (HsTyVar ann _ (L ltv tv)))
| isRdrTyVar tv
= let
an = (reverse ops) ++ cps
in
- return (L (widenLocatedAn l an)
- (UserTyVar (addAnns ann an cs) bvis (L ltv tv)))
+ return (L (widenLocatedAn l (for_widening bvis:an))
+ (UserTyVar (addAnns (ann Semi.<> for_widening_ann bvis) an cs)
+ bvis (L ltv tv)))
chk _ _ _ _ t@(L loc _)
= addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $
(PsErrUnexpectedTypeInDecl t pp_what (unLoc tc) tparms equals_or_where)
+ -- Return an AddEpAnn for use in widenLocatedAn. The AnnKeywordId is not used.
+ for_widening :: HsBndrVis GhcPs -> AddEpAnn
+ for_widening (HsBndrInvisible (L (TokenLoc loc) _)) = AddEpAnn AnnAnyclass loc
+ for_widening _ = AddEpAnn AnnAnyclass (EpaDelta (SameLine 0) [])
+
+ for_widening_ann :: HsBndrVis GhcPs -> EpAnn [AddEpAnn]
+ for_widening_ann (HsBndrInvisible (L (TokenLoc (EpaSpan r _mb)) _)) = EpAnn (realSpanAsAnchor r) [] emptyComments
+ for_widening_ann _ = EpAnnNotUsed
+
whereDots, equalsDots :: SDoc
-- Second argument to checkTyVars
diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile
index 7d57d53595c93f655e6df2751fc1db5f2f9e8b22..b82a65b56b3d4150ba6840c9e03bb0de2e357c82 100644
--- a/testsuite/tests/printer/Makefile
+++ b/testsuite/tests/printer/Makefile
@@ -800,3 +800,8 @@ Test22771:
Test23465:
$(CHECK_PPR) $(LIBDIR) Test23464.hs
$(CHECK_EXACT) $(LIBDIR) Test23464.hs
+
+.PHONY: Test23887
+Test23465:
+ $(CHECK_PPR) $(LIBDIR) Test23887.hs
+ $(CHECK_EXACT) $(LIBDIR) Test23887.hs
diff --git a/testsuite/tests/printer/Test23887.hs b/testsuite/tests/printer/Test23887.hs
new file mode 100644
index 0000000000000000000000000000000000000000..b0e61e0e711045ea00885a4ea7927dea22850be3
--- /dev/null
+++ b/testsuite/tests/printer/Test23887.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE PolyKinds #-}
+module Test23887 where
+-- based on T13343.hs
+import GHC.Exts
+
+type Bad :: forall v . TYPE v
+type Bad @v = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v
+
+-- Note v /= v1.
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index 71bc05dacdb5ae5a0c847d96667065fd59a77e58..454b0724cfa089541088464683e2119546aca6f8 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -192,3 +192,4 @@ test('HsDocTy', [ignore_stderr, req_ppr_deps], makefile_test, ['HsDocTy'])
test('Test22765', [ignore_stderr, req_ppr_deps], makefile_test, ['Test22765'])
test('Test22771', [ignore_stderr, req_ppr_deps], makefile_test, ['Test22771'])
test('Test23464', [ignore_stderr, req_ppr_deps], makefile_test, ['Test23464'])
+test('Test23887', [ignore_stderr, req_ppr_deps], makefile_test, ['Test23887'])
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index e1a5a2f7cc39100fc852eed16013e170fe9a55a2..a149a978404aa116292204c492a5806797cf3a85 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -36,10 +36,10 @@ import GHC.Data.FastString
-- ---------------------------------------------------------------------
_tt :: IO ()
-_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/master/_build/stage1/lib/"
+-- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/master/_build/stage1/lib/"
-- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib/"
-- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprint/_build/stage1/lib"
--- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_build/stage1/lib"
+_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_build/stage1/lib"
-- "../../testsuite/tests/ghc-api/exactprint/RenameCase1.hs" (Just changeRenameCase1)
-- "../../testsuite/tests/ghc-api/exactprint/LayoutLet2.hs" (Just changeLayoutLet2)
@@ -205,7 +205,8 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/master/_b
-- "../../testsuite/tests/printer/Test16279.hs" Nothing
-- "../../testsuite/tests/printer/HsDocTy.hs" Nothing
-- "../../testsuite/tests/printer/Test22765.hs" Nothing
- "../../testsuite/tests/printer/Test22771.hs" Nothing
+ -- "../../testsuite/tests/printer/Test22771.hs" Nothing
+ "../../testsuite/tests/typecheck/should_fail/T22560_fail_c.hs" Nothing
-- cloneT does not need a test, function can be retired