Fix #16411 by making dataConCannotMatch aware of (~~)
authorRyan Scott <ryan.gl.scott@gmail.com>
Sat, 9 Mar 2019 00:02:44 +0000 (19:02 -0500)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Wed, 13 Mar 2019 19:16:08 +0000 (15:16 -0400)
The `dataConCannotMatch` function (which powers the
`-Wpartial-fields` warning, among other things) had special reasoning
for explicit equality constraints of the form `a ~ b`, but it did
not extend that reasoning to `a ~~ b` constraints, leading to #16411.
Easily fixed.

compiler/basicTypes/DataCon.hs
testsuite/tests/typecheck/should_compile/T16411.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T

index 8baf43c..690ed68 100644 (file)
@@ -1403,10 +1403,13 @@ dataConCannotMatch tys con
 
     -- TODO: could gather equalities from superclasses too
     predEqs pred = case classifyPredType pred of
 
     -- TODO: could gather equalities from superclasses too
     predEqs pred = case classifyPredType pred of
-                     EqPred NomEq ty1 ty2       -> [(ty1, ty2)]
-                     ClassPred eq [_, ty1, ty2]
-                       | eq `hasKey` eqTyConKey -> [(ty1, ty2)]
-                     _                          -> []
+                     EqPred NomEq ty1 ty2         -> [(ty1, ty2)]
+                     ClassPred eq args
+                       | eq `hasKey` eqTyConKey
+                       , [_, ty1, ty2] <- args    -> [(ty1, ty2)]
+                       | eq `hasKey` heqTyConKey
+                       , [_, _, ty1, ty2] <- args -> [(ty1, ty2)]
+                     _                            -> []
 
 -- | Were the type variables of the data con written in a different order
 -- than the regular order (universal tyvars followed by existential tyvars)?
 
 -- | Were the type variables of the data con written in a different order
 -- than the regular order (universal tyvars followed by existential tyvars)?
diff --git a/testsuite/tests/typecheck/should_compile/T16411.hs b/testsuite/tests/typecheck/should_compile/T16411.hs
new file mode 100644 (file)
index 0000000..5cbd255
--- /dev/null
@@ -0,0 +1,14 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -Wpartial-fields #-}
+module T16411 where
+
+import Data.Type.Equality
+
+data T1 z where
+  MkT1a :: { rec1 :: () } -> T1 Int
+  MkT1b :: (z ~ Bool) => T1 z
+
+data T2 z where
+  MkT2a :: { rec2 :: () } -> T2 Int
+  MkT2b :: (z ~~ Bool) => T2 z
index b94f021..81a63c5 100644 (file)
@@ -670,3 +670,4 @@ test('T16204a', normal, compile, [''])
 test('T16204b', normal, compile, [''])
 test('T16225', normal, compile, [''])
 test('T13951', normal, compile, [''])
 test('T16204b', normal, compile, [''])
 test('T16225', normal, compile, [''])
 test('T13951', normal, compile, [''])
+test('T16411', normal, compile, [''])