diff options
| -rw-r--r-- | compiler/typecheck/TcDeriv.hs | 64 | ||||
| -rw-r--r-- | testsuite/tests/deriving/should_compile/T17324.hs | 17 | ||||
| -rw-r--r-- | testsuite/tests/deriving/should_compile/T17324.stderr | 4 | ||||
| -rw-r--r-- | testsuite/tests/deriving/should_compile/all.T | 1 |
4 files changed, 60 insertions, 26 deletions
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 6688ed7cbc..9b4f31e6d1 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -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 () diff --git a/testsuite/tests/deriving/should_compile/T17324.hs b/testsuite/tests/deriving/should_compile/T17324.hs new file mode 100644 index 0000000000..7373af8936 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T17324.hs @@ -0,0 +1,17 @@ +{-# 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) diff --git a/testsuite/tests/deriving/should_compile/T17324.stderr b/testsuite/tests/deriving/should_compile/T17324.stderr new file mode 100644 index 0000000000..54e6534462 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T17324.stderr @@ -0,0 +1,4 @@ + +T17324.hs:8:1: warning: [-Wunused-imports (in -Wextra)] + The import of ‘Dual, Product, Sum’ + from module ‘Data.Monoid’ is redundant diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index a12cf95c28..04fd02518f 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -118,3 +118,4 @@ test('T15637', normal, compile, ['']) test('T15831', normal, compile, ['']) test('T16179', normal, compile, ['']) test('T16518', normal, compile, ['']) +test('T17324', normal, compile, ['']) |