diff options
| -rw-r--r-- | compiler/hsSyn/HsExpr.hs | 6 | ||||
| -rw-r--r-- | compiler/rename/RnPat.hs | 30 | ||||
| -rw-r--r-- | testsuite/tests/patsyn/should_compile/T12615.hs | 12 | ||||
| -rw-r--r-- | testsuite/tests/patsyn/should_compile/all.T | 2 |
4 files changed, 45 insertions, 5 deletions
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 1ff204bd82..fdce60a172 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -2277,6 +2277,12 @@ data HsMatchContext id deriving Functor deriving instance (DataIdPost id) => Data (HsMatchContext id) +isPatSynCtxt :: HsMatchContext id -> Bool +isPatSynCtxt ctxt = + case ctxt of + PatSyn -> True + _ -> False + -- | Haskell Statement Context data HsStmtContext id = ListComp diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index 7e41bec9d2..e67be63fa4 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -62,7 +62,7 @@ import TysWiredIn ( nilDataCon ) import DataCon import qualified GHC.LanguageExtensions as LangExt -import Control.Monad ( when, liftM, ap ) +import Control.Monad ( when, liftM, ap, unless ) import Data.Ratio {- @@ -248,6 +248,25 @@ We want to "see" this use, and in let-bindings we collect all uses and report unused variables at the binding level. So we must use bindLocalNames here, *not* bindLocalNameFV. Trac #3943. + +Note: [Don't report shadowing for pattern synonyms] +There is one special context where a pattern doesn't introduce any new binders - +pattern synonym declarations. Therefore we don't check to see if pattern +variables shadow existing identifiers as they are never bound to anything +and have no scope. + +Without this check, there would be quite a cryptic warning that the `x` +in the RHS of the pattern synonym declaration shadowed the top level `x`. + +``` +x :: () +x = () + +pattern P x = Just x +``` + +See #12615 for some more examples. + ********************************************************* * * External entry points @@ -293,9 +312,12 @@ rnPats ctxt pats thing_inside -- check incrementally for duplicates; -- Nor can we check incrementally for shadowing, else we'll -- complain *twice* about duplicates e.g. f (x,x) = ... - ; addErrCtxt doc_pat $ - checkDupAndShadowedNames envs_before $ - collectPatsBinders pats' + -- + -- See note [Don't report shadowing for pattern synonyms] + ; unless (isPatSynCtxt ctxt) + (addErrCtxt doc_pat $ + checkDupAndShadowedNames envs_before $ + collectPatsBinders pats') ; thing_inside pats' } } where doc_pat = text "In" <+> pprMatchContext ctxt diff --git a/testsuite/tests/patsyn/should_compile/T12615.hs b/testsuite/tests/patsyn/should_compile/T12615.hs new file mode 100644 index 0000000000..1405525f48 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T12615.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude, PatternSynonyms #-} +{-# OPTIONS_GHC -Wall #-} +module Test where + +x :: () +x = () + +pattern Point2 :: () -> () -> ((), ()) +pattern Point2 x y = (x, y) + +pattern Point :: () -> () -> ((), ()) +pattern Point{x1, y1} = (x1, y1) diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 1297d8cd1a..d26fc84bec 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -59,4 +59,4 @@ test('T11977', normal, compile, ['']) test('T12108', normal, compile, ['']) test('T12484', normal, compile, ['']) test('T11987', normal, multimod_compile, ['T11987', '-v0']) - +test('T12615', normal, compile, ['']) |