From 41f0f6c2f571ea05c49f9f6ed64beebdc5a9f9fc Mon Sep 17 00:00:00 2001
From: Richard Eisenberg <rae@cs.brynmawr.edu>
Date: Thu, 1 Nov 2018 18:03:21 -0400
Subject: [PATCH] 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

(cherry picked from commit 1f72a1c81368e34387aac38c0b1c59521cec58ec)
---
 compiler/typecheck/FamInst.hs                       | 7 +++++--
 testsuite/tests/typecheck/should_fail/T15796.hs     | 8 ++++++++
 testsuite/tests/typecheck/should_fail/T15796.stderr | 6 ++++++
 testsuite/tests/typecheck/should_fail/all.T         | 1 +
 4 files changed, 20 insertions(+), 2 deletions(-)
 create mode 100644 testsuite/tests/typecheck/should_fail/T15796.hs
 create mode 100644 testsuite/tests/typecheck/should_fail/T15796.stderr

diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index 00602ecba54..eff33e3210d 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 00000000000..450064d4cc6
--- /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 00000000000..3aa7ae8d656
--- /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 e12aba63621..1b635cf6140 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, [''])
-- 
GitLab