From 854f731436073f709f7896f48d239a52da046043 Mon Sep 17 00:00:00 2001
From: "Dr. ERDI Gergo" <gergo@erdi.hu>
Date: Sun, 6 Apr 2014 21:26:46 +0800
Subject: [PATCH] Require PatternSynonyms language flag when encountering a use
 of pattern synonym (#8961)

(cherry picked from commit 8f831ec578d22419788542290e164c50524d90f6)
---
 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(-)
 create mode 100644 testsuite/tests/patsyn/should_compile/export.hs
 create mode 100644 testsuite/tests/patsyn/should_fail/T8961.hs
 create mode 100644 testsuite/tests/patsyn/should_fail/T8961.stderr
 create mode 100644 testsuite/tests/patsyn/should_fail/T8961a.hs

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 0c8c09d54af5..3c5ea84a75c7 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -813,14 +813,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 84b231cf61b2..71b0b71f3fe8 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 000000000000..957f735e202d
--- /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 000000000000..087c39993bf2
--- /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 000000000000..a58ee3800414
--- /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 000000000000..f741d7b5d11b
--- /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 0a07aed04668..2590a308a473 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',''])
-- 
GitLab