Commit d584e3f0 authored by Ryan Scott's avatar Ryan Scott Committed by Marge Bot

Use addUsedDataCons more judiciously in TcDeriv (#17324)

If you derive an instance like this:

```hs
deriving <...> instance Foo C
```

And the data constructors for `C` aren't in scope, then
`doDerivInstErrorChecks1` throws an error. Moreover, it will
_only_ throw an error if `<...>` is either `stock` or `newtype`.
This is because the code that the `anyclass` or `via` strategies
would generate would not require the use of the data constructors
for `C`.

However, `doDerivInstErrorChecks1` has another purpose. If you
write this:

```hs
import M (C(MkC1, ..., MkCn))

deriving <...> instance Foo C
```

Then `doDerivInstErrorChecks1` will call `addUsedDataCons` on
`MkC1` through `MkCn` to ensure that `-Wunused-imports` does not
complain about them. However, `doDerivInstErrorChecks1` was doing
this for _every_ deriving strategy, which mean that if `<...>` were
`anyclass` or `via`, then the warning about `MkC1` through `MkCn`
being unused would be suppressed!

The fix is simple enough: only call `addUsedDataCons` when the
strategy is `stock` or `newtype`, just like the other code paths
in `doDerivInstErrorChecks1`.

Fixes #17324.
parent 35cc5eff
Pipeline #11234 failed with stages
in 811 minutes and 26 seconds
......@@ -1972,34 +1972,46 @@ genInst spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon
set_span_and_ctxt :: TcM a -> TcM a
set_span_and_ctxt = setSrcSpan loc . addErrCtxt (instDeclCtxt3 clas tys)
-- When processing a standalone deriving declaration, check that all of the
-- constructors for the data type are in scope. For instance:
--
-- import M (T)
-- deriving stock instance Eq T
--
-- This should be rejected, as the derived Eq instance would need to refer to
-- the constructors for T, which are not in scope.
--
-- Note that the only strategies that require this check are `stock` and
-- `newtype`. Neither `anyclass` nor `via` require it as the code that they
-- generate does not require using data constructors.
doDerivInstErrorChecks1 :: DerivSpecMechanism -> DerivM ()
doDerivInstErrorChecks1 mechanism = do
DerivEnv { denv_tc = tc
, denv_rep_tc = rep_tc } <- ask
standalone <- isStandaloneDeriv
let anyclass_strategy = isDerivSpecAnyClass mechanism
via_strategy = isDerivSpecVia mechanism
bale_out msg = do err <- derivingThingErrMechanism mechanism msg
lift $ failWithTc err
-- For standalone deriving, check that all the data constructors are in
-- scope...
rdr_env <- lift getGlobalRdrEnv
let data_con_names = map dataConName (tyConDataCons rep_tc)
hidden_data_cons = not (isWiredInName (tyConName rep_tc)) &&
(isAbstractTyCon rep_tc ||
any not_in_scope data_con_names)
not_in_scope dc = isNothing (lookupGRE_Name rdr_env dc)
lift $ addUsedDataCons rdr_env rep_tc
-- ...however, we don't perform this check if we're using DeriveAnyClass,
-- since it doesn't generate any code that requires use of a data
-- constructor. Nor do we perform this check with @deriving via@, as it
-- doesn't explicitly require the constructors to be in scope.
unless (anyclass_strategy || via_strategy
|| not standalone || not hidden_data_cons) $
bale_out $ derivingHiddenErr tc
standalone <- isStandaloneDeriv
when standalone $ case mechanism of
DerivSpecStock{} -> check
DerivSpecNewtype{} -> check
DerivSpecAnyClass{} -> pure ()
DerivSpecVia{} -> pure ()
where
check :: DerivM ()
check = do
DerivEnv { denv_tc = tc, denv_rep_tc = rep_tc } <- ask
let bale_out msg = do err <- derivingThingErrMechanism mechanism msg
lift $ failWithTc err
rdr_env <- lift getGlobalRdrEnv
let data_con_names = map dataConName (tyConDataCons rep_tc)
hidden_data_cons = not (isWiredInName (tyConName rep_tc)) &&
(isAbstractTyCon rep_tc ||
any not_in_scope data_con_names)
not_in_scope dc = isNothing (lookupGRE_Name rdr_env dc)
-- Make sure to also mark the data constructors as used so that GHC won't
-- mistakenly emit -Wunused-imports warnings about them.
lift $ addUsedDataCons rdr_env rep_tc
unless (not hidden_data_cons) $
bale_out $ derivingHiddenErr tc
doDerivInstErrorChecks2 :: Class -> ClsInst -> ThetaType -> Maybe SrcSpan
-> DerivSpecMechanism -> TcM ()
......
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wunused-imports #-}
module T17324 where
import Data.Monoid (Sum(Sum), Product(Product), Dual(Dual))
class C1 a
deriving anyclass instance C1 (Sum a)
class C2 a
deriving anyclass instance C2 (Product a)
class C3 a
deriving via Dual a instance C3 (Dual a)
T17324.hs:8:1: warning: [-Wunused-imports (in -Wextra)]
The import of ‘Dual, Product, Sum’
from module ‘Data.Monoid’ is redundant
......@@ -118,3 +118,4 @@ test('T15637', normal, compile, [''])
test('T15831', normal, compile, [''])
test('T16179', normal, compile, [''])
test('T16518', normal, compile, [''])
test('T17324', normal, compile, [''])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment