diff options
| author | Richard Eisenberg <eir@cis.upenn.edu> | 2015-06-05 09:56:21 -0400 |
|---|---|---|
| committer | Richard Eisenberg <eir@cis.upenn.edu> | 2015-06-05 11:09:24 -0400 |
| commit | 61b96a86c5342fb1c850361177d60fe855d948f6 (patch) | |
| tree | 755b996764698214d91277a038085c34ce59a7cd | |
| parent | 53c13744210402151e58baf0d703d23927f5188d (diff) | |
| download | haskell-61b96a86c5342fb1c850361177d60fe855d948f6.tar.gz | |
Fix #10489
Dang, roles are annoying.
Test case: typecheck/should_compile/T10489
| -rw-r--r-- | compiler/hsSyn/HsUtils.hs | 3 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/T10489.hs | 3 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 19 |
3 files changed, 15 insertions, 10 deletions
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index f4737e7bdb..fd3d5efa6a 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -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 +-- input coercion is Nominal 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 diff --git a/testsuite/tests/typecheck/should_compile/T10489.hs b/testsuite/tests/typecheck/should_compile/T10489.hs new file mode 100644 index 0000000000..892965e8d8 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10489.hs @@ -0,0 +1,3 @@ +module T10489 where + +convert d = let d' = case d of '0' -> '!' in d' diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 12e26128bc..dbd6328cae 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -254,9 +254,9 @@ test('tc236', 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']) - + 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('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']) -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']) @@ -332,7 +332,7 @@ test('T4498', 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, ['']) @@ -457,3 +457,4 @@ test('T10390', normal, compile, ['']) test('T8555', normal, compile, ['']) test('T8799', normal, compile, ['']) test('T10423', normal, compile, ['']) +test('T10489', normal, compile, ['']) |