[commit: ghc] ghc-7.8: rnMethodBind: reject pattern synonyms in instance definitions (fixes #9705) (df719cb)

[git at git.haskell.org]

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

On branch  : ghc-7.8
Link       : http://ghc.haskell.org/trac/ghc/changeset/df719cbfbc822bf77c5de884b37ef35597cd64ca/ghc

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

commit df719cbfbc822bf77c5de884b37ef35597cd64ca
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Tue Oct 21 20:51:35 2014 +0800

    rnMethodBind: reject pattern synonyms in instance definitions (fixes #9705)
    
    (cherry picked from commit e5ba36080d08791f44e3bed37721f702e242af96)


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

df719cbfbc822bf77c5de884b37ef35597cd64ca
 compiler/rename/RnBinds.lhs                     | 10 ++++++++++
 testsuite/tests/patsyn/should_fail/T9705.hs     |  3 +++
 testsuite/tests/patsyn/should_fail/T9705.stderr |  4 ++++
 testsuite/tests/patsyn/should_fail/all.T        |  1 +
 4 files changed, 18 insertions(+)

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 7251492..3991e24 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -698,6 +698,11 @@ rnMethodBind _ _ (L loc bind@(PatBind {})) = do
     addErrAt loc (methodBindErr bind)
     return (emptyBag, emptyFVs)
 
+-- Associated pattern synonyms are not implemented yet
+rnMethodBind _ _ (L loc bind@(PatSynBind {})) = do
+    addErrAt loc $ methodPatSynErr bind
+    return (emptyBag, emptyFVs)
+
 rnMethodBind _ _ b = pprPanic "rnMethodBind" (ppr b)
 \end{code}
 
@@ -1012,6 +1017,11 @@ methodBindErr mbind
  =  hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))
        2 (ppr mbind)
 
+methodPatSynErr :: HsBindLR RdrName RdrName -> SDoc
+methodPatSynErr mbind
+ =  hang (ptext (sLit "Pattern synonyms not allowed in instance declarations"))
+       2 (ppr mbind)
+
 bindsInHsBootFile :: LHsBindsLR Name RdrName -> SDoc
 bindsInHsBootFile mbinds
   = hang (ptext (sLit "Bindings in hs-boot files are not allowed"))
diff --git a/testsuite/tests/patsyn/should_fail/T9705.hs b/testsuite/tests/patsyn/should_fail/T9705.hs
new file mode 100644
index 0000000..54d1d00
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T9705.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE PatternSynonyms #-}
+class C a where
+    pattern P = ()
diff --git a/testsuite/tests/patsyn/should_fail/T9705.stderr b/testsuite/tests/patsyn/should_fail/T9705.stderr
new file mode 100644
index 0000000..d9a3a49
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T9705.stderr
@@ -0,0 +1,4 @@
+
+T9705.hs:3:5:
+    Pattern synonyms not allowed in instance declarations
+      pattern P = ()
diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T
index bff6bdf..298f23b 100644
--- a/testsuite/tests/patsyn/should_fail/all.T
+++ b/testsuite/tests/patsyn/should_fail/all.T
@@ -6,3 +6,4 @@ test('T8961', normal, multimod_compile_fail, ['T8961',''])
 test('as-pattern', normal, compile_fail, [''])
 test('T9161-1', normal, compile_fail, [''])
 test('T9161-2', normal, compile_fail, [''])
+test('T9705', normal, compile_fail, [''])