[commit: ghc] master: Implement `-Wpartial-fields` warning (#7169) (f7f270e)
git at git.haskell.org
git at git.haskell.org
Wed Oct 25 20:44:44 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/f7f270eb6ba616feda79d370336db7e66f9ab79c/ghc
>---------------------------------------------------------------
commit f7f270eb6ba616feda79d370336db7e66f9ab79c
Author: Daishi Nakajima <nakaji.dayo at gmail.com>
Date: Wed Oct 25 15:51:01 2017 -0400
Implement `-Wpartial-fields` warning (#7169)
Warning on declaring a partial record selector.
However, disable warn with field names that start with underscore.
Test Plan: Added 1 test case.
Reviewers: austin, bgamari, simonpj
Reviewed By: bgamari, simonpj
Subscribers: goldfire, simonpj, duog, rwbarton, thomie
GHC Trac Issues: #7169
Differential Revision: https://phabricator.haskell.org/D4083
>---------------------------------------------------------------
f7f270eb6ba616feda79d370336db7e66f9ab79c
compiler/main/DynFlags.hs | 4 ++-
compiler/typecheck/TcTyClsDecls.hs | 42 ++++++++++++++++++++++
docs/users_guide/using-warnings.rst | 19 +++++++++-
testsuite/tests/typecheck/should_compile/T7169.hs | 23 ++++++++++++
.../tests/typecheck/should_compile/T7169.stderr | 2 ++
testsuite/tests/typecheck/should_compile/all.T | 1 +
6 files changed, 89 insertions(+), 2 deletions(-)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 4c62a0d..7602b71 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -674,6 +674,7 @@ data WarningFlag =
| Opt_WarnCPPUndef -- Since 8.2
| Opt_WarnUnbangedStrictPatterns -- Since 8.2
| Opt_WarnMissingHomeModules -- Since 8.2
+ | Opt_WarnPartialFields -- Since 8.4
deriving (Eq, Show, Enum)
data Language = Haskell98 | Haskell2010
@@ -3665,7 +3666,8 @@ wWarningFlagsDeps = [
Opt_WarnMissingPatternSynonymSignatures,
flagSpec "simplifiable-class-constraints" Opt_WarnSimplifiableClassConstraints,
flagSpec "missing-home-modules" Opt_WarnMissingHomeModules,
- flagSpec "unrecognised-warning-flags" Opt_WarnUnrecognisedWarningFlags ]
+ flagSpec "unrecognised-warning-flags" Opt_WarnUnrecognisedWarningFlags,
+ flagSpec "partial-fields" Opt_WarnPartialFields ]
-- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
negatableFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index b4b31e3..cf92638 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -2355,6 +2355,7 @@ checkValidTyCon tc
; let ex_ok = existential_ok || gadt_ok
-- Data cons can have existential context
; mapM_ (checkValidDataCon dflags ex_ok tc) data_cons
+ ; mapM_ (checkPartialRecordField data_cons) (tyConFieldLabels tc)
-- Check that fields with the same name share a type
; mapM_ check_fields groups }}
@@ -2401,6 +2402,29 @@ checkValidTyCon tc
(_, _, _, res2) = dataConSig con2
fty2 = dataConFieldType con2 lbl
+checkPartialRecordField :: [DataCon] -> FieldLabel -> TcM ()
+-- Check the partial record field selector, and warns.
+-- See Note [Checking partial record field]
+checkPartialRecordField all_cons fld
+ = setSrcSpan loc $
+ warnIfFlag Opt_WarnPartialFields
+ (not is_exhaustive && not (startsWithUnderscore occ_name))
+ (sep [text "Use of partial record field selector" <> colon,
+ nest 2 $ quotes (ppr occ_name)])
+ where
+ sel_name = flSelector fld
+ loc = getSrcSpan sel_name
+ occ_name = getOccName sel_name
+
+ (cons_with_field, cons_without_field) = partition has_field all_cons
+ has_field con = fld `elem` (dataConFieldLabels con)
+ is_exhaustive = all (dataConCannotMatch inst_tys) cons_without_field
+
+ con1 = ASSERT( not (null cons_with_field) ) head cons_with_field
+ (univ_tvs, _, eq_spec, _, _, _) = dataConFullSig con1
+ eq_subst = mkTvSubstPrs (map eqSpecPair eq_spec)
+ inst_tys = substTyVars eq_subst univ_tvs
+
checkFieldCompat :: FieldLabelString -> DataCon -> DataCon
-> Type -> Type -> Type -> Type -> TcM ()
checkFieldCompat fld con1 con2 res1 res2 fty1 fty2
@@ -2958,6 +2982,24 @@ tcSplitSigmaTy. tcSplitNestedSigmaTys will always split any foralls that it
sees until it can't go any further, so if you called it on the default type
signature for `each`, it would return (a -> f b) -> s -> f t like we desired.
+Note [Checking partial record field]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+This check checks the partial record field selector, and warns (Trac #7169).
+
+For example:
+
+ data T a = A { m1 :: a, m2 :: a } | B { m1 :: a }
+
+The function 'm2' is partial record field, and will fail when it is applied to
+'B'. The warning identifies such partial fields. The check is performed at the
+declaration of T, not at the call-sites of m2.
+
+The warning can be suppressed by prefixing the field-name with an underscore.
+For example:
+
+ data T a = A { m1 :: a, _m2 :: a } | B { m1 :: a }
+
+
************************************************************************
* *
Checking role validity
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 65ffe99..216d7ee 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -78,6 +78,7 @@ The following flags are simple ways to select standard "packages" of warnings:
* :ghc-flag:`-Wmissing-home-modules`
* :ghc-flag:`-Widentities`
* :ghc-flag:`-Wredundant-constraints`
+ * :ghc-flag:`-Wpartial-fields`
.. ghc-flag:: -Weverything
:shortdesc: enable all warnings supported by GHC
@@ -1464,7 +1465,23 @@ of ``-W(no-)*``.
pick up modules, not listed neither in ``exposed-modules``, nor in
``other-modules``.
+.. ghc-flag:: -Wpartial-fields
+ :shortdesc: warn when define partial record field.
+ :type: dynamic
+ :reverse: -Wno-partial-fields
+ :category:
+
+ :since: 8.4
+
+ The option :ghc-flag:`-Wpartial-fields` warns about record field that could
+ fail when it is used as a function. The function ``f`` below will fail when
+ applied to Bar, so the compiler will emit a warning about this when
+ :ghc-flag:`-Wpartial-fields` is enabled.
+
+ The warning is suppressed if the field name begins with an underscore. ::
+
+ data Foo = Foo { f :: Int } | Bar
+
If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice.
It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's
sanity, not yours.)
-
diff --git a/testsuite/tests/typecheck/should_compile/T7169.hs b/testsuite/tests/typecheck/should_compile/T7169.hs
new file mode 100644
index 0000000..ab1a7580
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T7169.hs
@@ -0,0 +1,23 @@
+{-#OPTIONS_GHC -Wpartial-fields #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE GADTs #-}
+
+
+module T7196 where
+
+data T a = A
+ { m1 :: a
+ , m2 :: a
+ , _m3 :: a
+ } | B
+ {
+ m1 :: a
+ }
+
+pattern P{x} = x
+
+data family F a
+data instance F a where
+ F1 :: { f1 :: Int } -> F Int
+ F2 :: { f2 :: Int } -> F Char
diff --git a/testsuite/tests/typecheck/should_compile/T7169.stderr b/testsuite/tests/typecheck/should_compile/T7169.stderr
new file mode 100644
index 0000000..0cc82e0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T7169.stderr
@@ -0,0 +1,2 @@
+T7169.hs:11:5: warning: [-Wpartial-fields]
+ Use of partial record field selector: ‘m2’
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index a83e41a..e799a45 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -580,3 +580,4 @@ test('T13943', normal, compile, ['-fsolve-constant-dicts'])
test('T14333', normal, compile, [''])
test('T14363', normal, compile, [''])
test('T14363a', normal, compile, [''])
+test('T7169', normal, compile, [''])
More information about the ghc-commits
mailing list