[commit: ghc] wip/pattern-synonyms: Require PatternSynonyms language flag when encountering a use of pattern synonym (#8961) (60ec752)

[git at git.haskell.org]

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

On branch  : wip/pattern-synonyms
Link       : http://ghc.haskell.org/trac/ghc/changeset/60ec752c7e5378c8eeb556391ae34ab8c37426c4/ghc

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

commit 60ec752c7e5378c8eeb556391ae34ab8c37426c4
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Sun Apr 6 21:26:46 2014 +0800

    Require PatternSynonyms language flag when encountering a use of pattern synonym
    (#8961)


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

60ec752c7e5378c8eeb556391ae34ab8c37426c4
 compiler/typecheck/TcPat.lhs                    |    8 +++-----
 testsuite/tests/patsyn/should_compile/all.T     |    1 +
 testsuite/tests/patsyn/should_compile/export.hs |    4 ++++
 testsuite/tests/patsyn/should_fail/T8961.hs     |    7 +++++++
 testsuite/tests/patsyn/should_fail/T8961.stderr |    7 +++++++
 testsuite/tests/patsyn/should_fail/T8961a.hs    |    4 ++++
 testsuite/tests/patsyn/should_fail/all.T        |    1 +
 7 files changed, 27 insertions(+), 5 deletions(-)

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index ab6d7bd..a5ae5a1 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -777,14 +777,12 @@ tcPatSynPat penv (L con_span _) pat_syn pat_ty arg_pats thing_inside
 
         ; prov_dicts' <- newEvVars prov_theta'
 
-          {-
+        -- Using a pattern synonym requires the PatternSynonyms
+        -- language flag to keep consistent with #2905
         ; patsyns_on <- xoptM Opt_PatternSynonyms
 	; checkTc patsyns_on
                   (ptext (sLit "A pattern match on a pattern synonym requires PatternSynonyms"))
-		  -- Trac #2905 decided that a *pattern-match* of a GADT
-		  -- should require the GADT language flag.
-                  -- Re TypeFamilies see also #7156
--}
+
         ; let skol_info = case pe_ctxt penv of
                             LamPat mc -> PatSkol (PatSynCon pat_syn) mc
                             LetPat {} -> UnkSkol -- Doesn't matter
diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T
index 84b231c..71b0b71 100644
--- a/testsuite/tests/patsyn/should_compile/all.T
+++ b/testsuite/tests/patsyn/should_compile/all.T
@@ -7,3 +7,4 @@ test('ex-view', normal, compile, [''])
 test('ex-num', normal, compile, [''])
 test('num', normal, compile, [''])
 test('incomplete', normal, compile, [''])
+test('export', normal, compile, [''])
diff --git a/testsuite/tests/patsyn/should_compile/export.hs b/testsuite/tests/patsyn/should_compile/export.hs
new file mode 100644
index 0000000..957f735
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/export.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE PatternSynonyms #-}
+module ShouldCompile (pattern Single) where
+
+pattern Single x <- [x]
diff --git a/testsuite/tests/patsyn/should_fail/T8961.hs b/testsuite/tests/patsyn/should_fail/T8961.hs
new file mode 100644
index 0000000..087c399
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T8961.hs
@@ -0,0 +1,7 @@
+module ShouldFail where
+
+import T8961a
+
+single :: [a] -> Maybe a
+single (Single x) = Just x
+single _ = Nothing
diff --git a/testsuite/tests/patsyn/should_fail/T8961.stderr b/testsuite/tests/patsyn/should_fail/T8961.stderr
new file mode 100644
index 0000000..a58ee38
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T8961.stderr
@@ -0,0 +1,7 @@
+[1 of 2] Compiling T8961a           ( T8961a.hs, T8961a.o )
+[2 of 2] Compiling ShouldFail       ( T8961.hs, T8961.o )
+
+T8961.hs:6:9:
+    A pattern match on a pattern synonym requires PatternSynonyms
+    In the pattern: Single x
+    In an equation for ‘single’: single (Single x) = Just x
diff --git a/testsuite/tests/patsyn/should_fail/T8961a.hs b/testsuite/tests/patsyn/should_fail/T8961a.hs
new file mode 100644
index 0000000..f741d7b
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T8961a.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE PatternSynonyms #-}
+module T8961a (pattern Single) where
+
+pattern Single x <- [x]
diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T
index 0a07aed..2590a30 100644
--- a/testsuite/tests/patsyn/should_fail/all.T
+++ b/testsuite/tests/patsyn/should_fail/all.T
@@ -2,3 +2,4 @@
 test('mono', normal, compile_fail, [''])
 test('unidir', normal, compile_fail, [''])
 test('local', normal, compile_fail, [''])
+test('T8961', normal, multimod_compile_fail, ['T8961',''])