Fix OptCoercion
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 2 Jan 2018 17:25:58 +0000 (17:25 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 3 Jan 2018 11:26:20 +0000 (11:26 +0000)
In the presence of -fdefer-type-errors, OptCoercion can
encounter a mal-formed coerercion with type
    T a ~ T a b
and that was causing a subsequent Lint error.

This caused Trac #14607.  Easily fixed by turning an ASSERT
into a guard.

compiler/types/OptCoercion.hs
testsuite/tests/typecheck/should_fail/T14607.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T14607.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/all.T

index e8379ad..24dc8a4 100644 (file)
@@ -934,8 +934,10 @@ etaTyConAppCo_maybe tc co
   , tc1 == tc2
   , isInjectiveTyCon tc r  -- See Note [NthCo and newtypes] in TyCoRep
   , let n = length tys1
+  , tys2 `lengthIs` n      -- This can fail in an erroneous progam
+                           -- E.g. T a ~# T a b
+                           -- Trac #14607
   = ASSERT( tc == tc1 )
-    ASSERT( tys2 `lengthIs` n )
     Just (decomposeCo n co)
     -- NB: n might be <> tyConArity tc
     -- e.g.   data family T a :: * -> *
diff --git a/testsuite/tests/typecheck/should_fail/T14607.hs b/testsuite/tests/typecheck/should_fail/T14607.hs
new file mode 100644 (file)
index 0000000..891d3cc
--- /dev/null
@@ -0,0 +1,23 @@
+{-# OPTIONS_GHC -fdefer-type-errors #-}
+    -- This line is crucial to the bug
+
+{-# Language GADTs #-}
+{-# Language InstanceSigs #-}
+{-# Language KindSignatures #-}
+{-# Language TypeFamilies #-}
+{-# Language DataKinds #-}
+{-# Language FlexibleInstances #-}
+
+module T14607 where
+
+import Data.Kind
+
+data LamCons :: Type -> Type -> () -> Type where
+  C :: LamCons a a '()
+
+class Mk a where
+  mk :: LamCons a a '()
+
+instance Mk a where
+  mk :: LamCons a '()
+  mk = mk
diff --git a/testsuite/tests/typecheck/should_fail/T14607.stderr b/testsuite/tests/typecheck/should_fail/T14607.stderr
new file mode 100644 (file)
index 0000000..740f89a
--- /dev/null
@@ -0,0 +1,21 @@
+
+T14607.hs:22:9: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • Expecting one more argument to ‘LamCons a  '()’
+      Expected a type, but ‘LamCons a  '()’ has kind ‘() -> *’
+    • In the type signature: mk :: LamCons a  '()
+      In the instance declaration for ‘Mk a’
+
+T14607.hs:22:19: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • Expected a type, but ‘ '()’ has kind ‘()’
+    • In the second argument of ‘LamCons’, namely ‘ '()’
+      In the type signature: mk :: LamCons a  '()
+      In the instance declaration for ‘Mk a’
+
+T14607.hs:23:8: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • Couldn't match expected type ‘LamCons a '()’
+                  with actual type ‘LamCons a0 a0 '()’
+    • In the expression: mk
+      In an equation for ‘mk’: mk = mk
+      In the instance declaration for ‘Mk a’
+    • Relevant bindings include
+        mk :: LamCons a '() (bound at T14607.hs:23:3)
index b1a0e75..2d8137f 100644 (file)
@@ -463,3 +463,4 @@ test('T14350', normal, compile_fail, [''])
 test('T14390', normal, compile_fail, [''])
 test('MissingExportList03', normal, compile_fail, [''])
 test('T14618', normal, compile_fail, [''])
+test('T14607', normal, compile, [''])