[commit: ghc] master: Fix #14114 by checking for duplicate vars on pattern synonym RHSes (a89bb80)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a89bb806c58d3e601b37d6f2c4ebec6514fd2776/ghc

>---------------------------------------------------------------

commit a89bb806c58d3e601b37d6f2c4ebec6514fd2776
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Tue Aug 22 09:28:49 2017 -0400

    Fix #14114 by checking for duplicate vars on pattern synonym RHSes
    
    Summary:
    Because we weren't checking for duplicate variables on the right-hand
    sides of pattern synonyms, bogus definitions like this one passed the renamer:
    
    ```lang=haskell
    pattern Foo a <- (a,a)
    ```
    
    Luckily, the fix is simple.
    
    Test Plan: make test TEST=T14114
    
    Reviewers: mpickering, austin, bgamari, simonpj
    
    Reviewed By: simonpj
    
    Subscribers: simonpj, rwbarton, thomie
    
    GHC Trac Issues: #14114
    
    Differential Revision: https://phabricator.haskell.org/D3866


>---------------------------------------------------------------

a89bb806c58d3e601b37d6f2c4ebec6514fd2776
 compiler/rename/RnPat.hs                         | 15 ++++++++-------
 testsuite/tests/patsyn/should_fail/T14114.hs     |  7 +++++++
 testsuite/tests/patsyn/should_fail/T14114.stderr | 18 ++++++++++++++++++
 testsuite/tests/patsyn/should_fail/all.T         |  1 +
 4 files changed, 34 insertions(+), 7 deletions(-)

diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index 320e4f3..9b439a7 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -47,8 +47,8 @@ import RnEnv
 import RnFixity
 import RnUtils             ( HsDocContext(..), newLocalBndrRn, bindLocalNames
                            , warnUnusedMatches, newLocalBndrRn
-                           , checkDupAndShadowedNames, checkTupSize
-                           , unknownSubordinateErr )
+                           , checkDupNames, checkDupAndShadowedNames
+                           , checkTupSize , unknownSubordinateErr )
 import RnTypes
 import PrelNames
 import TyCon               ( tyConName )
@@ -67,7 +67,7 @@ import TysWiredIn          ( nilDataCon )
 import DataCon
 import qualified GHC.LanguageExtensions as LangExt
 
-import Control.Monad       ( when, liftM, ap, unless )
+import Control.Monad       ( when, liftM, ap )
 import qualified Data.List.NonEmpty as NE
 import Data.Ratio
 
@@ -321,10 +321,11 @@ rnPats ctxt pats thing_inside
           --    complain *twice* about duplicates e.g. f (x,x) = ...
           --
           -- See note [Don't report shadowing for pattern synonyms]
-        ; unless (isPatSynCtxt ctxt)
-              (addErrCtxt doc_pat $
-                checkDupAndShadowedNames envs_before $
-                collectPatsBinders pats')
+        ; let bndrs = collectPatsBinders pats'
+        ; addErrCtxt doc_pat $
+          if isPatSynCtxt ctxt
+             then checkDupNames bndrs
+             else checkDupAndShadowedNames envs_before bndrs
         ; thing_inside pats' } }
   where
     doc_pat = text "In" <+> pprMatchContext ctxt
diff --git a/testsuite/tests/patsyn/should_fail/T14114.hs b/testsuite/tests/patsyn/should_fail/T14114.hs
new file mode 100644
index 0000000..b1fb8e6
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T14114.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE PatternSynonyms #-}
+module T14114 where
+
+pattern Foo1 a <- (a,a)
+pattern Foo2 a  = (a,a)
+pattern Foo3 a <- (a,a) where
+  Foo3 a = (a,a)
diff --git a/testsuite/tests/patsyn/should_fail/T14114.stderr b/testsuite/tests/patsyn/should_fail/T14114.stderr
new file mode 100644
index 0000000..a93b51e
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T14114.stderr
@@ -0,0 +1,18 @@
+
+T14114.hs:4:20: error:
+    • Conflicting definitions for ‘a’
+      Bound at: T14114.hs:4:20
+                T14114.hs:4:22
+    • In a pattern synonym declaration
+
+T14114.hs:5:20: error:
+    • Conflicting definitions for ‘a’
+      Bound at: T14114.hs:5:20
+                T14114.hs:5:22
+    • In a pattern synonym declaration
+
+T14114.hs:6:20: error:
+    • Conflicting definitions for ‘a’
+      Bound at: T14114.hs:6:20
+                T14114.hs:6:22
+    • In a pattern synonym declaration
diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T
index 86ec79a..92989cf 100644
--- a/testsuite/tests/patsyn/should_fail/all.T
+++ b/testsuite/tests/patsyn/should_fail/all.T
@@ -36,3 +36,4 @@ test('T12819', normal, compile_fail, [''])
 test('UnliftedPSBind', normal, compile_fail, [''])
 test('T13349', normal, compile_fail, [''])
 test('T13470', normal, compile_fail, [''])
+test('T14114', normal, compile_fail, [''])