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>
Tue, 26 Sep 2017 21:40:03 +0000 (17:40 -0400)
Fixes #13929.

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

index 1ed45fc..b2b98f8 100644 (file)
@@ -379,11 +379,11 @@ ds_expr _ (ExplicitTuple tup_args boxity)
                                             mkCoreTupBoxity boxity args) }
 
 ds_expr _ (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]) ) }
 
 ds_expr _ (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 5079397..fe71e37 100644 (file)
@@ -456,5 +456,5 @@ test('T11963', normal, compile_fail, [''])
 test('T14000', normal, compile_fail, [''])
 test('T14055', normal, compile_fail, [''])
 test('T13909', normal, compile_fail, [''])
-test('T13929', expect_broken(13929), compile_fail, [''])
+test('T13929', normal, compile_fail, [''])
 test('T14232', normal, compile_fail, [''])