summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2019-07-07 20:14:14 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-07-11 17:47:41 -0400
commitb507acebdc3dbec53c54ae07175b39da4066d4f8 (patch)
treecb0ee4f150e047927e4499075eb35ca724327dab
parent01ec8549871ebc43db3a7e28324222fa739c6531 (diff)
downloadhaskell-b507acebdc3dbec53c54ae07175b39da4066d4f8.tar.gz
Don't typecheck too much (or too little) in DerivingVia (#16923)
Previously, GHC would typecheck the `via` type once per class in a `deriving` clause, which caused the problems observed in #16923. This patch restructures some of the functionality in `TcDeriv` and `TcHsType` to avoid this problem. We now typecheck the `via` type exactly once per `deriving` clause and *then* typecheck all of the classes in the clause. See `Note [Don't typecheck too much in DerivingVia]` in `TcDeriv` for the full details.
-rw-r--r--compiler/typecheck/TcDeriv.hs258
-rw-r--r--compiler/typecheck/TcHsType.hs60
-rw-r--r--testsuite/tests/deriving/should_fail/T16923.hs4
-rw-r--r--testsuite/tests/deriving/should_fail/T16923.stderr6
-rw-r--r--testsuite/tests/deriving/should_fail/all.T1
5 files changed, 191 insertions, 138 deletions
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 4ab9fa69d3..c8617b89d1 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -492,21 +492,16 @@ makeDerivSpecs :: Bool
-> [LDerivDecl GhcRn]
-> TcM [EarlyDerivSpec]
makeDerivSpecs is_boot deriv_infos deriv_decls
- = do { -- We carefully set up uses of recoverM to minimize error message
- -- cascades. See Note [Flattening deriving clauses].
- ; eqns1 <- sequenceA
- [ recoverM (pure Nothing)
- (deriveClause rep_tc (fmap unLoc dcs)
- pred err_ctxt)
+ = do { eqns1 <- sequenceA
+ [ deriveClause rep_tc dcs preds err_ctxt
| DerivInfo { di_rep_tc = rep_tc, di_clauses = clauses
, di_ctxt = err_ctxt } <- deriv_infos
, L _ (HsDerivingClause { deriv_clause_strategy = dcs
, deriv_clause_tys = L _ preds })
<- clauses
- , pred <- preds
]
; eqns2 <- mapM (recoverM (pure Nothing) . deriveStandalone) deriv_decls
- ; let eqns = catMaybes (eqns1 ++ eqns2)
+ ; let eqns = concat eqns1 ++ catMaybes eqns2
; if is_boot then -- No 'deriving' at all in hs-boot files
do { unless (null eqns) (add_deriv_err (head eqns))
@@ -518,9 +513,116 @@ makeDerivSpecs is_boot deriv_infos deriv_decls
addErr (hang (text "Deriving not permitted in hs-boot file")
2 (text "Use an instance declaration instead"))
+------------------------------------------------------------------
+-- | Process the derived classes in a single @deriving@ clause.
+deriveClause :: TyCon -> Maybe (LDerivStrategy GhcRn)
+ -> [LHsSigType GhcRn] -> SDoc
+ -> TcM [EarlyDerivSpec]
+deriveClause rep_tc mb_lderiv_strat deriv_preds err_ctxt
+ = addErrCtxt err_ctxt $ do
+ traceTc "deriveClause" $ vcat
+ [ text "tvs" <+> ppr tvs
+ , text "tc" <+> ppr tc
+ , text "tys" <+> ppr tys
+ , text "mb_lderiv_strat" <+> ppr mb_lderiv_strat ]
+ tcExtendTyVarEnv tvs $ do
+ (mb_lderiv_strat', via_tvs) <- tcDerivStrategy mb_lderiv_strat
+ tcExtendTyVarEnv via_tvs $
+ -- Moreover, when using DerivingVia one can bind type variables in
+ -- the `via` type as well, so these type variables must also be
+ -- brought into scope.
+ mapMaybeM (derivePred tc tys mb_lderiv_strat' via_tvs) deriv_preds
+ -- After typechecking the `via` type once, we then typecheck all
+ -- of the classes associated with that `via` type in the
+ -- `deriving` clause.
+ -- See also Note [Don't typecheck too much in DerivingVia].
+ where
+ tvs = tyConTyVars rep_tc
+ (tc, tys) = case tyConFamInstSig_maybe rep_tc of
+ -- data family:
+ Just (fam_tc, pats, _) -> (fam_tc, pats)
+ -- NB: deriveTyData wants the *user-specified*
+ -- name. See Note [Why we don't pass rep_tc into deriveTyData]
+
+ _ -> (rep_tc, mkTyVarTys tvs) -- datatype
+
+-- | Process a single predicate in a @deriving@ clause.
+--
+-- This returns a 'Maybe' because the user might try to derive 'Typeable',
+-- which is a no-op nowadays.
+derivePred :: TyCon -> [Type] -> Maybe (LDerivStrategy GhcTc) -> [TyVar]
+ -> LHsSigType GhcRn -> TcM (Maybe EarlyDerivSpec)
+derivePred tc tys mb_lderiv_strat via_tvs deriv_pred =
+ -- We carefully set up uses of recoverM to minimize error message
+ -- cascades. See Note [Recovering from failures in deriving clauses].
+ recoverM (pure Nothing) $
+ setSrcSpan (getLoc (hsSigType deriv_pred)) $ do
+ traceTc "derivePred" $ vcat
+ [ text "tc" <+> ppr tc
+ , text "tys" <+> ppr tys
+ , text "deriv_pred" <+> ppr deriv_pred
+ , text "mb_lderiv_strat" <+> ppr mb_lderiv_strat
+ , text "via_tvs" <+> ppr via_tvs ]
+ (cls_tvs, cls, cls_tys, cls_arg_kinds) <- tcHsDeriv deriv_pred
+ when (cls_arg_kinds `lengthIsNot` 1) $
+ failWithTc (nonUnaryErr deriv_pred)
+ let [cls_arg_kind] = cls_arg_kinds
+ mb_deriv_strat = fmap unLoc mb_lderiv_strat
+ if (className cls == typeableClassName)
+ then do warnUselessTypeable
+ return Nothing
+ else let deriv_tvs = via_tvs ++ cls_tvs in
+ Just <$> deriveTyData tc tys mb_deriv_strat
+ deriv_tvs cls cls_tys cls_arg_kind
+
{-
-Note [Flattening deriving clauses]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Don't typecheck too much in DerivingVia]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider the following example:
+
+ data D = ...
+ deriving (A1 t, ..., A20 t) via T t
+
+GHC used to be engineered such that it would typecheck the `deriving`
+clause like so:
+
+1. Take the first class in the clause (`A1`).
+2. Typecheck the `via` type (`T t`) and bring its bound type variables
+ into scope (`t`).
+3. Typecheck the class (`A1`).
+4. Move on to the next class (`A2`) and repeat the process until all
+ classes have been typechecked.
+
+This algorithm gets the job done most of the time, but it has two notable
+flaws. One flaw is that it is wasteful: it requires that `T t` be typechecked
+20 different times, once for each class in the `deriving` clause. This is
+unnecessary because we only need to typecheck `T t` once in order to get
+access to its bound type variable.
+
+The other issue with this algorithm arises when there are no classes in the
+`deriving` clause, like in the following example:
+
+ data D2 = ...
+ deriving () via Maybe Maybe
+
+Because there are no classes, the algorithm above will simply do nothing.
+As a consequence, GHC will completely miss the fact that `Maybe Maybe`
+is ill-kinded nonsense (#16923).
+
+To address both of these problems, GHC now uses this algorithm instead:
+
+1. Typecheck the `via` type and bring its boudn type variables into scope.
+2. Take the first class in the `deriving` clause.
+3. Typecheck the class.
+4. Move on to the next class and repeat the process until all classes have been
+ typechecked.
+
+This algorithm ensures that the `via` type is always typechecked, even if there
+are no classes in the `deriving` clause. Moreover, it typecheck the `via` type
+/exactly/ once and no more, even if there are multiple classes in the clause.
+
+Note [Recovering from failures in deriving clauses]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider what happens if you run this program (from #10684) without
DeriveGeneric enabled:
@@ -543,31 +645,25 @@ additional error on the program above:
This was happening because when GHC encountered any error within a single
data type's set of deriving clauses, it would call recoverM and move on
to the next data type's deriving clauses. One unfortunate consequence of
-this design is that if A's derived Generic instance failed, so its derived
+this design is that if A's derived Generic instance failed, its derived
Show instance would be skipped entirely, leading to the "No instance for
(Show A)" error cascade.
-The solution to this problem is to "flatten" the set of classes that are
-derived for a particular data type via deriving clauses. That is, if
-you have:
+The solution to this problem is to push through uses of recoverM to the
+level of the individual derived classes in a particular data type's set of
+deriving clauses. That is, if you have:
newtype C = C D
deriving (E, F, G)
- deriving anyclass (H, I, J)
- deriving newtype (K, L, M)
Then instead of processing instances E through M under the scope of a single
-recoverM, we flatten these deriving clauses into the list:
-
- [ E (Nothing)
- , F (Nothing)
- , G (Nothing)
- , H (Just anyclass)
- , I (Just anyclass)
- , J (Just anyclass)
- , K (Just newtype)
- , L (Just newtype)
- , M (Just newtype) ]
+recoverM, as in the following pseudocode:
+
+ recoverM (pure Nothing) $ mapM derivePred [E, F, G]
+
+We instead use recoverM in each iteration of the loop:
+
+ mapM (recoverM (pure Nothing) . derivePred) [E, F, G]
And then process each class individually, under its own recoverM scope. That
way, failure to derive one class doesn't cancel out other classes in the
@@ -575,24 +671,6 @@ same set of clause-derived classes.
-}
------------------------------------------------------------------
--- | Process a single class in a `deriving` clause.
-deriveClause :: TyCon -> Maybe (DerivStrategy GhcRn)
- -> LHsSigType GhcRn -> SDoc
- -> TcM (Maybe EarlyDerivSpec)
-deriveClause rep_tc mb_strat pred err_ctxt
- = addErrCtxt err_ctxt $
- deriveTyData tvs tc tys mb_strat pred
- where
- tvs = tyConTyVars rep_tc
- (tc, tys) = case tyConFamInstSig_maybe rep_tc of
- -- data family:
- Just (fam_tc, pats, _) -> (fam_tc, pats)
- -- NB: deriveTyData wants the *user-specified*
- -- name. See Note [Why we don't pass rep_tc into deriveTyData]
-
- _ -> (rep_tc, mkTyVarTys tvs) -- datatype
-
-------------------------------------------------------------------
deriveStandalone :: LDerivDecl GhcRn -> TcM (Maybe EarlyDerivSpec)
-- Process a single standalone deriving declaration
-- e.g. deriving instance Show a => Show (T a)
@@ -600,21 +678,21 @@ deriveStandalone :: LDerivDecl GhcRn -> TcM (Maybe EarlyDerivSpec)
--
-- This returns a Maybe because the user might try to derive Typeable, which is
-- a no-op nowadays.
-deriveStandalone (L loc (DerivDecl _ deriv_ty mbl_deriv_strat overlap_mode))
+deriveStandalone (L loc (DerivDecl _ deriv_ty mb_lderiv_strat overlap_mode))
= setSrcSpan loc $
addErrCtxt (standaloneCtxt deriv_ty) $
do { traceTc "Standalone deriving decl for" (ppr deriv_ty)
- ; let mb_deriv_strat = fmap unLoc mbl_deriv_strat
- ctxt = TcType.InstDeclCtxt True
+ ; let ctxt = TcType.InstDeclCtxt True
; traceTc "Deriving strategy (standalone deriving)" $
- vcat [ppr mb_deriv_strat, ppr deriv_ty]
- ; (mb_deriv_strat', tvs', (deriv_ctxt', cls, inst_tys'))
- <- tcDerivStrategy mb_deriv_strat $ do
- (tvs, deriv_ctxt, cls, inst_tys)
- <- tcStandaloneDerivInstType ctxt deriv_ty
- pure (tvs, (deriv_ctxt, cls, inst_tys))
+ vcat [ppr mb_lderiv_strat, ppr deriv_ty]
+ ; (mb_lderiv_strat', via_tvs') <- tcDerivStrategy mb_lderiv_strat
+ ; (cls_tvs', deriv_ctxt', cls, inst_tys')
+ <- tcExtendTyVarEnv via_tvs' $
+ tcStandaloneDerivInstType ctxt deriv_ty
; checkTc (not (null inst_tys')) derivingNullaryErr
- ; let inst_ty' = last inst_tys'
+ ; let mb_deriv_strat' = fmap unLoc mb_lderiv_strat'
+ tvs' = via_tvs' ++ cls_tvs'
+ inst_ty' = last inst_tys'
-- See Note [Unify kinds in deriving]
; (tvs, deriv_ctxt, inst_tys) <-
case mb_deriv_strat' of
@@ -738,42 +816,22 @@ warnUselessTypeable
text "has no effect: all types now auto-derive Typeable" }
------------------------------------------------------------------
-deriveTyData :: [TyVar] -> TyCon -> [Type] -- LHS of data or data instance
+deriveTyData :: TyCon -> [Type] -- LHS of data or data instance
-- Can be a data instance, hence [Type] args
-- and in that case the TyCon is the /family/ tycon
- -> Maybe (DerivStrategy GhcRn) -- The optional deriving strategy
- -> LHsSigType GhcRn -- The deriving predicate
- -> TcM (Maybe EarlyDerivSpec)
+ -> Maybe (DerivStrategy GhcTc) -- The optional deriving strategy
+ -> [TyVar] -- The type variables bound by the derived class
+ -> Class -- The derived class
+ -> [Type] -- The derived class's arguments
+ -> Kind -- The function argument in the derived class's kind.
+ -- (e.g., if `deriving Functor`, this would be
+ -- `Type -> Type` since
+ -- `Functor :: (Type -> Type) -> Constraint`)
+ -> TcM EarlyDerivSpec
-- The deriving clause of a data or newtype declaration
-- I.e. not standalone deriving
---
--- This returns a Maybe because the user might try to derive Typeable, which is
--- a no-op nowadays.
-deriveTyData tvs tc tc_args mb_deriv_strat deriv_pred
- = setSrcSpan (getLoc (hsSigType deriv_pred)) $
- -- Use loc of the 'deriving' item
- do { (mb_deriv_strat', deriv_tvs, (cls, cls_tys, cls_arg_kinds))
- <- tcExtendTyVarEnv tvs $
- -- Deriving preds may (now) mention
- -- the type variables for the type constructor, hence tcExtendTyVarenv
- -- The "deriv_pred" is a LHsType to take account of the fact that for
- -- newtype deriving we allow deriving (forall a. C [a]).
-
- -- Typeable is special, because Typeable :: forall k. k -> Constraint
- -- so the argument kind 'k' is not decomposable by splitKindFunTys
- -- as is the case for all other derivable type classes
- tcDerivStrategy mb_deriv_strat $
- tcHsDeriv deriv_pred
-
- ; when (cls_arg_kinds `lengthIsNot` 1) $
- failWithTc (nonUnaryErr deriv_pred)
- ; let [cls_arg_kind] = cls_arg_kinds
- ; if className cls == typeableClassName
- then do warnUselessTypeable
- return Nothing
- else
-
- do { -- Given data T a b c = ... deriving( C d ),
+deriveTyData tc tc_args mb_deriv_strat deriv_tvs cls cls_tys cls_arg_kind
+ = do { -- Given data T a b c = ... deriving( C d ),
-- we want to drop type variables from T so that (C d (T a)) is well-kinded
let (arg_kinds, _) = splitFunTys cls_arg_kind
n_args_to_drop = length arg_kinds
@@ -816,7 +874,7 @@ deriveTyData tvs tc tc_args mb_deriv_strat deriv_pred
-- See Note [Unify kinds in deriving]
; (tkvs, final_cls_tys, final_tc_args, final_mb_deriv_strat) <-
- case mb_deriv_strat' of
+ case mb_deriv_strat of
-- Perform an additional unification with the kind of the `via`
-- type and the result of the previous kind unification.
Just (ViaStrategy via_ty) -> do
@@ -839,19 +897,17 @@ deriveTyData tvs tc tc_args mb_deriv_strat deriv_pred
)
_ -> pure ( tkvs', final_cls_tys', final_tc_args'
- , mb_deriv_strat' )
-
- ; traceTc "Deriving strategy (deriving clause)" $
- vcat [ppr final_mb_deriv_strat, ppr deriv_pred]
+ , mb_deriv_strat )
- ; traceTc "derivTyData1" (vcat [ pprTyVars tvs, ppr tc, ppr tc_args
- , ppr deriv_pred
- , pprTyVars (tyCoVarsOfTypesList tc_args)
- , ppr n_args_to_keep, ppr n_args_to_drop
- , ppr inst_ty_kind, ppr cls_arg_kind, ppr mb_match
- , ppr final_tc_args, ppr final_cls_tys ])
+ ; traceTc "deriveTyData 1" $ vcat
+ [ ppr mb_deriv_strat, pprTyVars deriv_tvs, ppr tc, ppr tc_args
+ , pprTyVars (tyCoVarsOfTypesList tc_args)
+ , ppr n_args_to_keep, ppr n_args_to_drop
+ , ppr inst_ty_kind, ppr cls_arg_kind, ppr mb_match
+ , ppr final_tc_args, ppr final_cls_tys ]
- ; traceTc "derivTyData2" (vcat [ ppr tkvs ])
+ ; traceTc "deriveTyData 2" $ vcat
+ [ ppr tkvs ]
; let final_tc_app = mkTyConApp tc final_tc_args
; checkTc (allDistinctTyVars (mkVarSet tkvs) args_to_drop) -- (a, b, c)
@@ -879,8 +935,8 @@ deriveTyData tvs tc tc_args mb_deriv_strat deriv_pred
; spec <- mkEqnHelp Nothing tkvs
cls final_cls_tys tc final_tc_args
(InferContext Nothing) final_mb_deriv_strat
- ; traceTc "derivTyData" (ppr spec)
- ; return $ Just spec } }
+ ; traceTc "deriveTyData 3" (ppr spec)
+ ; return spec }
{- Note [tc_args and tycon arity]
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index c81956d8a7..f067236be6 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -8,6 +8,7 @@
{-# LANGUAGE CPP, TupleSections, MultiWayIf, RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
module TcHsType (
-- Type signatures
@@ -299,7 +300,7 @@ tcTopLHsType hs_sig_type ctxt_kind
tcTopLHsType (XHsImplicitBndrs nec) _ = noExtCon nec
-----------------
-tcHsDeriv :: LHsSigType GhcRn -> TcM ([TyVar], (Class, [Type], [Kind]))
+tcHsDeriv :: LHsSigType GhcRn -> TcM ([TyVar], Class, [Type], [Kind])
-- Like tcHsSigType, but for the ...deriving( C t1 ty2 ) clause
-- Returns the C, [ty1, ty2, and the kinds of C's remaining arguments
-- E.g. class C (a::*) (b::k->k)
@@ -313,52 +314,37 @@ tcHsDeriv hs_ty
; let (tvs, pred) = splitForAllTys ty
(kind_args, _) = splitFunTys (tcTypeKind pred)
; case getClassPredTys_maybe pred of
- Just (cls, tys) -> return (tvs, (cls, tys, kind_args))
+ Just (cls, tys) -> return (tvs, cls, tys, kind_args)
Nothing -> failWithTc (text "Illegal deriving item" <+> quotes (ppr hs_ty)) }
--- | Typecheck something within the context of a deriving strategy.
--- This is of particular importance when the deriving strategy is @via@.
--- For instance:
---
--- @
--- deriving via (S a) instance C (T a)
--- @
---
--- We need to typecheck @S a@, and moreover, we need to extend the tyvar
--- environment with @a@ before typechecking @C (T a)@, since @S a@ quantified
--- the type variable @a@.
-tcDerivStrategy
- :: forall a.
- Maybe (DerivStrategy GhcRn) -- ^ The deriving strategy
- -> TcM ([TyVar], a) -- ^ The thing to typecheck within the context of the
- -- deriving strategy, which might quantify some type
- -- variables of its own.
- -> TcM (Maybe (DerivStrategy GhcTc), [TyVar], a)
- -- ^ The typechecked deriving strategy, all quantified tyvars, and
- -- the payload of the typechecked thing.
-tcDerivStrategy mds thing_inside
- = case mds of
+-- | Typecheck a deriving strategy. For most deriving strategies, this is a
+-- no-op, but for the @via@ strategy, this requires typechecking the @via@ type.
+tcDerivStrategy ::
+ Maybe (LDerivStrategy GhcRn)
+ -- ^ The deriving strategy
+ -> TcM (Maybe (LDerivStrategy GhcTc), [TyVar])
+ -- ^ The typechecked deriving strategy and the tyvars that it binds
+ -- (if using 'ViaStrategy').
+tcDerivStrategy mb_lds
+ = case mb_lds of
Nothing -> boring_case Nothing
- Just ds -> do (ds', tvs, thing) <- tc_deriv_strategy ds
- pure (Just ds', tvs, thing)
+ Just (dL->L loc ds) ->
+ setSrcSpan loc $ do
+ (ds', tvs) <- tc_deriv_strategy ds
+ pure (Just (cL loc ds'), tvs)
where
tc_deriv_strategy :: DerivStrategy GhcRn
- -> TcM (DerivStrategy GhcTc, [TyVar], a)
+ -> TcM (DerivStrategy GhcTc, [TyVar])
tc_deriv_strategy StockStrategy = boring_case StockStrategy
tc_deriv_strategy AnyclassStrategy = boring_case AnyclassStrategy
tc_deriv_strategy NewtypeStrategy = boring_case NewtypeStrategy
tc_deriv_strategy (ViaStrategy ty) = do
- ty' <- checkNoErrs $
- tcTopLHsType ty AnyKind
+ ty' <- checkNoErrs $ tcTopLHsType ty AnyKind
let (via_tvs, via_pred) = splitForAllTys ty'
- tcExtendTyVarEnv via_tvs $ do
- (thing_tvs, thing) <- thing_inside
- pure (ViaStrategy via_pred, via_tvs ++ thing_tvs, thing)
-
- boring_case :: mds -> TcM (mds, [TyVar], a)
- boring_case mds = do
- (thing_tvs, thing) <- thing_inside
- pure (mds, thing_tvs, thing)
+ pure (ViaStrategy via_pred, via_tvs)
+
+ boring_case :: ds -> TcM (ds, [TyVar])
+ boring_case ds = pure (ds, [])
tcHsClsInstType :: UserTypeCtxt -- InstDeclCtxt or SpecInstCtxt
-> LHsSigType GhcRn
diff --git a/testsuite/tests/deriving/should_fail/T16923.hs b/testsuite/tests/deriving/should_fail/T16923.hs
new file mode 100644
index 0000000000..eaa845864b
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T16923.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE DerivingVia #-}
+module T16923 where
+
+data Foo deriving () via Maybe Maybe
diff --git a/testsuite/tests/deriving/should_fail/T16923.stderr b/testsuite/tests/deriving/should_fail/T16923.stderr
new file mode 100644
index 0000000000..b17e673b30
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T16923.stderr
@@ -0,0 +1,6 @@
+
+T16923.hs:4:32: error:
+ • Expecting one more argument to ‘Maybe’
+ Expected a type, but ‘Maybe’ has kind ‘* -> *’
+ • In the first argument of ‘Maybe’, namely ‘Maybe’
+ In the data declaration for ‘Foo’
diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T
index 1f674805a3..bbef97bec7 100644
--- a/testsuite/tests/deriving/should_fail/all.T
+++ b/testsuite/tests/deriving/should_fail/all.T
@@ -73,6 +73,7 @@ test('T14728b', normal, compile_fail, [''])
test('T14916', normal, compile_fail, [''])
test('T15073', [extra_files(['T15073a.hs'])], multimod_compile_fail,
['T15073', '-v0'])
+test('T16923', normal, compile_fail, [''])
test('deriving-via-fail', normal, compile_fail, [''])
test('deriving-via-fail2', normal, compile_fail, [''])
test('deriving-via-fail3', normal, compile_fail, [''])