[commit: ghc] master: Fix #11287. (da69358)
git at git.haskell.org
git at git.haskell.org
Sat Dec 26 21:02:55 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/da69358bfb1b71c6455c420399fd6a18a02ee5df/ghc
>---------------------------------------------------------------
commit da69358bfb1b71c6455c420399fd6a18a02ee5df
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date: Sat Dec 26 12:58:03 2015 -0500
Fix #11287.
Happily, the fix is simply deleting some old code. I love it when
that happens.
>---------------------------------------------------------------
da69358bfb1b71c6455c420399fd6a18a02ee5df
compiler/coreSyn/CoreUtils.hs | 2 +-
compiler/typecheck/TcMatches.hs | 10 +---------
testsuite/tests/th/all.T | 2 +-
3 files changed, 3 insertions(+), 11 deletions(-)
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 9d887ec..f31eac6 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -616,7 +616,7 @@ refineDefaultAlt us tycon tys imposs_deflt_cons all_alts
-- Check for no data constructors
-- This can legitimately happen for abstract types and type families,
-- so don't report that
- = pprTrace "prepareDefault" (ppr tycon) (False, all_alts)
+ = (False, all_alts)
| otherwise -- The common case
= (False, all_alts)
diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs
index 2e4078b..f7bb726 100644
--- a/compiler/typecheck/TcMatches.hs
+++ b/compiler/typecheck/TcMatches.hs
@@ -117,13 +117,6 @@ tcMatchesCase :: (Outputable (body Name)) =>
-- wrapper goes from MatchGroup's ty to expected ty
tcMatchesCase ctxt scrut_ty matches res_ty
- | isEmptyMatchGroup matches -- Allow empty case expressions
- = return (MG { mg_alts = noLoc []
- , mg_arg_tys = [scrut_ty]
- , mg_res_ty = res_ty
- , mg_origin = mg_origin matches })
-
- | otherwise
= do { res_ty <- tauifyMultipleMatches matches res_ty
; tcMatches ctxt [scrut_ty] res_ty matches }
@@ -220,8 +213,7 @@ data TcMatchCtxt body -- c.f. TcStmtCtxt, also in this module
tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches
, mg_origin = origin })
- = ASSERT( not (null matches) ) -- Ensure that rhs_ty is filled in
- do { matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches
+ = do { matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches
; return (MG { mg_alts = L l matches'
, mg_arg_tys = pat_tys
, mg_res_ty = rhs_ty
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 2a82a23..fb429bc 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -272,7 +272,7 @@ test('T7532',
['T7532', '-v0 ' + config.ghc_th_way_flags])
test('T2222', normal, compile, ['-v0'])
test('T1849', normal, ghci_script, ['T1849.script'])
-test('T7681', when(compiler_debugged(), expect_broken(11287)), compile, ['-v0'])
+test('T7681', normal, compile, ['-v0'])
test('T7910', normal, compile_and_run, ['-v0'])
test('ClosedFam1TH', normal, compile, ['-dsuppress-uniques -v0'])
More information about the ghc-commits
mailing list