Don't lint erroneous programs. ghc-8.6.2-release
authorRichard Eisenberg <rae@cs.brynmawr.edu>
Thu, 1 Nov 2018 22:03:21 +0000 (18:03 -0400)
committerBen Gamari <ben@smart-cactus.org>
Fri, 2 Nov 2018 15:00:36 +0000 (11:00 -0400)
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
testsuite/tests/typecheck/should_fail/T15796.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T15796.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/all.T

index 00602ec..eff33e3 100644 (file)
@@ -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 (file)
index 0000000..450064d
--- /dev/null
@@ -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 (file)
index 0000000..3aa7ae8
--- /dev/null
@@ -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’
index e12aba6..1b635cf 100644 (file)
@@ -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, [''])