summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard Eisenberg <rae@cs.brynmawr.edu>2018-11-01 18:03:21 -0400
committerRichard Eisenberg <rae@cs.brynmawr.edu>2018-11-01 18:05:14 -0400
commit1f72a1c81368e34387aac38c0b1c59521cec58ec (patch)
treee074c1f92f4459ff21b56b68476696e56c5afc72
parent74ed9c1c1b26971133c7166663b9c966d2eaca08 (diff)
downloadhaskell-1f72a1c81368e34387aac38c0b1c59521cec58ec.tar.gz
Don't lint erroneous programs.
newFamInst lints its types. This is good. But it's not so good when there have been errors and thus recovery tycons are about. So we now don't. Fixes #15796. Test case: typecheck/should_fail/T15796
-rw-r--r--compiler/typecheck/FamInst.hs7
-rw-r--r--testsuite/tests/typecheck/should_fail/T15796.hs8
-rw-r--r--testsuite/tests/typecheck/should_fail/T15796.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/all.T1
4 files changed, 20 insertions, 2 deletions
diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index 5825232574..4944598aeb 100644
--- a/compiler/typecheck/FamInst.hs
+++ b/compiler/typecheck/FamInst.hs
@@ -150,7 +150,7 @@ See #9562.
-- It is defined here to avoid a dependency from FamInstEnv on the monad
-- code.
-newFamInst :: FamFlavor -> CoAxiom Unbranched -> TcRnIf gbl lcl FamInst
+newFamInst :: FamFlavor -> CoAxiom Unbranched -> TcM FamInst
-- Freshen the type variables of the FamInst branches
newFamInst flavor axiom@(CoAxiom { co_ax_tc = fam_tc })
= ASSERT2( tyCoVarsOfTypes lhs `subVarSet` tcv_set, text "lhs" <+> pp_ax )
@@ -162,7 +162,10 @@ newFamInst flavor axiom@(CoAxiom { co_ax_tc = fam_tc })
; let lhs' = substTys subst lhs
rhs' = substTy subst rhs
tcvs' = tvs' ++ cvs'
- ; when (gopt Opt_DoCoreLinting dflags) $
+ ; ifErrsM (return ()) $ -- Don't lint when there are errors, because
+ -- errors might mean TcTyCons.
+ -- See Note [Recover from validity error] in TcTyClsDecls
+ when (gopt Opt_DoCoreLinting dflags) $
-- Check that the types involved in this instance are well formed.
-- Do /not/ expand type synonyms, for the reasons discussed in
-- Note [Linting type synonym applications].
diff --git a/testsuite/tests/typecheck/should_fail/T15796.hs b/testsuite/tests/typecheck/should_fail/T15796.hs
new file mode 100644
index 0000000000..450064d4cc
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T15796.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+module Bug where
+
+newtype N a where
+ MkN :: Show a => a -> N a
+type family T a
+type instance T (N a) = N a
diff --git a/testsuite/tests/typecheck/should_fail/T15796.stderr b/testsuite/tests/typecheck/should_fail/T15796.stderr
new file mode 100644
index 0000000000..3aa7ae8d65
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T15796.stderr
@@ -0,0 +1,6 @@
+
+T15796.hs:6:3: error:
+ • A newtype constructor cannot have a context in its type
+ MkN :: forall a. Show a => a -> N a
+ • In the definition of data constructor ‘MkN’
+ In the newtype declaration for ‘N’
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index f80f5cda01..c3a9f510d0 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -486,3 +486,4 @@ test('T15552a', normal, compile_fail, [''])
test('T15629', normal, compile_fail, [''])
test('T15767', normal, compile_fail, [''])
test('T15648', [extra_files(['T15648a.hs'])], multimod_compile_fail, ['T15648', '-v0 -fprint-equality-relations'])
+test('T15796', normal, compile_fail, [''])