[commit: ghc] master: Require PatternSynonyms language flag when encountering a use of pattern synonym (#8961) (8f831ec)
git at git.haskell.org
git at git.haskell.org
Sun Apr 6 15:06:50 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/8f831ec578d22419788542290e164c50524d90f6/ghc
>---------------------------------------------------------------
commit 8f831ec578d22419788542290e164c50524d90f6
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)
>---------------------------------------------------------------
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(-)
diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 0c8c09d..3c5ea84 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 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',''])
More information about the ghc-commits
mailing list