Fix #10489
authorRichard Eisenberg <eir@cis.upenn.edu>
Fri, 5 Jun 2015 13:56:21 +0000 (09:56 -0400)
committerRichard Eisenberg <eir@cis.upenn.edu>
Fri, 5 Jun 2015 15:09:24 +0000 (11:09 -0400)
Dang, roles are annoying.

Test case: typecheck/should_compile/T10489

compiler/hsSyn/HsUtils.hs
testsuite/tests/typecheck/should_compile/T10489.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T

index f4737e7..fd3d5ef 100644 (file)
@@ -504,9 +504,10 @@ mkHsWrapPat :: HsWrapper -> Pat id -> Type -> Pat id
 mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p
                        | otherwise           = CoPat co_fn p ty
 
 mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p
                        | otherwise           = CoPat co_fn p ty
 
+-- input coercion is Nominal
 mkHsWrapPatCo :: TcCoercion -> Pat id -> Type -> Pat id
 mkHsWrapPatCo co pat ty | isTcReflCo co = pat
 mkHsWrapPatCo :: TcCoercion -> Pat id -> Type -> Pat id
 mkHsWrapPatCo co pat ty | isTcReflCo co = pat
-                        | otherwise     = CoPat (mkWpCast co) pat ty
+                        | otherwise     = CoPat (mkWpCast (mkTcSubCo co)) pat ty
 
 mkHsDictLet :: TcEvBinds -> LHsExpr Id -> LHsExpr Id
 mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr
 
 mkHsDictLet :: TcEvBinds -> LHsExpr Id -> LHsExpr Id
 mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr
diff --git a/testsuite/tests/typecheck/should_compile/T10489.hs b/testsuite/tests/typecheck/should_compile/T10489.hs
new file mode 100644 (file)
index 0000000..892965e
--- /dev/null
@@ -0,0 +1,3 @@
+module T10489 where
+
+convert d = let d' = case d of '0' -> '!' in d'
index 12e2612..dbd6328 100644 (file)
@@ -254,9 +254,9 @@ test('tc236', normal, compile, [''])
 test('tc237', normal, compile, [''])
 test('tc238', normal, compile, [''])
 
 test('tc237', normal, compile, [''])
 test('tc238', normal, compile, [''])
 
-test('tc239', extra_clean(['Tc239_Help.hi', 'Tc239_Help.o']), 
+test('tc239', extra_clean(['Tc239_Help.hi', 'Tc239_Help.o']),
      multimod_compile, ['tc239', '-v0'])
      multimod_compile, ['tc239', '-v0'])
-     
+
 test('tc240', normal, compile, [''])
 test('tc241', normal, compile, [''])
 test('tc242', normal, compile, [''])
 test('tc240', normal, compile, [''])
 test('tc241', normal, compile, [''])
 test('tc242', normal, compile, [''])
@@ -278,13 +278,13 @@ test('FD4', normal, compile, [''])
 test('faxen', normal, compile, [''])
 test('T1495', normal, compile, [''])
 test('T2045', normal, compile, [''])   # Needs -fhpc
 test('faxen', normal, compile, [''])
 test('T1495', normal, compile, [''])
 test('T2045', normal, compile, [''])   # Needs -fhpc
-test('T2478', normal, compile, ['']) 
-test('T2433', extra_clean(['T2433_Help.hi', 'T2433_Help.o']), 
+test('T2478', normal, compile, [''])
+test('T2433', extra_clean(['T2433_Help.hi', 'T2433_Help.o']),
      multimod_compile, ['T2433', '-v0'])
      multimod_compile, ['T2433', '-v0'])
-test('T2494', normal, compile_fail, ['']) 
-test('T2494-2', normal, compile, ['']) 
-test('T2497', normal, compile, ['']) 
-     
+test('T2494', normal, compile_fail, [''])
+test('T2494-2', normal, compile, [''])
+test('T2497', normal, compile, [''])
+
 
 # Omitting temporarily
 test('syn-perf', normal, compile, ['-freduction-depth=30'])
 
 # Omitting temporarily
 test('syn-perf', normal, compile, ['-freduction-depth=30'])
@@ -332,7 +332,7 @@ test('T4498', normal, compile, [''])
 test('T4524', normal, compile, [''])
 test('T4917', normal, compile, [''])
 
 test('T4524', normal, compile, [''])
 test('T4917', normal, compile, [''])
 
-test('T4912', extra_clean(['T4912a.hi', 'T4912a.o']), 
+test('T4912', extra_clean(['T4912a.hi', 'T4912a.o']),
      multimod_compile, ['T4912', '-v0'])
 
 test('T4952', normal, compile, [''])
      multimod_compile, ['T4912', '-v0'])
 
 test('T4952', normal, compile, [''])
@@ -457,3 +457,4 @@ test('T10390', normal, compile, [''])
 test('T8555', normal, compile, [''])
 test('T8799', normal, compile, [''])
 test('T10423', normal, compile, [''])
 test('T8555', normal, compile, [''])
 test('T8799', normal, compile, [''])
 test('T10423', normal, compile, [''])
+test('T10489', normal, compile, [''])