desugar: Catch levity polymorphism in unboxed sum expressions
authorBen Gamari <ben@smart-cactus.org>
Tue, 26 Sep 2017 18:52:26 +0000 (14:52 -0400)
committerBen Gamari <ben@smart-cactus.org>
Wed, 27 Sep 2017 02:48:17 +0000 (22:48 -0400)
Fixes #13929.

(cherry picked from commit 018c40fb1bb27853d0cefa5b90a44ce13e91a856)

compiler/deSugar/DsExpr.hs
testsuite/tests/typecheck/should_fail/T13929.stderr
testsuite/tests/typecheck/should_fail/all.T

index 3cbc917..8f236b7 100644 (file)
@@ -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
index 3ddf5b3..d1e1f63 100644 (file)
@@ -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
index 2942639..9f9752a 100644 (file)
@@ -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, [''])