diff options
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 |