[Git][ghc/ghc][master] Pmc: COMPLETE pragmas associated with Family TyCons should apply to...

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Sun Jan 14 17:48:43 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
ae6d8cd2 by Sebastian Graf at 2024-01-14T12:48:15-05:00
Pmc: COMPLETE pragmas associated with Family TyCons should apply to representation TyCons as well (#24326)

Fixes #24326.

- - - - -


4 changed files:

- compiler/GHC/Types/CompleteMatch.hs
- + testsuite/tests/pmcheck/complete_sigs/T24326.hs
- + testsuite/tests/pmcheck/complete_sigs/T24326.stderr
- testsuite/tests/pmcheck/complete_sigs/all.T


Changes:

=====================================
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
=====================================
@@ -0,0 +1,33 @@
+{-# 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
=====================================
@@ -0,0 +1,4 @@
+
+T24326.hs:30: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
=====================================
@@ -1,7 +1,9 @@
+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, multimod_compile, ['Completesig03', ''])
+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, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae6d8cd2771ffa8022a60a6e1ed7b07d073d33e6

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae6d8cd2771ffa8022a60a6e1ed7b07d073d33e6
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240114/e2adba75/attachment-0001.html>


More information about the ghc-commits mailing list