diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index 00602ecba547326ebeeb688a295da56873f780f4..eff33e3210dae5d678819c4cf9c34829a79fbd96 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 0000000000000000000000000000000000000000..450064d4cc6e6fc8d02f88b8ba264930661cce28
--- /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 0000000000000000000000000000000000000000..3aa7ae8d656345970b6585509da1333f1d453a43
--- /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 e12aba63621349079d2890191c7f18f6d961320d..1b635cf61407f84612521e125d828a97c19f88c5 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -477,3 +477,4 @@ test('T15067', normal, compile_fail, [''])
 test('T15361', normal, compile_fail, [''])
 test('T15527', normal, compile_fail, [''])
 test('T15767', normal, compile_fail, [''])
+test('T15796', normal, compile_fail, [''])