Added a new warning about compatibility with RequiredTypeArguments

This commit introduces a new warning
that indicates code incompatible with
future extension: RequiredTypeArguments.

Enabling this extension may break some code and the warning
will help to make it compatible in advance.

32 files changed, 239 insertions, 4 deletions

diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index ed77b81ebd..4f656041df 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -628,6 +628,7 @@ data WarningFlag =
    | Opt_WarnGADTMonoLocalBinds                      -- Since 9.4
    | Opt_WarnTypeEqualityOutOfScope                  -- Since 9.4
    | Opt_WarnTypeEqualityRequiresOperators           -- Since 9.4
+   | Opt_WarnTermVariableCapture
    deriving (Eq, Ord, Show, Enum)
 
 -- | Return the names of a WarningFlag
@@ -639,6 +640,7 @@ warnFlagNames wflag = case wflag of
   Opt_WarnAlternativeLayoutRuleTransitional       -> "alternative-layout-rule-transitional" :| []
   Opt_WarnAmbiguousFields                         -> "ambiguous-fields" :| []
   Opt_WarnAutoOrphans                             -> "auto-orphans" :| []
+  Opt_WarnTermVariableCapture                     -> "term-variable-capture" :| []
   Opt_WarnCPPUndef                                -> "cpp-undef" :| []
   Opt_WarnUnbangedStrictPatterns                  -> "unbanged-strict-patterns" :| []
   Opt_WarnDeferredTypeErrors                      -> "deferred-type-errors" :| []
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index ad71ee27a0..29dff3650f 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3323,7 +3323,8 @@ wWarningFlagsDeps = mconcat [
   warnSpec    Opt_WarnUnicodeBidirectionalFormatCharacters,
   warnSpec    Opt_WarnGADTMonoLocalBinds,
   warnSpec    Opt_WarnTypeEqualityOutOfScope,
-  warnSpec    Opt_WarnTypeEqualityRequiresOperators
+  warnSpec    Opt_WarnTypeEqualityRequiresOperators,
+  warnSpec    Opt_WarnTermVariableCapture
  ]
 
 -- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 90c9f38faf..e9733a8bfc 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -1152,6 +1152,14 @@ its namespace to DataName and do a second lookup.
 The final result (after the renamer) will be:
   HsTyVar ("Zero", DataName)
 
+Another case of demotion happens when the compiler needs to check
+if a name of a type variable has already been used for a term that is in scope.
+We need to do it to check if a user should change the name
+to make his code compatible with the RequiredTypeArguments extension.
+
+This type of demotion is made via demoteTvNameSpace.
+
+
 Note [Promotion]
 ~~~~~~~~~~~~~~~
 When the user mentions a type constructor or a type variable in a
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 989a8bf3d8..cb246d1c77 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -395,6 +395,7 @@ rnImplicitTvOccs :: Maybe assoc
                  -> RnM (a, FreeVars)
 rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside
   = do { let implicit_vs = nubN implicit_vs_with_dups
+       ; mapM_ warn_term_var_capture implicit_vs
 
        ; traceRn "rnImplicitTvOccs" $
          vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ]
@@ -1151,6 +1152,20 @@ bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside =
         thing_inside $ HsOuterExplicit { hso_xexplicit = noExtField
                                        , hso_bndrs     = exp_bndrs' }
 
+warn_term_var_capture :: LocatedN RdrName -> RnM ()
+warn_term_var_capture lVar = do
+    gbl_env <- getGlobalRdrEnv
+    local_env <- getLocalRdrEnv
+    case demoteRdrNameTv $ unLoc lVar of
+      Nothing           -> return ()
+      Just demoted_name -> do
+        let global_vars = lookupGRE_RdrName demoted_name gbl_env
+        let mlocal_var  = lookupLocalRdrEnv local_env demoted_name
+        case mlocal_var of
+          Just name -> warnCapturedTerm lVar (Right name)
+          Nothing   -> unless (null global_vars) $
+                         warnCapturedTerm lVar (Left global_vars)
+
 bindHsForAllTelescope :: HsDocContext
                       -> HsForAllTelescope GhcPs
                       -> (HsForAllTelescope GhcRn -> RnM (a, FreeVars))
@@ -1654,6 +1669,11 @@ warnUnusedForAll doc (L loc tv) used_names
                    , inHsDocContext doc ]
       addDiagnosticAt (locA loc) msg
 
+warnCapturedTerm :: LocatedN RdrName -> Either [GlobalRdrElt] Name -> TcM ()
+warnCapturedTerm (L loc tv) shadowed_term_names
+  = let msg = TcRnCapturedTermName tv shadowed_term_names
+    in addDiagnosticAt (locA loc) msg
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index f135826147..8d18cad2a2 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -62,7 +62,7 @@ import GHC.Types.Error.Codes ( constructorCode )
 import GHC.Types.Id
 import GHC.Types.Name
 import GHC.Types.Name.Reader ( GreName(..), pprNameProvenance
-                             , RdrName, rdrNameOcc, greMangledName )
+                             , RdrName, rdrNameOcc, greMangledName, grePrintableName )
 import GHC.Types.Name.Set
 import GHC.Types.SrcLoc
 import GHC.Types.TyThing
@@ -1221,6 +1221,18 @@ instance Diagnostic TcRnMessage where
       hang (text "A section must be enclosed in parentheses")
          2 (text "thus:" <+> (parens (ppr expr)))
 
+    TcRnCapturedTermName tv_name shadowed_term_names
+      -> mkSimpleDecorated $
+        text "The type variable" <+> quotes (ppr tv_name) <+>
+          text "is implicitly quantified," $+$
+          text "even though another variable of the same name is in scope:" $+$
+          nest 2 var_names $+$
+          text "This is not forward-compatible with a planned GHC extension, RequiredTypeArguments."
+        where
+          var_names = case shadowed_term_names of
+              Left gbl_names -> vcat (map (\name -> quotes (ppr $ grePrintableName name) <+> pprNameProvenance name) gbl_names)
+              Right lcl_name -> quotes (ppr lcl_name) <+> text "defined at"
+                <+> ppr (nameSrcLoc lcl_name)
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -1625,6 +1637,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnIllegalTupleSection{}
       -> ErrorWithoutFlag
+    TcRnCapturedTermName{}
+      -> WarningWithFlag Opt_WarnTermVariableCapture
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -2034,7 +2048,8 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnIllegalTupleSection{}
       -> [suggestExtension LangExt.TupleSections]
-
+    TcRnCapturedTermName{}
+      -> [SuggestRenameTypeVariable]
 
   diagnosticCode = constructorCode
 
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 990c97970c..13bef7b699 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -1642,6 +1642,16 @@ data TcRnMessage where
   -}
   TcRnForallIdentifier :: RdrName -> TcRnMessage
 
+  {-| TcRnCapturedTermName is a warning (controlled by -Wterm-variable-capture) that occurs
+    when an implicitly quantified type variable's name is already used for a term.
+    Example:
+      a = 10
+      f :: a -> a
+
+    Test cases: T22513a T22513b T22513c T22513d T22513e T22513f T22513g T22513h T22513i
+ -}
+  TcRnCapturedTermName :: RdrName -> Either [GlobalRdrElt] Name -> TcRnMessage
+
   {-| TcRnTypeEqualityOutOfScope is a warning (controlled by -Wtype-equality-out-of-scope)
       that occurs when the type equality (a ~ b) is not in scope.
 
diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs
index ad8028ef38..3b7220f703 100644
--- a/compiler/GHC/Types/Error/Codes.hs
+++ b/compiler/GHC/Types/Error/Codes.hs
@@ -500,6 +500,7 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "TcRnMissingClassAssoc"                         = 06205
   GhcDiagnosticCode "TcRnBadFamInstDecl"                            = 06206
   GhcDiagnosticCode "TcRnNotOpenFamily"                             = 06207
+  GhcDiagnosticCode "TcRnCapturedTermName"                          = 54201
 
   -- IllegalNewtypeReason
   GhcDiagnosticCode "DoesNotHaveSingleField"                        = 23517
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index 0a175347b0..7e194ed194 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -418,6 +418,11 @@ data GhcHint
     -}
   | SuggestSpecialiseVisibilityHints Name
 
+    {-| Suggest renaming implicitly quantified type variable in case it
+        captures a term's name.
+    -}
+  | SuggestRenameTypeVariable
+
 -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
 -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
 -- to instantiate a particular signature, where the first argument is
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index 53890e8daf..e6c42539e3 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/compiler/GHC/Types/Hint/Ppr.hs
@@ -206,6 +206,8 @@ instance Outputable GhcHint where
            <+> quotes (ppr name) <+> text "has an INLINABLE pragma"
          where
            mod = nameModule name
+    SuggestRenameTypeVariable
+      -> text "Consider renaming the type variable."
 
 perhapsAsPat :: SDoc
 perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs
index bfc3b8aa95..36add1cfea 100644
--- a/compiler/GHC/Types/Name/Occurrence.hs
+++ b/compiler/GHC/Types/Name/Occurrence.hs
@@ -49,6 +49,7 @@ module GHC.Types.Name.Occurrence (
         mkDFunOcc,
         setOccNameSpace,
         demoteOccName,
+        demoteOccTvName,
         promoteOccName,
         HasOccName(..),
 
@@ -215,6 +216,14 @@ demoteNameSpace DataName = Nothing
 demoteNameSpace TvName = Nothing
 demoteNameSpace TcClsName = Just DataName
 
+-- demoteTvNameSpace lowers the NameSpace of a type variable.
+-- See Note [Demotion] in GHC.Rename.Env.
+demoteTvNameSpace :: NameSpace -> Maybe NameSpace
+demoteTvNameSpace TvName = Just VarName
+demoteTvNameSpace VarName = Nothing
+demoteTvNameSpace DataName = Nothing
+demoteTvNameSpace TcClsName = Nothing
+
 -- promoteNameSpace promotes the NameSpace as follows.
 -- See Note [Promotion] in GHC.Rename.Env.
 promoteNameSpace :: NameSpace -> Maybe NameSpace
@@ -334,6 +343,11 @@ demoteOccName (OccName space name) = do
   space' <- demoteNameSpace space
   return $ OccName space' name
 
+demoteOccTvName :: OccName -> Maybe OccName
+demoteOccTvName (OccName space name) = do
+  space' <- demoteTvNameSpace space
+  return $ OccName space' name
+
 -- promoteOccName promotes the NameSpace of OccName.
 -- See Note [Promotion] in GHC.Rename.Env.
 promoteOccName :: OccName -> Maybe OccName
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index feecb3bfc3..7c52a94584 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -33,7 +33,7 @@ module GHC.Types.Name.Reader (
         nameRdrName, getRdrName,
 
         -- ** Destruction
-        rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName,
+        rdrNameOcc, rdrNameSpace, demoteRdrName, demoteRdrNameTv, promoteRdrName,
         isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,
         isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
 
@@ -195,6 +195,12 @@ demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ)
 demoteRdrName (Orig _ _) = Nothing
 demoteRdrName (Exact _) = Nothing
 
+demoteRdrNameTv :: RdrName -> Maybe RdrName
+demoteRdrNameTv (Unqual occ) = fmap Unqual (demoteOccTvName occ)
+demoteRdrNameTv (Qual m occ) = fmap (Qual m) (demoteOccTvName occ)
+demoteRdrNameTv (Orig _ _) = Nothing
+demoteRdrNameTv (Exact _) = Nothing
+
 -- promoteRdrName promotes the NameSpace of RdrName.
 -- See Note [Promotion] in GHC.Rename.Env.
 promoteRdrName :: RdrName -> Maybe RdrName
diff --git a/docs/users_guide/9.6.1-notes.rst b/docs/users_guide/9.6.1-notes.rst
index ef3078bbfa..797ff72f3a 100644
--- a/docs/users_guide/9.6.1-notes.rst
+++ b/docs/users_guide/9.6.1-notes.rst
@@ -96,6 +96,9 @@ Compiler
 - The :ghc-flag:`-Woperator-whitespace` warning no longer ignores constructor symbols
   (operators starting with ``:``).
 
+- Added a new warning :ghc-flag:`-Wterm-variable-capture` that helps to make code compatible with 
+  the future extension ``RequiredTypeArguments``.
+
 GHCi
 ~~~~
 
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 977bb69941..c99c51043f 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -2355,6 +2355,29 @@ of ``-W(no-)*``.
     triggered whenever this happens, and can be addressed by enabling the
     extension.
 
+.. ghc-flag:: -Wterm-variable-capture
+    :shortdesc: warn when an implicitly quantified type variable captures a term's name
+    :type: dynamic
+    
+    :since: 9.6.1
+
+    In accordance with `GHC Proposal #281
+    <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0281-visible-forall.rst>`__,
+    a new extension ``RequiredTypeArguments`` will be introduced in a future GHC release.
+
+    Under ``RequiredTypeArguments``, implicit quantification of type variables does not take place
+    if there is a term variable of the same name in scope.
+
+    For example: ::
+
+       a = 15
+       f :: a -> a    -- Does ‘a’ refer to the term-level binding
+                      -- or is it implicitly quantified?
+
+    When :ghc-flag:`-Wterm-variable-capture` is enabled, GHC warns against implicit quantification
+    that would stop working under ``RequiredTypeArguments``.
+
+
 If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice.
 It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's
 sanity, not yours.)
diff --git a/testsuite/tests/rename/should_compile/T22513a.hs b/testsuite/tests/rename/should_compile/T22513a.hs
new file mode 100644
index 0000000000..ec6211e2fb
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513a.hs
@@ -0,0 +1,6 @@
+module T22513a where 
+
+a = 10
+
+f :: a -> a
+f = id
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513a.stderr b/testsuite/tests/rename/should_compile/T22513a.stderr
new file mode 100644
index 0000000000..09a3471e2d
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513a.stderr
@@ -0,0 +1,6 @@
+T22513a.hs:5:6: warning: [GHC-54201] [-Wterm-variable-capture]
+    The type variable ‘a’ is implicitly quantified,
+    even though another variable of the same name is in scope:
+        ‘a’ defined at T22513a.hs:3:1
+    This is not forward-compatible with a planned GHC extension, RequiredTypeArguments.
+    Suggested fix: Consider renaming the type variable.
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513b.hs b/testsuite/tests/rename/should_compile/T22513b.hs
new file mode 100644
index 0000000000..d80dab4a32
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513b.hs
@@ -0,0 +1,6 @@
+module T22513b where 
+
+import Prelude (id, Int)
+
+f :: id -> Int
+f _ = 10
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513b.stderr b/testsuite/tests/rename/should_compile/T22513b.stderr
new file mode 100644
index 0000000000..0d710e8ab5
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513b.stderr
@@ -0,0 +1,7 @@
+T22513b.hs:5:6: warning: [GHC-54201] [-Wterm-variable-capture]
+    The type variable ‘id’ is implicitly quantified,
+    even though another variable of the same name is in scope:
+      ‘id’ imported from ‘Prelude’ at T22513b.hs:3:17-18
+           (and originally defined in ‘GHC.Base’)
+    This is not forward-compatible with a planned GHC extension, RequiredTypeArguments.
+    Suggested fix: Consider renaming the type variable.
diff --git a/testsuite/tests/rename/should_compile/T22513c.hs b/testsuite/tests/rename/should_compile/T22513c.hs
new file mode 100644
index 0000000000..6f1cc8b547
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513c.hs
@@ -0,0 +1,7 @@
+module T22513c where
+
+f :: Int -> Int 
+f a = g a 
+  where
+    g :: a -> a
+    g = id
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513c.stderr b/testsuite/tests/rename/should_compile/T22513c.stderr
new file mode 100644
index 0000000000..ee2bc58336
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513c.stderr
@@ -0,0 +1,6 @@
+T22513c.hs:6:10: warning: [GHC-54201] [-Wterm-variable-capture]
+    The type variable ‘a’ is implicitly quantified,
+    even though another variable of the same name is in scope:
+      ‘a’ defined at T22513c.hs:4:3
+    This is not forward-compatible with a planned GHC extension, RequiredTypeArguments.
+    Suggested fix: Consider renaming the type variable.
diff --git a/testsuite/tests/rename/should_compile/T22513d.hs b/testsuite/tests/rename/should_compile/T22513d.hs
new file mode 100644
index 0000000000..7082c90688
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513d.hs
@@ -0,0 +1,3 @@
+module T22513d where
+
+f (Just (x :: id) :: Maybe id) = x
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513d.stderr b/testsuite/tests/rename/should_compile/T22513d.stderr
new file mode 100644
index 0000000000..dedf7a5002
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513d.stderr
@@ -0,0 +1,7 @@
+T22513d.hs:3:28: warning: [GHC-54201] [-Wterm-variable-capture]
+    The type variable ‘id’ is implicitly quantified,
+    even though another variable of the same name is in scope:
+      ‘id’ imported from ‘Prelude’ at T22513d.hs:1:8-14
+           (and originally defined in ‘GHC.Base’)
+    This is not forward-compatible with a planned GHC extension, RequiredTypeArguments.
+    Suggested fix: Consider renaming the type variable.
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513e.hs b/testsuite/tests/rename/should_compile/T22513e.hs
new file mode 100644
index 0000000000..63e661bd76
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513e.hs
@@ -0,0 +1,3 @@
+module T22513e where
+
+data T (a :: id) = MkT
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513e.stderr b/testsuite/tests/rename/should_compile/T22513e.stderr
new file mode 100644
index 0000000000..2598537d1d
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513e.stderr
@@ -0,0 +1,7 @@
+T22513e.hs:3:14: warning: [GHC-54201] [-Wterm-variable-capture]
+    The type variable ‘id’ is implicitly quantified,
+    even though another variable of the same name is in scope:
+      ‘id’ imported from ‘Prelude’ at T22513e.hs:1:8-14
+           (and originally defined in ‘GHC.Base’)
+    This is not forward-compatible with a planned GHC extension, RequiredTypeArguments.
+    Suggested fix: Consider renaming the type variable.
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513f.hs b/testsuite/tests/rename/should_compile/T22513f.hs
new file mode 100644
index 0000000000..0ef422fdeb
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513f.hs
@@ -0,0 +1,6 @@
+module T22513f where
+
+import Data.Proxy
+
+p :: () -> forall (a :: id). Proxy a
+p () = Proxy
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513f.stderr b/testsuite/tests/rename/should_compile/T22513f.stderr
new file mode 100644
index 0000000000..e6045be3a3
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513f.stderr
@@ -0,0 +1,7 @@
+T22513f.hs:5:25: warning: [GHC-54201] [-Wterm-variable-capture]
+    The type variable ‘id’ is implicitly quantified,
+    even though another variable of the same name is in scope:
+      ‘id’ imported from ‘Prelude’ at T22513f.hs:1:8-14
+           (and originally defined in ‘GHC.Base’)
+    This is not forward-compatible with a planned GHC extension, RequiredTypeArguments.
+    Suggested fix: Consider renaming the type variable.
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513g.hs b/testsuite/tests/rename/should_compile/T22513g.hs
new file mode 100644
index 0000000000..1895b70bc2
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513g.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module T22513g where
+import Data.Kind
+
+data T k (id::head) (b::k) :: k2 -> head -> Type
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513g.stderr b/testsuite/tests/rename/should_compile/T22513g.stderr
new file mode 100644
index 0000000000..636a35bfaa
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513g.stderr
@@ -0,0 +1,7 @@
+T22513g.hs:5:15: warning: [GHC-54201] [-Wterm-variable-capture]
+    The type variable ‘head’ is implicitly quantified,
+    even though another variable of the same name is in scope:
+      ‘head’ imported from ‘Prelude’ at T22513g.hs:2:8-14
+             (and originally defined in ‘GHC.List’)
+    This is not forward-compatible with a planned GHC extension, RequiredTypeArguments.
+    Suggested fix: Consider renaming the type variable.
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513h.hs b/testsuite/tests/rename/should_compile/T22513h.hs
new file mode 100644
index 0000000000..a29ced5a44
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513h.hs
@@ -0,0 +1,8 @@
+module T22513h where
+
+class C a where
+    f :: a -> Bool
+
+instance C (Maybe id) where
+    f (Just _) = True
+    f Nothing = False
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513h.stderr b/testsuite/tests/rename/should_compile/T22513h.stderr
new file mode 100644
index 0000000000..33244dd11d
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513h.stderr
@@ -0,0 +1,7 @@
+T22513h.hs:6:19: warning: [GHC-54201] [-Wterm-variable-capture]
+    The type variable ‘id’ is implicitly quantified,
+    even though another variable of the same name is in scope:
+      ‘id’ imported from ‘Prelude’ at T22513h.hs:1:8-14
+           (and originally defined in ‘GHC.Base’)
+    This is not forward-compatible with a planned GHC extension, RequiredTypeArguments.
+    Suggested fix: Consider renaming the type variable.
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513i.hs b/testsuite/tests/rename/should_compile/T22513i.hs
new file mode 100644
index 0000000000..45e217489f
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513i.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
+
+module T22513i where
+
+import Language.Haskell.TH
+
+sp :: Q ()
+sp =
+    $(do
+        instances <- reifyInstances ''Show [ VarT (mkName "id") ]
+        [e| return () |])
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/T22513i.stderr b/testsuite/tests/rename/should_compile/T22513i.stderr
new file mode 100644
index 0000000000..d99b621a47
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T22513i.stderr
@@ -0,0 +1,7 @@
+T22513i.hs:9:6: warning: [GHC-54201] [-Wterm-variable-capture]
+    The type variable ‘id’ is implicitly quantified,
+    even though another variable of the same name is in scope:
+      ‘id’ imported from ‘Prelude’ at T22513i.hs:3:8-14
+           (and originally defined in ‘GHC.Base’)
+    This is not forward-compatible with a planned GHC extension, RequiredTypeArguments.
+    Suggested fix: Consider renaming the type variable.
\ No newline at end of file
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 9ad3dd0baf..2477d55daa 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -190,3 +190,12 @@ test('T19984', normal, compile, ['-fwarn-unticked-promoted-constructors'])
 test('T21654', normal, compile, ['-Wunused-top-binds'])
 test('T22057', normal, compile, ['-Wall'])
 test('T22067', req_th, compile, ['-Wall'])
+test('T22513a', normal, compile, ['-Wterm-variable-capture'])
+test('T22513b', normal, compile, ['-Wterm-variable-capture'])
+test('T22513c', normal, compile, ['-Wterm-variable-capture'])
+test('T22513d', normal, compile, ['-Wterm-variable-capture'])
+test('T22513e', normal, compile, ['-Wterm-variable-capture'])
+test('T22513f', normal, compile, ['-Wterm-variable-capture'])
+test('T22513g', normal, compile, ['-Wterm-variable-capture'])
+test('T22513h', normal, compile, ['-Wterm-variable-capture'])
+test('T22513i', normal, compile, ['-Wterm-variable-capture'])
\ No newline at end of file