[commit: ghc] wip/T9732: Binding things matched by an unboxed pattern synonym should require a bang (ba1a59c)

[git at git.haskell.org]

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

On branch  : wip/T9732
Link       : http://ghc.haskell.org/trac/ghc/changeset/ba1a59cd6bcf9b1e04000907bedec1b1572d8c5a/ghc

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

commit ba1a59cd6bcf9b1e04000907bedec1b1572d8c5a
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Sat Nov 1 12:00:19 2014 +0800

    Binding things matched by an unboxed pattern synonym should require a bang


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

ba1a59cd6bcf9b1e04000907bedec1b1572d8c5a
 testsuite/tests/patsyn/should_compile/all.T                    |  1 +
 testsuite/tests/patsyn/should_compile/unboxed-bind-bang.hs     | 10 ++++++++++
 testsuite/tests/patsyn/should_fail/all.T                       |  1 +
 .../should_fail/{unboxed-wrapper-naked.hs => unboxed-bind.hs}  |  6 ++++--
 testsuite/tests/patsyn/should_fail/unboxed-bind.stderr         |  6 ++++++
 5 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T
index e8cfb60..97d4317 100644
--- a/testsuite/tests/patsyn/should_compile/all.T
+++ b/testsuite/tests/patsyn/should_compile/all.T
@@ -11,3 +11,4 @@ test('export', normal, compile, [''])
 test('T8966', normal, compile, [''])
 test('T9023', normal, compile, [''])
 test('T9732', normal, compile, [''])
+test('unboxed-bind-bang', normal, compile, [''])
diff --git a/testsuite/tests/patsyn/should_compile/unboxed-bind-bang.hs b/testsuite/tests/patsyn/should_compile/unboxed-bind-bang.hs
new file mode 100644
index 0000000..a972b21
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/unboxed-bind-bang.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE PatternSynonyms, MagicHash, BangPatterns #-}
+module ShouldCompile where
+
+import GHC.Base
+
+data Foo = MkFoo Int# Int#
+
+pattern P x = MkFoo 0# x
+
+f x = let !(P arg) = x in arg
diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T
index 3979288..96cb097 100644
--- a/testsuite/tests/patsyn/should_fail/all.T
+++ b/testsuite/tests/patsyn/should_fail/all.T
@@ -8,3 +8,4 @@ test('T9161-2', normal, compile_fail, [''])
 test('T9705-1', normal, compile_fail, [''])
 test('T9705-2', normal, compile_fail, [''])
 test('unboxed-wrapper-naked', normal, compile_fail, [''])
+test('unboxed-bind', normal, compile_fail, [''])
diff --git a/testsuite/tests/patsyn/should_fail/unboxed-wrapper-naked.hs b/testsuite/tests/patsyn/should_fail/unboxed-bind.hs
similarity index 52%
copy from testsuite/tests/patsyn/should_fail/unboxed-wrapper-naked.hs
copy to testsuite/tests/patsyn/should_fail/unboxed-bind.hs
index 6e7cc94..ef1b070 100644
--- a/testsuite/tests/patsyn/should_fail/unboxed-wrapper-naked.hs
+++ b/testsuite/tests/patsyn/should_fail/unboxed-bind.hs
@@ -3,6 +3,8 @@ module ShouldFail where
 
 import GHC.Base
 
-pattern P1 = 42#
+data Foo = MkFoo Int# Int#
 
-x = P1
+pattern P x = MkFoo 0# x
+
+f x = let P arg = x in arg
diff --git a/testsuite/tests/patsyn/should_fail/unboxed-bind.stderr b/testsuite/tests/patsyn/should_fail/unboxed-bind.stderr
new file mode 100644
index 0000000..17ca7af
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/unboxed-bind.stderr
@@ -0,0 +1,6 @@
+
+unboxed-bind.hs:10:11:
+    Pattern bindings containing unlifted types should use an outermost bang pattern:
+      P arg = x
+    In the expression: let P arg = x in arg
+    In an equation for ‘f’: f x = let P arg = x in arg