[commit: ghc] master: Disallow unboxed string literals in patterns (#13260) (6177c0d)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6177c0d8bdc6f5c0675b2eace592620abb658787/ghc

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

commit 6177c0d8bdc6f5c0675b2eace592620abb658787
Author: Rupert Horlick <ruperthorlick at gmail.com>
Date:   Mon Mar 6 13:44:40 2017 -0500

    Disallow unboxed string literals in patterns (#13260)
    
    Signed-off-by: Rupert Horlick <ruperthorlick at gmail.com>
    
    Reviewers: austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3286


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

6177c0d8bdc6f5c0675b2eace592620abb658787
 compiler/parser/RdrHsSyn.hs                      | 3 +++
 testsuite/tests/parser/should_fail/T13260.hs     | 7 +++++++
 testsuite/tests/parser/should_fail/T13260.stderr | 4 ++++
 testsuite/tests/parser/should_fail/all.T         | 1 +
 4 files changed, 15 insertions(+)

diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 2c63c42..e06c7e3 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -829,6 +829,9 @@ checkAPat msg loc e0 = do
  case e0 of
    EWildPat -> return (WildPat placeHolderType)
    HsVar x  -> return (VarPat x)
+   HsLit (HsStringPrim _ _) -- (#13260)
+       -> parseErrorSDoc loc (text "Illegal unboxed string literal in pattern:" $$ ppr e0)
+
    HsLit l  -> return (LitPat l)
 
    -- Overloaded numeric patterns (e.g. f 0 x = x)
diff --git a/testsuite/tests/parser/should_fail/T13260.hs b/testsuite/tests/parser/should_fail/T13260.hs
new file mode 100644
index 0000000..b0e1f97
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T13260.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE MagicHash #-}
+
+module T13260 where
+
+  g y = case y of
+    "a"# -> True
+    _    -> False
diff --git a/testsuite/tests/parser/should_fail/T13260.stderr b/testsuite/tests/parser/should_fail/T13260.stderr
new file mode 100644
index 0000000..05e99d6
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T13260.stderr
@@ -0,0 +1,4 @@
+
+T13260.hs:6:5: error:
+    Illegal unboxed string literal in pattern:
+    "a"#
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index b3efb5c..1496fec 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -96,3 +96,4 @@ test('T10498b', normal, compile_fail, [''])
 test('T12051', normal, compile_fail, [''])
 test('T12429', normal, compile_fail, [''])
 test('T12811', normal, compile_fail, [''])
+test('T13260', normal, compile_fail, [''])