diff options
| -rw-r--r-- | compiler/typecheck/TcExpr.hs-boot | 4 | ||||
| -rw-r--r-- | compiler/typecheck/TcMatches.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/T17343.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/T17343.stderr | 4 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 1 |
5 files changed, 18 insertions, 5 deletions
diff --git a/compiler/typecheck/TcExpr.hs-boot b/compiler/typecheck/TcExpr.hs-boot index 25650e34fc..efebcdc6e5 100644 --- a/compiler/typecheck/TcExpr.hs-boot +++ b/compiler/typecheck/TcExpr.hs-boot @@ -15,11 +15,11 @@ tcMonoExpr, tcMonoExprNC :: -> ExpRhoType -> TcM (LHsExpr GhcTcId) -tcInferSigma, tcInferSigmaNC :: +tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTcId, TcSigmaType) -tcInferRho :: +tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTcId, TcRhoType) diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index b01776a175..f971da2aa3 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -21,7 +21,7 @@ module TcMatches ( tcMatchesFun, tcGRHS, tcGRHSsPat, tcMatchesCase, tcMatchLambd import GhcPrelude -import {-# SOURCE #-} TcExpr( tcSyntaxOp, tcInferSigmaNC, tcInferSigma +import {-# SOURCE #-} TcExpr( tcSyntaxOp, tcInferRhoNC, tcInferRho , tcCheckId, tcMonoExpr, tcMonoExprNC, tcPolyExpr ) import BasicTypes (LexicalFixity(..)) @@ -404,7 +404,7 @@ tcGuardStmt _ (BodyStmt _ guard _ _) res_ty thing_inside ; return (BodyStmt boolTy guard' noSyntaxExpr noSyntaxExpr, thing) } tcGuardStmt ctxt (BindStmt _ pat rhs _ _) res_ty thing_inside - = do { (rhs', rhs_ty) <- tcInferSigmaNC rhs + = do { (rhs', rhs_ty) <- tcInferRhoNC rhs -- Stmt has a context already ; (pat', thing) <- tcPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs) pat (mkCheckExpType rhs_ty) $ @@ -478,7 +478,7 @@ tcLcStmt m_tc ctxt (TransStmt { trS_form = form, trS_stmts = stmts -- passed in to tcStmtsAndThen is never looked at ; (stmts', (bndr_ids, by')) <- tcStmtsAndThen (TransStmtCtxt ctxt) (tcLcStmt m_tc) stmts unused_ty $ \_ -> do - { by' <- traverse tcInferSigma by + { by' <- traverse tcInferRho by ; bndr_ids <- tcLookupLocalIds bndr_names ; return (bndr_ids, by') } diff --git a/testsuite/tests/typecheck/should_compile/T17343.hs b/testsuite/tests/typecheck/should_compile/T17343.hs new file mode 100644 index 0000000000..e3179b4e23 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T17343.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE BangPatterns #-} + +h :: () +h | !_ <- undefined = () +{-# NOINLINE h #-} + +-- main is expected to crash +main = print h diff --git a/testsuite/tests/typecheck/should_compile/T17343.stderr b/testsuite/tests/typecheck/should_compile/T17343.stderr new file mode 100644 index 0000000000..044fa41d77 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T17343.stderr @@ -0,0 +1,4 @@ +T17343: Prelude.undefined +CallStack (from HasCallStack): + error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err + undefined, called at T17343.hs:4:5 in main:Main diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 7594265db6..c51ff0b36b 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -692,3 +692,4 @@ test('T17067', normal, compile, ['']) test('T17202', expect_broken(17202), compile, ['']) test('T15839a', normal, compile, ['']) test('T15839b', normal, compile, ['']) +test('T17343', exit_code(1), compile_and_run, ['']) |