[Git][ghc/ghc][wip/T24824] 2 commits: Pmc: Improve implementation of -Wincomplete-record-selectors (#24824, #24891)
Sebastian Graf (@sgraf812)
gitlab at gitlab.haskell.org
Wed Sep 25 12:31:52 UTC 2024
Sebastian Graf pushed to branch wip/T24824 at Glasgow Haskell Compiler / GHC
Commits:
2c9a685c by Sebastian Graf at 2024-09-25T14:31:36+02:00
Pmc: Improve implementation of -Wincomplete-record-selectors (#24824, #24891)
We now incorporate the result type of unsaturated record selector applications
as well as consider long-distance information in getField applications.
See the updated Note [Detecting incomplete record selectors].
Fixes #24824 and #24891.
- - - - -
7cf5a9a2 by Sebastian Graf at 2024-09-25T14:31:36+02:00
Pmc: Improve warning messages of -Wincomplete-record-selectors
... as suggested by Adam Gundry in !12685.
- - - - -
21 changed files:
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Types.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Types/CtLocEnv.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Utils/Monad.hs
- testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel1.stderr
- testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel2.stderr
- testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel3.stderr
- + testsuite/tests/pmcheck/should_compile/T24824.hs
- + testsuite/tests/pmcheck/should_compile/T24891.hs
- + testsuite/tests/pmcheck/should_compile/T24891.stderr
- testsuite/tests/pmcheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/TcIncompleteRecSel.stderr
Changes:
=====================================
compiler/GHC/HsToCore/Errors/Ppr.hs
=====================================
@@ -207,10 +207,12 @@ instance Diagnostic DsMessage where
<+> text "for"<+> quotes (ppr lhs_id)
<+> text "might fire first")
]
- DsIncompleteRecordSelector name cons_wo_field not_full_examples -> mkSimpleDecorated $
- text "The application of the record field" <+> quotes (ppr name)
- <+> text "may fail for the following constructors:"
- <+> vcat (map ppr cons_wo_field ++ [text "..." | not_full_examples])
+ DsIncompleteRecordSelector name cons maxCons -> mkSimpleDecorated $
+ hang (text "Selecting the record field" <+> quotes (ppr name)
+ <+> text "may fail for the following constructors:")
+ 2
+ (hsep $ punctuate comma $
+ map ppr (take maxCons cons) ++ [ text "..." | lengthExceeds cons maxCons ])
diagnosticReason = \case
DsUnknownMessage m -> diagnosticReason m
=====================================
compiler/GHC/HsToCore/Errors/Types.hs
=====================================
@@ -163,7 +163,9 @@ data DsMessage
DsIncompleteRecSel2
DsIncompleteRecSel3
-}
- | DsIncompleteRecordSelector !Name ![ConLike] !Bool
+ | DsIncompleteRecordSelector !Name -- ^ The selector
+ ![ConLike] -- ^ The partial constructors
+ !Int -- ^ The max number of constructors reported
deriving Generic
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -1,6 +1,6 @@
-
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# LANGUAGE LambdaCase #-}
@@ -33,6 +33,7 @@ import GHC.HsToCore.Pmc
import GHC.HsToCore.Errors.Types
import GHC.Types.SourceText
import GHC.Types.Name hiding (varName)
+import GHC.Types.Name.Reader
import GHC.Core.FamInstEnv( topNormaliseType )
import GHC.HsToCore.Quote
import GHC.HsToCore.Ticks (stripTicksTopHsExpr)
@@ -43,6 +44,7 @@ import GHC.Hs
import GHC.Tc.Utils.TcType
import GHC.Tc.Types.Evidence
import GHC.Tc.Utils.Monad
+import GHC.Tc.Instance.Class (lookupHasFieldLabel)
import GHC.Core.Type
import GHC.Core.TyCo.Rep
import GHC.Core
@@ -67,7 +69,6 @@ import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
import GHC.Core.PatSyn
import Control.Monad
-import GHC.Types.Error
{-
************************************************************************
@@ -261,35 +262,18 @@ dsLExpr (L loc e) = putSrcSpanDsA loc $ dsExpr e
dsExpr :: HsExpr GhcTc -> DsM CoreExpr
dsExpr (HsVar _ (L _ id)) = dsHsVar id
-{- Record selectors are warned about if they are not
-present in all of the parent data type's constructor,
-or always in case of pattern synonym record selectors
-(regulated by a flag). However, this only produces
-a warning if it's not a part of a record selector
-application. For example:
-
- data T = T1 | T2 {s :: Bool}
- f x = s x -- the warning from this case will be supressed
-
-See the `HsApp` case for where it is filtered out
--}
+-- See of Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
dsExpr (HsRecSel _ (FieldOcc id _))
= do { let name = getName id
RecSelId {sel_cons = (_, cons_wo_field)}
= idDetails id
- ; cons_trimmed <- trim_cons cons_wo_field
- ; unless (null cons_wo_field) $ diagnosticDs
- $ DsIncompleteRecordSelector name cons_trimmed (cons_trimmed /= cons_wo_field)
- -- This only produces a warning if it's not a part of a
- -- record selector application (e.g. `s a` where `s` is a selector)
- -- See the `HsApp` case for where it is filtered out
+ ; suppress_here <- getSuppressIncompleteRecSelsDs
+ -- See (4) and (5) of Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
+ ; unless (suppress_here || null cons_wo_field) $ do
+ dflags <- getDynFlags
+ let maxCons = maxUncoveredPatterns dflags
+ diagnosticDs $ DsIncompleteRecordSelector name cons_wo_field maxCons
; dsHsVar id }
- where
- trim_cons :: [ConLike] -> DsM [ConLike]
- trim_cons cons_wo_field = do
- dflags <- getDynFlags
- let maxConstructors = maxUncoveredPatterns dflags
- return $ take maxConstructors cons_wo_field
dsExpr (HsUnboundVar (HER ref _ _) _) = dsEvTerm =<< readMutVar ref
@@ -358,28 +342,17 @@ dsExpr (HsLam _ variant a_Match)
= uncurry mkCoreLams <$> matchWrapper (LamAlt variant) Nothing a_Match
dsExpr e@(HsApp _ fun arg)
- -- We want to have a special case that uses the PMC information to filter
- -- out some of the incomplete record selectors warnings and not trigger
- -- the warning emitted during the desugaring of dsExpr(HsRecSel)
- -- See Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
- = do { (msgs, fun') <- captureMessagesDs $ dsLExpr fun
- -- Make sure to filter out the generic incomplete record selector warning
- -- if it's a raw record selector
+ = do { fun' <- suppressIncompleteRecSelsDs $ dsLExpr fun
+ -- See (5) of Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
; arg' <- dsLExpr arg
- ; case getIdFromTrivialExpr_maybe fun' of
- Just fun_id | isRecordSelector fun_id
- -> do { let msgs' = filterMessages is_incomplete_rec_sel_msg msgs
- ; addMessagesDs msgs'
- ; pmcRecSel fun_id arg' }
- _ -> addMessagesDs msgs
+ ; mb_rec_sel <- decomposeRecSelHead fun'
+ ; case mb_rec_sel of
+ -- See (2) of Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
+ Just sel_id
+ -> pmcRecSel sel_id arg'
+ _ -> return ()
; warnUnusedBindValue fun arg (exprType arg')
; return $ mkCoreAppDs (text "HsApp" <+> ppr e) fun' arg' }
- where
- is_incomplete_rec_sel_msg :: MsgEnvelope DsMessage -> Bool
- is_incomplete_rec_sel_msg (MsgEnvelope {errMsgDiagnostic = DsIncompleteRecordSelector{}})
- = False
- is_incomplete_rec_sel_msg _ = True
-
dsExpr e@(HsAppType {}) = dsHsWrapped e
@@ -1015,7 +988,19 @@ warnDiscardedDoBindings rhs rhs_ty
------------------------------
dsHsWrapped :: HsExpr GhcTc -> DsM CoreExpr
dsHsWrapped orig_hs_expr
- = go idHsWrapper orig_hs_expr
+ = do { res <- suppressIncompleteRecSelsDs $ go idHsWrapper orig_hs_expr
+ ; suppress_here <- getSuppressIncompleteRecSelsDs
+ -- See (5) of Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
+ ; if | not suppress_here
+ , Just fun_id <- getIdFromTrivialExpr_maybe res
+ , isRecordSelector fun_id
+ , Just (FTF_T_T, _, arg_ty,_res_ty) <- splitFunTy_maybe (exprType res)
+ -> do { dummy <- newSysLocalDs (Scaled ManyTy arg_ty)
+ -- See (3) of Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
+ ; pmcRecSel fun_id (Var dummy) }
+ | otherwise
+ -> return ()
+ ; return res }
where
go wrap (HsPar _ (L _ hs_e))
= go wrap hs_e
@@ -1037,3 +1022,48 @@ dsHsWrapped orig_hs_expr
{ addTyCs FromSource (hsWrapDictBinders wrap) $
do { e <- dsExpr hs_e
; return (wrap' e) } } }
+
+decomposeRecSelHead :: CoreExpr -> DsM (Maybe Id)
+-- ^ Detect whether the given CoreExpr is
+-- * a record selector, or
+-- * a resolved getField application listing the record selector
+-- See (6) of Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc.
+decomposeRecSelHead fun
+ -- First plain record selectors; `sel |> co`. Easy:
+ | Just sel_id <- getIdFromTrivialExpr_maybe fun
+ , isRecordSelector sel_id
+ = pure (Just sel_id)
+
+ -- Now resolved getField applications. General form:
+ -- getField
+ -- @GHC.Types.Symbol {k}
+ -- @"sel" x
+ -- @T r
+ -- @Int a
+ -- ($dHasField :: HasField "sel" T Int)
+ -- :: T -> Int
+ -- where
+ -- $dHasField = sel |> (co :: T -> Int ~R# HasField "sel" T Int)
+ -- Alas, we cannot simply look at the unfolding of $dHasField below because it
+ -- has not been set yet, so we have to reconstruct the selector from the types.
+ | App fun2 dict <- fun
+ -- cheap test first
+ , Just _dict_id <- getIdFromTrivialExpr_maybe dict
+ -- looks good so far. Now match deeper
+ , get_field `App` _k `App` Type x_ty `App` Type r_ty `App` _a_ty <- fun2
+ , Just get_field_id <- getIdFromTrivialExpr_maybe get_field
+ , get_field_id `hasKey` getFieldClassOpKey
+ -- Checks out! Now get a hold of the record selector.
+ = do fam_inst_envs <- dsGetFamInstEnvs
+ rdr_env <- dsGetGlobalRdrEnv
+ -- Look up the field named x/"sel" in the type r/T
+ case lookupHasFieldLabel fam_inst_envs x_ty r_ty of
+ Just fl
+ | Just _ <- lookupGRE_FieldLabel rdr_env fl
+ -- Make sure the field is actually visible in this module;
+ -- otherwise this might not be the implicit HasField instance
+ -> Just <$> dsLookupGlobalId (flSelector fl)
+ _ -> pure Nothing
+
+ | otherwise
+ = pure Nothing
=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -26,7 +26,7 @@ module GHC.HsToCore.Monad (
mkNamePprCtxDs,
newUnique,
UniqSupply, newUniqueSupply,
- getGhcModeDs, dsGetFamInstEnvs,
+ getGhcModeDs, dsGetFamInstEnvs, dsGetGlobalRdrEnv,
dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon,
dsLookupDataCon, dsLookupConLike,
getCCIndexDsM,
@@ -36,6 +36,9 @@ module GHC.HsToCore.Monad (
-- Getting and setting pattern match oracle states
getPmNablas, updPmNablas,
+ -- Locally suppress -Wincomplete-record-selectors warnings
+ getSuppressIncompleteRecSelsDs, suppressIncompleteRecSelsDs,
+
-- Tracking evidence variable coherence
addUnspecables, getUnspecables,
@@ -45,7 +48,6 @@ module GHC.HsToCore.Monad (
-- Warnings and errors
DsWarning, diagnosticDs, errDsCoreExpr,
failWithDs, failDs, discardWarningsDs,
- addMessagesDs, captureMessagesDs,
-- Data types
DsMatchContext(..),
@@ -407,6 +409,7 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var
, dsl_loc = real_span
, dsl_nablas = initNablas
, dsl_unspecables = mempty
+ , dsl_suppress_incomplete_rec_sel = False
}
in (gbl_env, lcl_env)
@@ -475,6 +478,13 @@ addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecabl
getUnspecables :: DsM (S.Set EvId)
getUnspecables = dsl_unspecables <$> getLclEnv
+suppressIncompleteRecSelsDs :: DsM a -> DsM a
+suppressIncompleteRecSelsDs = updLclEnv (\dsl -> dsl { dsl_suppress_incomplete_rec_sel = True })
+
+-- | Get the current pattern match oracle state. See 'dsl_nablas'.
+getSuppressIncompleteRecSelsDs :: DsM Bool
+getSuppressIncompleteRecSelsDs = do { env <- getLclEnv; return (dsl_suppress_incomplete_rec_sel env) }
+
getSrcSpanDs :: DsM SrcSpan
getSrcSpanDs = do { env <- getLclEnv
; return (RealSrcSpan (dsl_loc env) Strict.Nothing) }
@@ -499,12 +509,6 @@ diagnosticDs dsMessage
; let msg = mkMsgEnvelope diag_opts loc (ds_name_ppr_ctx env) dsMessage
; updMutVar (ds_msgs env) (\ msgs -> msg `addMessage` msgs) }
-addMessagesDs :: Messages DsMessage -> DsM ()
-addMessagesDs msgs1
- = do { msg_var <- ds_msgs <$> getGblEnv
- ; msgs0 <- liftIO $ readIORef msg_var
- ; liftIO $ writeIORef msg_var (msgs0 `unionMessages` msgs1) }
-
-- | Issue an error, but return the expression for (), so that we can continue
-- reporting errors.
errDsCoreExpr :: DsMessage -> DsM CoreExpr
@@ -520,13 +524,6 @@ failWithDs msg
failDs :: DsM a
failDs = failM
-captureMessagesDs :: DsM a -> DsM (Messages DsMessage, a)
-captureMessagesDs thing_inside
- = do { msg_var <- liftIO $ newIORef emptyMessages
- ; res <- updGblEnv (\gbl -> gbl {ds_msgs = msg_var}) thing_inside
- ; msgs <- liftIO $ readIORef msg_var
- ; return (msgs, res) }
-
mkNamePprCtxDs :: DsM NamePprCtx
mkNamePprCtxDs = ds_name_ppr_ctx <$> getGblEnv
@@ -567,6 +564,9 @@ dsGetFamInstEnvs
dsGetMetaEnv :: DsM (NameEnv DsMetaVal)
dsGetMetaEnv = do { env <- getLclEnv; return (dsl_meta env) }
+dsGetGlobalRdrEnv :: DsM GlobalRdrEnv
+dsGetGlobalRdrEnv = ds_gbl_rdr_env <$> getGblEnv
+
-- | The @COMPLETE@ pragmas that are in scope.
dsGetCompleteMatches :: DsM DsCompleteMatches
dsGetCompleteMatches = ds_complete_matches <$> getGblEnv
=====================================
compiler/GHC/HsToCore/Pmc.hs
=====================================
@@ -201,55 +201,180 @@ pmcMatches origin ctxt vars matches = {-# SCC "pmcMatches" #-} do
{-
Note [Detecting incomplete record selectors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-A record selector occurrence is incomplete iff. it could fail due to
-being applied to a data type constructor not present for this record field.
-
-e.g.
- data T = T1 | T2 {x :: Int}
- d = x someComputation -- `d` may fail
-
-There are 4 parts to detecting and warning about
-incomplete record selectors to consider:
-
- - Computing which constructors a general application of a record field will succeed on,
- and which ones it will fail on. This is stored in the `sel_cons` field of
- `IdDetails` datatype, which is a part of an `Id` and calculated when renaming a
- record selector in `mkOneRecordSelector`
-
- - Emitting a warning whenever a `HasField` constraint is solved.
- This is checked in `matchHasField` and emitted only for when
- the constraint is resolved with an implicit instance rather than a
- custom one (since otherwise the warning will be emitted in
- the custom implementation anyways)
-
- e.g.
- g :: HasField "x" t Int => t -> Int
- g = getField @"x"
-
- f :: T -> Int
- f = g -- warning will be emitted here
-
- - Emitting a warning for a general occurrence of the record selector
- This is done during the renaming of a `HsRecSel` expression in `dsExpr`
- and simply pulls the information about incompleteness from the `Id`
-
- e.g.
- l :: T -> Int
- l a = x a -- warning will be emitted here
-
- - Emitting a warning for a record selector `sel` applied to a variable `y`.
- In that case we want to use the long-distance information from the
- pattern match checker to rule out impossible constructors
- (See Note [Long-distance information]). We first add constraints to
- the long-distance `Nablas` that `y` cannot be one of the constructors that
- contain `sel` (function `checkRecSel` in GHC.HsToCore.Pmc.Check). If the
- `Nablas` are still inhabited, we emit a warning with the inhabiting constructors
- as examples of where `sel` may fail.
-
- e.g.
- z :: T -> Int
- z T1 = 0
- z a = x a -- warning will not be emitted here since `a` can only be `T2`
+This Note describes the implementation of
+GHC proposal 516 "Add warning for incomplete record selectors".
+
+A **partial field** is a field that does not belong to every constructor of the
+corresponding datatype.
+A **partial selector occurrence** is a use of a record selector for a partial
+field, either as a selector function in an expression, or as the solution to a
+HasField constraint.
+
+Partial selector occurrences desugar to case expressions which may crash at
+runtime:
+
+ data T a where
+ T1 :: T Int
+ T2 {sel :: Int} :: T Bool
+
+ urgh :: T a -> Int
+ urgh x = sel x
+ ===>
+ urgh x = case x of
+ T1 -> error "no record field sel"
+ T2 f -> f
+
+As such, it makes sense to warn about such potential crashes.
+We do so whenever -Wincomplete-record-selectors is present, and we utilise
+the pattern-match coverage checker for precise results, because there are many
+uses of selectors for partial fields which are in fact dynamically safe.
+
+Pmc can detect two very common safe uses for which we will not warn:
+
+ (LDI) Ambient pattern-matches unleash Note [Long-distance information] that
+ render a naively flagged partial selector occurrence safe, as in
+ ldi :: T a -> Int
+ ldi T1 = 0
+ ldi arg = sel arg
+ We should not warn here, because `arg` cannot be `T1`.
+
+ (RES) Constraining the result type of a GADT such as T might render
+ naively flagged partial selector occurrences safe, as in
+ resTy :: T Bool -> Int
+ resTy = sel
+ Here, `T1 :: T Int` is ruled out because it has the wrong result type.
+
+Additionally, we want to support incomplete -XOverloadedRecordDot access as
+well, in either the (LDI) use case or the (RES) use case:
+
+ data Dot = No | Yes { sel2 :: Int }
+ dot d = d.sel2 -- should warn
+ ldiDot No = 0
+ ldiDot d = d.sel2 -- should not warn
+ resTyDot :: T Bool -> Int
+ resTyDot x = x.sel -- should not warn
+
+From a user's point of view, function `ldiDot` looks very like example `ldi` and
+`resTyDot` looks very like `resTy`. But from an /implementation/ point of view
+they are very different: both `ldiDot` and `resTyDot` simply emit `HasField`
+constraints, and it is those constraints that the implementation must use to
+determine incompleteness.
+
+Furthermore, HasField constraints allow to delay the completeness check from
+the field access site to a caller, as in test cases TcIncompleteRecSel and T24891:
+
+ accessDot :: HasField "sel2" t Int => t -> Int
+ accessDot x = x.sel2
+ solveDot :: Dot -> Int
+ solveDot = accessDot
+
+We should warn in `solveDot`, but not in `accessDot`.
+
+Here is how we achieve all this in the implementation:
+
+ 1. When renaming a record selector in `mkOneRecordSelector`,
+ we precompute the constructors the selector succeeds on.
+ That would be `T2` for `sel` because `sel (T2 42)` succeeds,
+ and `Yes` for `sel2` because `sel2 (Yes 13)` succeeds.
+ We store this information in the `sel_cons` field of `RecSelId`.
+ (Remember, the same field may occur in several constructors of the data
+ type; hence the selector may succeed on more than one constructor.)
+
+The next three items describe mechanisms for producing warnings on record
+selectors and situations in which they trigger.
+They are ordered by specificity, so we prefer (2) over (3) over (4).
+Item (5) below describes how we resolve the overlap.
+(-XOverloadedRecordDot is discussed separately in Item (6) and (7).)
+
+ 2. In function `ldi`, we have a record selector application `sel arg`.
+ This situation is detected in the `HsApp` case of `dsExpr`.
+ We call out to the pattern-match checker to determine whether use of the
+ selector is safe, by calling GHC.HsToCore.Pmc.pmcRecSel, passing the
+ `RecSelId` `sel` as well as `arg`.
+
+ The pattern-match checker reduces the partial-selector-occurrence problem to
+ a complete-match problem by adding a negative constructor constraint such as
+ `arg /~ T2` for every constructor in the precomputed `sel_cons` of `sel`.
+ Recall that these were exactly the constructors which define a field `sel`.
+ `pmcRecSel` then tests
+
+ case arg of {}
+
+ for completeness. Any incomplete match, such as in the original `urgh`, must
+ reference a constructor that does not have field `sel`, such as `T1`.
+ In case of `urgh`, `T1` is indeed the case that we report as inexhaustive.
+
+ However, in function `ldi`, we have *both* the result type of
+ `arg::T a` (boring, but see (3)) as well as Note [Long-distance information]
+ about `arg` from the ambient match, and the latter lists the constraint
+ `arg /~ T1`. Consequently, since `arg` is neither `T1` nor `T2` in the
+ reduced problem, the match is exhaustive and the use of the record selector
+ safe.
+
+ 3. In function `resTy`, the record selector is unsaturated, but the result type
+ ensures a safe use of the selector.
+ This situation is detected in `dsHsWrapped`, where the record selector
+ is elaborated with its type arguments; we simply match on desugared Core
+ `sel @Bool :: T Bool -> Int` to learn the result type `T Bool`.
+ We again call `pmcRecSel`, but this time with a fresh dummy Id `ds::T Bool`.
+
+ 4. In case of an unsaturated record selector that is *not* applied to any type
+ argument after elaboration (e.g. in `urgh2 = sel2 :: Dot -> Int`), we simply
+ produce a warning about all `sel_cons`; no need to call `pmcRecSel`.
+ This happens in the `HsRecSel` case of `dsExpr`.
+
+We resolve the overlap between situations (2)-(4) by preferring (2) over (3)
+over (4) as follows:
+
+ 5. (4) produces warnings in the `HsRecSel` case of `dsExpr`.
+ (3) produces warnings in a potentially surrounding call to `dsHsWrapped`.
+ (2) produces warnings in a potentially surrounding `HsApp` case in `dsExpr`.
+ Since (2) surrounds (3) surrounds (4), this is simply implemented via the
+ flag `dsl_suppress_incomplete_rec_sel` of the `DsLclEnv`, which is set
+ in (2) and (3) before desugaring subexpressions.
+
+Finally, there are 2 more items addressing -XOverloadedRecordDot:
+
+ 6. -XOverloadedRecordDot such as in function `ldiDot` desugars as follows:
+ getField
+ @GHC.Types.Symbol
+ @"sel2"
+ @Dot
+ @Int
+ ($dHasField :: HasField "sel2" Dot Int)
+ d
+ where
+ $dHasField = sel2 |> (co :: Dot -> Int ~R# HasField "sel2" Dot Int)
+ We want to catch these applications in the saturated (2) case.
+ (The unsaturated case is handled implicitly by (7).)
+ For example, we do not want to generate a warning for function `ldiDot`!
+ For that, we need to be smart in `decomposeRecSelHead`, which matches out
+ the record selector. It must treat the above expression similar to a vanilla
+ RecSel app `sel2 d`.
+ This is a bit nasty since we cannot look at the unfolding of `$dHasField`.
+ Tested in T24891.
+
+ 7. For `accessDot` above, `decomposeRecSelHead` will fail to find a record
+ selector, because type `t` is not obviously a record type.
+ That's good, because it means we won't emit a warning for `accessDot`.
+ But we should really emit a warning for `solveDot`!
+ There, the compiler solves a `HasField` constraint and without an immediate
+ `getField`, roughly `solveDot = accessDot @Dot $d`.
+ It is the job of the solver to warn about incompleteness here,
+ in `GHC.Tc.Instance.Class.matchHasField`.
+
+ What makes this complicated is that we do not *also* want to warn in the
+ example `dot d = d.sel2` above, which is covered by more precise case (6)!
+ We suppress the warning in this case as follows:
+ 1. The type-checker (`GHC.Tc.Gen.tcApp`) produces `getField @.. $d e`
+ (Remember that (6) will detect `getField @.. $d e` as well.)
+ 2. Through `tcl_suppress_incomplete_rec_sel`, we suppress warnings when
+ solving `$d`.
+ 3. ... but not when checking `e`, because `e` might itself be a field
+ access that would need to be checked individually.
+ 4. What complicates matters is that the solver runs *after* type-checking,
+ so we must persist `tcl_suppress_incomplete_rec_sel` in the `CtLocEnv`.
+ What a hassle. This is all tested in T24891.
-}
pmcRecSel :: Id -- ^ Id of the selector
@@ -270,13 +395,11 @@ pmcRecSel sel_id arg
sel_name = varName sel_id
warn_incomplete arg_id uncov_nablas = do
dflags <- getDynFlags
- let maxConstructors = maxUncoveredPatterns dflags
- unc_examples <- getNFirstUncovered MinimalCover [arg_id] (maxConstructors + 1) uncov_nablas
+ let maxPatterns = maxUncoveredPatterns dflags
+ unc_examples <- getNFirstUncovered MinimalCover [arg_id] (maxPatterns + 1) uncov_nablas
let cons = [con | unc_example <- unc_examples
, Just (PACA (PmAltConLike con) _ _) <- [lookupSolution unc_example arg_id]]
- not_full_examples = length cons == (maxConstructors + 1)
- cons' = take maxConstructors cons
- diagnosticDs $ DsIncompleteRecordSelector sel_name cons' not_full_examples
+ diagnosticDs $ DsIncompleteRecordSelector sel_name cons maxPatterns
pmcRecSel _ _ = return ()
=====================================
compiler/GHC/HsToCore/Types.hs
=====================================
@@ -11,7 +11,7 @@ module GHC.HsToCore.Types (
DsMetaEnv, DsMetaVal(..), CompleteMatches
) where
-import GHC.Prelude (Int)
+import GHC.Prelude (Int, Bool)
import Data.IORef
import qualified Data.Set as S
@@ -80,6 +80,9 @@ data DsLclEnv
-- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc".
-- The set of reaching values Nablas is augmented as we walk inwards, refined
-- through each pattern match in turn
+ , dsl_suppress_incomplete_rec_sel :: Bool
+ -- ^ Whether to suppress -Wincomplete-record-selectors warnings.
+ -- See (5) of Note [Detecting incomplete record selectors]
, dsl_unspecables :: S.Set EvVar
-- ^ See Note [Desugaring non-canonical evidence]: this field collects
-- all un-specialisable evidence variables in scope.
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -1536,9 +1536,12 @@ instance Diagnostic TcRnMessage where
vcat [ sep [ text "Definition of partial record field" <> colon
, nest 2 $ quotes (ppr (occName fld)) ]
, text "Record selection and update using this field will be partial." ]
- TcRnHasFieldResolvedIncomplete name -> mkSimpleDecorated $
- text "The invocation of `getField` on the record field" <+> quotes (ppr name)
- <+> text "may produce an error since it is not defined for all data constructors"
+ TcRnHasFieldResolvedIncomplete name cons maxCons -> mkSimpleDecorated $
+ hang (text "Selecting the record field" <+> quotes (ppr name)
+ <+> text "may fail for the following constructors:")
+ 2
+ (hsep $ punctuate comma $
+ map ppr (take maxCons cons) ++ [ text "..." | lengthExceeds cons maxCons ])
TcRnBadFieldAnnotation n con reason -> mkSimpleDecorated $
hang (pprBadFieldAnnotationReason reason)
2 (text "on the" <+> speakNth n
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -3573,7 +3573,10 @@ data TcRnMessage where
Test cases:
TcIncompleteRecSel
-}
- TcRnHasFieldResolvedIncomplete :: !Name -> TcRnMessage
+ TcRnHasFieldResolvedIncomplete :: !Name -- ^ The selector
+ -> ![ConLike] -- ^ The partial constructors
+ -> !Int -- ^ The max number of constructors reported
+ -> TcRnMessage
{-| TcRnBadFieldAnnotation is an error/warning group indicating that a
strictness/unpack related data type field annotation is invalid.
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -403,10 +403,18 @@ tcApp rn_expr exp_res_ty
; (tc_fun, fun_sigma) <- tcInferAppHead fun
; let tc_head = (tc_fun, fun_ctxt)
+ ; let supp_incomplete_rec_sel
+ | XExpr (ExpandedThingRn (OrigExpr HsGetField{}) _) <- rn_expr
+ -- See (7) of Note [Detecting incomplete record selectors]
+ = setSuppressIncompleteRecSelsTc True
+ | otherwise
+ = id
+
-- Step 3: Instantiate the function type (taking a quick look at args)
; do_ql <- wantQuickLook rn_fun
; (inst_args, app_res_rho)
- <- setQLInstLevel do_ql $ -- See (TCAPP1) and (TCAPP2) in
+ <- supp_incomplete_rec_sel $
+ setQLInstLevel do_ql $ -- See (TCAPP1) and (TCAPP2) in
-- Note [tcApp: typechecking applications]
tcInstFun do_ql True tc_head fun_sigma rn_args
@@ -764,7 +772,9 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args
; go (pos+1) (addArgWrap wrap acc) inst_body rest_args }
go1 pos acc fun_ty (EWrap w : args)
- = go1 pos (EWrap w : acc) fun_ty args
+ = setSuppressIncompleteRecSelsTc False $
+ -- See (7) of Note [Detecting incomplete record selectors]
+ go1 pos (EWrap w : acc) fun_ty args
go1 pos acc fun_ty (EPrag sp prag : args)
= go1 pos (EPrag sp prag : acc) fun_ty args
@@ -2269,4 +2279,3 @@ rejectRepPolyNewtypes (fun,_) app_res_rho = case fun of
tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc
tcExprPrag (HsPragSCC x1 ann) = HsPragSCC x1 ann
-
=====================================
compiler/GHC/Tc/Instance/Class.hs
=====================================
@@ -5,7 +5,8 @@ module GHC.Tc.Instance.Class (
matchGlobalInst, matchEqualityInst,
ClsInstResult(..),
InstanceWhat(..), safeOverlap, instanceReturnsDictCon,
- AssocInstInfo(..), isNotAssociated
+ AssocInstInfo(..), isNotAssociated,
+ lookupHasFieldLabel
) where
import GHC.Prelude
@@ -22,7 +23,7 @@ import GHC.Tc.Instance.Typeable
import GHC.Tc.Utils.TcMType
import GHC.Tc.Types.Evidence
import GHC.Tc.Types.Origin (InstanceWhat (..), SafeOverlapping)
-import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst )
+import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst, FamInstEnvs )
import GHC.Rename.Env( addUsedGRE, addUsedDataCons, DeprecationWarnings (..) )
import GHC.Builtin.Types
@@ -1252,15 +1253,9 @@ matchHasField dflags short_cut clas tys
; case tys of
-- We are matching HasField {k} {r_rep} {a_rep} x r a...
[_k_ty, _r_rep, _a_rep, x_ty, r_ty, a_ty]
- -- x should be a literal string
- | Just x <- isStrLitTy x_ty
- -- r should be an applied type constructor
- , Just (tc, args) <- tcSplitTyConApp_maybe r_ty
- -- use representation tycon (if data family); it has the fields
- , let r_tc = fstOf3 (tcLookupDataFamInst fam_inst_envs tc args)
- -- x should be a field of r
- , Just fl <- lookupTyConFieldLabel (FieldLabelString x) r_tc
- -- the field selector should be in scope
+ -- Look up the field named x in the type r
+ | Just fl <- lookupHasFieldLabel fam_inst_envs x_ty r_ty
+ -- and ensure the field selector is in scope
, Just gre <- lookupGRE_FieldLabel rdr_env fl
-> do { let name = flSelector fl
@@ -1295,10 +1290,12 @@ matchHasField dflags short_cut clas tys
then do { -- See Note [Unused name reporting and HasField]
addUsedGRE AllDeprecationWarnings gre
; keepAlive name
- ; unless (null $ snd $ sel_cons $ idDetails sel_id)
- $ addDiagnostic $ TcRnHasFieldResolvedIncomplete name
- -- Only emit an incomplete selector warning if it's an implicit instance
- -- See Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
+ ; let maxCons = maxUncoveredPatterns dflags
+ ; let (_, fallible_cons) = sel_cons (idDetails sel_id)
+ ; suppress <- getSuppressIncompleteRecSelsTc
+ -- See (7) of Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
+ ; unless (null fallible_cons || suppress) $ do
+ addDiagnostic $ TcRnHasFieldResolvedIncomplete name fallible_cons maxCons
; return OneInst { cir_new_theta = theta
, cir_mk_ev = mk_ev
, cir_canonical = EvCanonical
@@ -1306,3 +1303,21 @@ matchHasField dflags short_cut clas tys
else matchInstEnv dflags short_cut clas tys }
_ -> matchInstEnv dflags short_cut clas tys }
+
+lookupHasFieldLabel :: FamInstEnvs -> Type -> Type -> Maybe FieldLabel
+-- The call (lookupHasFieldLabel fam_envs (LitTy "fld") (T t1..tn))
+-- returns the `FieldLabel` of field "fld" in the data type T.
+-- A complication is that `T` might be a data family, so we need to
+-- look it up in the `fam_envs` to find its representation tycon.
+lookupHasFieldLabel fam_inst_envs x_ty r_ty
+ -- x should be a literal string
+ | Just x <- isStrLitTy x_ty
+ -- r should be an applied type constructor
+ , Just (tc, args) <- tcSplitTyConApp_maybe r_ty
+ -- use representation tycon (if data family); it has the fields
+ , let r_tc = fstOf3 (tcLookupDataFamInst fam_inst_envs tc args)
+ -- x should be a field of r
+ = lookupTyConFieldLabel (FieldLabelString x) r_tc
+
+ | otherwise
+ = Nothing
=====================================
compiler/GHC/Tc/Types/CtLocEnv.hs
=====================================
@@ -29,7 +29,8 @@ data CtLocEnv = CtLocEnv { ctl_ctxt :: ![ErrCtxt]
, ctl_bndrs :: !TcBinderStack
, ctl_tclvl :: !TcLevel
, ctl_in_gen_code :: !Bool
- , ctl_rdr :: !LocalRdrEnv }
+ , ctl_rdr :: !LocalRdrEnv
+ , ctl_suppress_incomplete_rec_sels :: !Bool }
getCtLocEnvLoc :: CtLocEnv -> RealSrcSpan
@@ -57,4 +58,4 @@ setCtLocEnvLoc env loc@(UnhelpfulSpan _)
= env
ctLocEnvInGeneratedCode :: CtLocEnv -> Bool
-ctLocEnvInGeneratedCode = ctl_in_gen_code
\ No newline at end of file
+ctLocEnvInGeneratedCode = ctl_in_gen_code
=====================================
compiler/GHC/Tc/Types/LclEnv.hs
=====================================
@@ -12,6 +12,7 @@ module GHC.Tc.Types.LclEnv (
, getLclEnvRdrEnv
, getLclEnvTcLevel
, getLclEnvThStage
+ , getLclEnvSuppressIncompleteRecSels
, setLclEnvTcLevel
, setLclEnvLoc
, setLclEnvRdrEnv
@@ -19,6 +20,7 @@ module GHC.Tc.Types.LclEnv (
, setLclEnvErrCtxt
, setLclEnvThStage
, setLclEnvTypeEnv
+ , setLclEnvSuppressIncompleteRecSels
, modifyLclEnvTcLevel
, lclEnvInGeneratedCode
@@ -117,9 +119,11 @@ data TcLclCtxt
tcl_arrow_ctxt :: ArrowCtxt, -- Arrow-notation context
- tcl_env :: TcTypeEnv -- The local type environment:
+ tcl_env :: TcTypeEnv, -- The local type environment:
-- Ids and TyVars defined in this module
+ tcl_suppress_incomplete_rec_sel :: Bool -- True <=> Suppress warnings about incomplete record selectors
+ -- See (7) of Note [Detecting incomplete record selectors]
}
getLclEnvThStage :: TcLclEnv -> ThStage
@@ -179,6 +183,12 @@ getLclEnvRdrEnv = tcl_rdr . tcl_lcl_ctxt
setLclEnvRdrEnv :: LocalRdrEnv -> TcLclEnv -> TcLclEnv
setLclEnvRdrEnv rdr_env = modifyLclCtxt (\env -> env { tcl_rdr = rdr_env })
+getLclEnvSuppressIncompleteRecSels :: TcLclEnv -> Bool
+getLclEnvSuppressIncompleteRecSels = tcl_suppress_incomplete_rec_sel . tcl_lcl_ctxt
+
+setLclEnvSuppressIncompleteRecSels :: Bool -> TcLclEnv -> TcLclEnv
+setLclEnvSuppressIncompleteRecSels suppress = modifyLclCtxt (\env -> env { tcl_suppress_incomplete_rec_sel = suppress })
+
modifyLclCtxt :: (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
modifyLclCtxt upd env =
let !res = upd (tcl_lcl_ctxt env)
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -94,6 +94,7 @@ module GHC.Tc.Utils.Monad(
mkTcRnMessage, reportDiagnostic, reportDiagnostics,
warnIf, diagnosticTc, diagnosticTcM,
addDiagnosticTc, addDiagnosticTcM, addDiagnostic, addDiagnosticAt,
+ getSuppressIncompleteRecSelsTc, setSuppressIncompleteRecSelsTc,
-- * Type constraints
newTcEvBinds, newNoTcEvBinds, cloneEvBindsVar,
@@ -398,7 +399,8 @@ initTcWithGbl hsc_env gbl_env loc do_this
tcl_arrow_ctxt = NoArrowCtxt,
tcl_env = emptyNameEnv,
tcl_bndrs = [],
- tcl_tclvl = topTcLevel
+ tcl_tclvl = topTcLevel,
+ tcl_suppress_incomplete_rec_sel = False
},
tcl_usage = usage_var,
tcl_lie = lie_var,
@@ -1273,6 +1275,7 @@ mkCtLocEnv lcl_env =
, ctl_tclvl = getLclEnvTcLevel lcl_env
, ctl_in_gen_code = lclEnvInGeneratedCode lcl_env
, ctl_rdr = getLclEnvRdrEnv lcl_env
+ , ctl_suppress_incomplete_rec_sels = getLclEnvSuppressIncompleteRecSels lcl_env
}
setCtLocM :: CtLoc -> TcM a -> TcM a
@@ -1281,6 +1284,7 @@ setCtLocM (CtLoc { ctl_env = lcl }) thing_inside
= updLclEnv (\env -> setLclEnvLoc (ctl_loc lcl)
$ setLclEnvErrCtxt (ctl_ctxt lcl)
$ setLclEnvBinderStack (ctl_bndrs lcl)
+ $ setLclEnvSuppressIncompleteRecSels (ctl_suppress_incomplete_rec_sels lcl)
$ env) thing_inside
{- *********************************************************************
@@ -1662,6 +1666,12 @@ add_diagnostic msg
; mkTcRnMessage loc (TcRnMessageWithInfo unit_state msg) >>= reportDiagnostic
}
+getSuppressIncompleteRecSelsTc :: TcRn Bool
+getSuppressIncompleteRecSelsTc = getLclEnvSuppressIncompleteRecSels <$> getLclEnv
+
+setSuppressIncompleteRecSelsTc :: Bool -> TcRn a -> TcRn a
+setSuppressIncompleteRecSelsTc b = updLclEnv (setLclEnvSuppressIncompleteRecSels b)
+
{-
-----------------------------------
=====================================
testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel1.stderr
=====================================
@@ -1,3 +1,4 @@
-
DsIncompleteRecSel1.hs:8:5: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘x’ may fail for the following constructors: T2
+ Selecting the record field ‘x’ may fail for the following constructors:
+ T2
+
=====================================
testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel2.stderr
=====================================
@@ -1,6 +1,8 @@
-
DsIncompleteRecSel2.hs:22:8: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘x’ may fail for the following constructors: T4
+ Selecting the record field ‘x’ may fail for the following constructors:
+ T4
DsIncompleteRecSel2.hs:28:19: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘x’ may fail for the following constructors: P
+ Selecting the record field ‘x’ may fail for the following constructors:
+ P
+
=====================================
testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel3.stderr
=====================================
@@ -1,80 +1,48 @@
-
DsIncompleteRecSel3.hs:29:7: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘x’ may fail for the following constructors: T2
+ Selecting the record field ‘x’ may fail for the following constructors:
+ T2
DsIncompleteRecSel3.hs:34:7: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘y’ may fail for the following constructors: G2
- G3
- G4
- G5
- ...
+ Selecting the record field ‘y’ may fail for the following constructors:
+ G2, G3, G4, G5, ...
DsIncompleteRecSel3.hs:34:13: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘y’ may fail for the following constructors: G2
- G3
- G4
- G5
- ...
+ Selecting the record field ‘y’ may fail for the following constructors:
+ G2, G3, G4, G5, ...
DsIncompleteRecSel3.hs:34:19: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘y’ may fail for the following constructors: G2
- G3
- G4
- G5
- ...
+ Selecting the record field ‘y’ may fail for the following constructors:
+ G2, G3, G4, G5, ...
DsIncompleteRecSel3.hs:34:25: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘y’ may fail for the following constructors: G2
- G3
- G4
- G5
- ...
+ Selecting the record field ‘y’ may fail for the following constructors:
+ G2, G3, G4, G5, ...
DsIncompleteRecSel3.hs:34:31: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘y’ may fail for the following constructors: G2
- G3
- G4
- G5
- ...
+ Selecting the record field ‘y’ may fail for the following constructors:
+ G2, G3, G4, G5, ...
DsIncompleteRecSel3.hs:34:37: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘y’ may fail for the following constructors: G2
- G3
- G4
- G5
- ...
+ Selecting the record field ‘y’ may fail for the following constructors:
+ G2, G3, G4, G5, ...
DsIncompleteRecSel3.hs:34:43: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘y’ may fail for the following constructors: G2
- G3
- G4
- G5
- ...
+ Selecting the record field ‘y’ may fail for the following constructors:
+ G2, G3, G4, G5, ...
DsIncompleteRecSel3.hs:34:49: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘y’ may fail for the following constructors: G2
- G3
- G4
- G5
- ...
+ Selecting the record field ‘y’ may fail for the following constructors:
+ G2, G3, G4, G5, ...
DsIncompleteRecSel3.hs:34:55: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘y’ may fail for the following constructors: G2
- G3
- G4
- G5
- ...
+ Selecting the record field ‘y’ may fail for the following constructors:
+ G2, G3, G4, G5, ...
DsIncompleteRecSel3.hs:34:61: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘y’ may fail for the following constructors: G2
- G3
- G4
- G5
- ...
+ Selecting the record field ‘y’ may fail for the following constructors:
+ G2, G3, G4, G5, ...
DsIncompleteRecSel3.hs:37:5: warning: [GHC-17335] [-Wincomplete-record-selectors]
- The application of the record field ‘y’ may fail for the following constructors: G2
- G3
- G4
- G5
- ...
+ Selecting the record field ‘y’ may fail for the following constructors:
+ G2, G3, G4, G5, ...
+
=====================================
testsuite/tests/pmcheck/should_compile/T24824.hs
=====================================
@@ -0,0 +1,36 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T24824 where
+
+import GHC.Hs hiding (DataConCantHappen)
+
+main :: IO ()
+main = do
+ let hsModule = undefined :: HsModule GhcPs
+ let _ = hsmodImports $ hsModule -- warns
+ let _ = hsmodImports hsModule -- does not warn
+ pure ()
+
+data S a where
+ S1 :: S Int
+ S2 :: { x::Int } -> S a
+ S3 :: { x::Int } -> S a
+
+-- x :: forall a. S a -> Int
+-- A partial function
+
+g :: S Bool -> Int
+g s = (x @Bool) $ s
+
+data W a where
+ W1 :: !(F a) -> W a
+ W2 :: { y::Int } -> W a
+ W3 :: { y::Int } -> W a
+
+data DataConCantHappen
+
+type family F a
+type instance F Bool = DataConCantHappen
+
+h :: W Bool -> Int
+h w = y @Bool $ w
=====================================
testsuite/tests/pmcheck/should_compile/T24891.hs
=====================================
@@ -0,0 +1,30 @@
+{-# LANGUAGE GADTs, OverloadedRecordDot, DataKinds #-}
+
+module T24891 where
+
+import GHC.Records
+
+data T a where
+ T1 :: T Int
+ T2 :: {sel :: Int} -> T Bool
+ T3 :: T Bool
+
+f :: T Bool -> Int
+f x = x.sel -- warn, but only once, suggesting to match on T3
+
+data Dot = No | Yes {sel2 :: Int}
+
+ldiDot :: Dot -> Int
+ldiDot No = 0
+ldiDot d = d.sel2 -- do not warn
+
+accessDot :: HasField "sel2" t Int => t -> Int
+accessDot x = x.sel2 -- do not warn
+
+solveDot :: Dot -> Int
+solveDot = accessDot -- warn
+
+data Dot2 t = No2 | Yes2 {sel3 :: t}
+
+accessDot2 :: HasField "sel2" t Int => Dot2 t -> Int
+accessDot2 x = x.sel3.sel2 -- warn about x.sel3
=====================================
testsuite/tests/pmcheck/should_compile/T24891.stderr
=====================================
@@ -0,0 +1,12 @@
+T24891.hs:13:7: warning: [GHC-17335] [-Wincomplete-record-selectors]
+ Selecting the record field ‘sel’ may fail for the following constructors:
+ T3
+
+T24891.hs:25:12: warning: [GHC-86894] [-Wincomplete-record-selectors]
+ Selecting the record field ‘sel2’ may fail for the following constructors:
+ No
+
+T24891.hs:30:16: warning: [GHC-17335] [-Wincomplete-record-selectors]
+ Selecting the record field ‘sel3’ may fail for the following constructors:
+ No2
+
=====================================
testsuite/tests/pmcheck/should_compile/all.T
=====================================
@@ -172,4 +172,6 @@ test('DsIncompleteRecSel2', normal, compile, ['-Wincomplete-record-selectors'])
test('DsIncompleteRecSel3', [collect_compiler_stats('bytes allocated', 10)], compile, ['-Wincomplete-record-selectors'])
test('DoubleMatch', normal, compile, [overlapping_incomplete])
test('T24817', normal, compile, [overlapping_incomplete])
+test('T24824', normal, compile, ['-package ghc -Wincomplete-record-selectors'])
+test('T24891', normal, compile, ['-Wincomplete-record-selectors'])
test('T25257', normal, compile, [overlapping_incomplete])
=====================================
testsuite/tests/typecheck/should_compile/TcIncompleteRecSel.stderr
=====================================
@@ -1,3 +1,4 @@
-
TcIncompleteRecSel.hs:16:5: warning: [GHC-86894] [-Wincomplete-record-selectors]
- The invocation of `getField` on the record field ‘x’ may produce an error since it is not defined for all data constructors
+ Selecting the record field ‘x’ may fail for the following constructors:
+ T2
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/024addc0420e57cfc882e6af0a4af2ec7409c413...7cf5a9a24d0a9ed90e855fd259bf788a14e387c0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/024addc0420e57cfc882e6af0a4af2ec7409c413...7cf5a9a24d0a9ed90e855fd259bf788a14e387c0
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/20240925/8e8b1624/attachment-0001.html>
More information about the ghc-commits
mailing list