Fix #14114 by checking for duplicate vars on pattern synonym RHSes
authorRyan Scott <ryan.gl.scott@gmail.com>
Tue, 22 Aug 2017 13:28:49 +0000 (09:28 -0400)
committerRyan Scott <ryan.gl.scott@gmail.com>
Tue, 22 Aug 2017 13:28:49 +0000 (09:28 -0400)
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

compiler/rename/RnPat.hs
testsuite/tests/patsyn/should_fail/T14114.hs [new file with mode: 0644]
testsuite/tests/patsyn/should_fail/T14114.stderr [new file with mode: 0644]
testsuite/tests/patsyn/should_fail/all.T

index 320e4f3..9b439a7 100644 (file)
@@ -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 (file)
index 0000000..b1fb8e6
--- /dev/null
@@ -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 (file)
index 0000000..a93b51e
--- /dev/null
@@ -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
index 86ec79a..92989cf 100644 (file)
@@ -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, [''])