[commit: ghc] ghc-8.2: desugar: Catch levity polymorphism in unboxed sum expressions (78e6739)

[git at git.haskell.org]

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

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/78e673910f8759f643b263c70ad5c8fffd11a55d/ghc

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

commit 78e673910f8759f643b263c70ad5c8fffd11a55d
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Tue Sep 26 14:52:26 2017 -0400

    desugar: Catch levity polymorphism in unboxed sum expressions
    
    Fixes #13929.
    
    (cherry picked from commit 018c40fb1bb27853d0cefa5b90a44ce13e91a856)


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

78e673910f8759f643b263c70ad5c8fffd11a55d
 compiler/deSugar/DsExpr.hs                          | 10 +++++-----
 testsuite/tests/typecheck/should_fail/T13929.stderr | 12 ++++++++++++
 testsuite/tests/typecheck/should_fail/all.T         |  2 +-
 3 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 3cbc917..8f236b7 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -381,11 +381,11 @@ dsExpr (ExplicitTuple tup_args boxity)
                                             mkCoreTupBoxity boxity args) }
 
 dsExpr (ExplicitSum alt arity expr types)
-  = do { core_expr <- dsLExpr expr
-       ; return $ mkCoreConApps (sumDataCon alt arity)
-                                (map (Type . getRuntimeRep) types ++
-                                 map Type types ++
-                                 [core_expr]) }
+  = do { dsWhenNoErrs (dsLExprNoLP expr)
+                      (\core_expr -> mkCoreConApps (sumDataCon alt arity)
+                                     (map (Type . getRuntimeRep) types ++
+                                      map Type types ++
+                                      [core_expr]) ) }
 
 dsExpr (HsSCC _ cc expr@(L loc _)) = do
     dflags <- getDynFlags
diff --git a/testsuite/tests/typecheck/should_fail/T13929.stderr b/testsuite/tests/typecheck/should_fail/T13929.stderr
index 3ddf5b3..d1e1f63 100644
--- a/testsuite/tests/typecheck/should_fail/T13929.stderr
+++ b/testsuite/tests/typecheck/should_fail/T13929.stderr
@@ -10,3 +10,15 @@ T13929.hs:29:37: error:
       Type: GUnboxed g rg
       Kind: TYPE rg
     In the type of expression: gunbox y
+
+T13929.hs:33:24:
+    A levity-polymorphic type is not allowed here:
+      Type: GUnboxed f rf
+      Kind: TYPE rf
+    In the type of expression: gunbox l
+
+T13929.hs:34:26:
+    A levity-polymorphic type is not allowed here:
+      Type: GUnboxed g rg
+      Kind: TYPE rg
+    In the type of expression: gunbox r
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 2942639..9f9752a 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -437,5 +437,5 @@ test('T13677', normal, compile_fail, [''])
 test('T11963', normal, compile_fail, [''])
 test('T14000', normal, compile_fail, [''])
 test('T11672', normal, compile_fail, [''])
-test('T13929', expect_broken(13929), compile_fail, [''])
+test('T13929', normal, compile_fail, [''])