Pmc: COMPLETE pragmas associated with Family TyCons should apply to...

Pmc: COMPLETE pragmas associated with Family TyCons should apply to representation TyCons as well (#24326)

Fixes #24326.

compiler/GHC/Types/CompleteMatch.hs

@@ -35,6 +35,11 @@ completeMatchAppliesAtType ty cm = all @Maybe ty_matches (cmResultTyCon cm)
     ty_matches sig_tc
       | Just (tc, _arg_tys) <- splitTyConApp_maybe ty
       , tc == sig_tc
+      || sig_tc `is_family_ty_con_of` tc
+         -- #24326: sig_tc might be the data Family TyCon of the representation
+         --         TyCon tc -- this CompleteMatch still applies
       = True
       | otherwise
       = False
+    fam_tc `is_family_ty_con_of` repr_tc =
+      (fst <$> tyConFamInst_maybe repr_tc) == Just fam_tc

testsuite/tests/pmcheck/complete_sigs/T24326.hs

+{-# OPTIONS_GHC -Wincomplete-patterns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module T24326 where
+
+data family Foo
+data instance Foo = A | B
+{-# COMPLETE A :: Foo #-}
+
+class C a where
+  matches :: a -> Bool
+
+pattern P :: C a => a
+pattern P <- (matches -> True)
+
+data D = D Bool
+instance C D where { matches (D b) = b }
+
+data family B a
+data instance B Bool = BBool Bool
+instance C (B Bool) where { matches (BBool b) = b }
+{-# COMPLETE P :: B #-}
+
+f :: Foo -> Int
+f A = 0 -- should not warn
+
+f1 :: D -> ()
+f1 P = () -- should warn, because COMPLETE doesn't apply at D
+
+f2 :: B Bool -> ()
+f2 P = () -- should not warn

testsuite/tests/pmcheck/complete_sigs/T24326.stderr

+
+T24326.hs:29:1: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)]
+    Pattern match(es) are non-exhaustive
+    In an equation for ‘f1’: Patterns of type ‘D’ not matched: _

testsuite/tests/pmcheck/complete_sigs/all.T

+setTestOpts(extra_hc_opts('-Wincomplete-patterns'))
+
 test('completesig01', normal, compile, [''])
 test('completesig02', normal, compile, [''])
-test('Completesig03', normal, multimod_compile, ['Completesig03', '-Wall'])
-test('completesig04', normal, compile, ['-Wincomplete-patterns'])
+test('Completesig03', normal, compile, [''])
+test('completesig04', normal, compile, [''])
 test('completesig05', normal, compile, [''])
 test('completesig06', normal, compile, [''])
 test('completesig07', normal, compile, [''])
@@ -29,3 +31,4 @@ test('T18277', normal, compile, [''])
 test('T18960', normal, compile, [''])
 test('T18960b', normal, compile, [''])
 test('T19475', normal, compile, [''])
+test('T24326', normal, compile, [''])