rnMethodBind: reject pattern synonyms in instance definitions (fixes #9705)
authorDr. ERDI Gergo <gergo@erdi.hu>
Tue, 21 Oct 2014 12:51:35 +0000 (20:51 +0800)
committerDr. ERDI Gergo <gergo@erdi.hu>
Sat, 1 Nov 2014 11:14:17 +0000 (19:14 +0800)
compiler/rename/RnBinds.lhs
testsuite/tests/patsyn/should_fail/T9705.hs [new file with mode: 0644]
testsuite/tests/patsyn/should_fail/T9705.stderr [new file with mode: 0644]
testsuite/tests/patsyn/should_fail/all.T

index 96cb1aa..555d833 100644 (file)
@@ -745,6 +745,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}
 
@@ -1061,6 +1066,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 (file)
index 0000000..54d1d00
--- /dev/null
@@ -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 (file)
index 0000000..d9a3a49
--- /dev/null
@@ -0,0 +1,4 @@
+
+T9705.hs:3:5:
+    Pattern synonyms not allowed in instance declarations
+      pattern P = ()
index bff6bdf..298f23b 100644 (file)
@@ -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, [''])