From da69358bfb1b71c6455c420399fd6a18a02ee5df Mon Sep 17 00:00:00 2001 From: Richard Eisenberg Date: Sat, 26 Dec 2015 12:58:03 -0500 Subject: [PATCH] Fix #11287. Happily, the fix is simply deleting some old code. I love it when that happens. --- 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 9d887ecf46..f31eac6c87 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 2e4078b4ee..f7bb726ae8 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 2a82a2312d..fb429bcbd5 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']) -- GitLab