diff options
author | sheaf <sam.derbyshire@gmail.com> | 2022-02-21 16:43:27 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-02-22 16:00:14 -0500 |
commit | 0b36801f8eec9b9a7cc512135a13eaf89da370a2 (patch) | |
tree | 8d6cf545d9838c1b23fa0b30f5272b0e4937eb3e | |
parent | 2b890c89ba5de9bbf91388d7268919d5c7769bbf (diff) | |
download | haskell-0b36801f8eec9b9a7cc512135a13eaf89da370a2.tar.gz |
Forbid standalone instances for built-in classes
`check_special_inst_head` includes logic that disallows hand-written
instances for built-in classes such as Typeable, KnownNat
and KnownSymbol.
However, it also allowed standalone deriving declarations. This was
because we do want to allow standalone deriving instances with
Typeable as they are harmless, but we certainly don't want to allow
instances for e.g. KnownNat.
This patch ensures that we don't allow derived instances for
KnownNat, KnownSymbol (and also KnownChar, which was previously
omitted entirely).
Fixes #21087
-rw-r--r-- | compiler/GHC/Tc/Validity.hs | 37 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_fail/T21087.hs | 11 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_fail/T21087.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_fail/T21087b.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_fail/T21087b.stderr | 10 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_fail/T21087b_aux.hs | 11 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_fail/T21087b_aux.hs-boot | 11 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_fail/all.T | 2 |
8 files changed, 75 insertions, 14 deletions
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs index cad2ea1796..8be1944651 100644 --- a/compiler/GHC/Tc/Validity.hs +++ b/compiler/GHC/Tc/Validity.hs @@ -1385,21 +1385,24 @@ check_special_inst_head dflags is_boot is_sig ctxt clas cls_args , not is_boot = failWithTc (TcRnAbstractClassInst clas) - -- For Typeable, don't complain about instances for - -- standalone deriving; they are no-ops, and we warn about - -- it in GHC.Tc.Deriv.deriveStandalone. + -- Complain about hand-written instances of built-in classes + -- Typeable, KnownNat, KnownSymbol, Coercible, HasField. + + -- Disallow hand-written Typeable instances, except that we + -- allow a standalone deriving declaration: they are no-ops, + -- and we warn about them in GHC.Tc.Deriv.deriveStandalone. | clas_nm == typeableClassName , not is_sig -- Note [Instances of built-in classes in signature files] , hand_written_bindings = failWithTc $ TcRnSpecialClassInst clas False - -- Handwritten instances of KnownNat/KnownSymbol - -- are forbidden outside of signature files (#12837) - | clas_nm `elem` [ knownNatClassName, knownSymbolClassName ] - , not is_sig + -- Handwritten instances of KnownNat/KnownChar/KnownSymbol + -- are forbidden outside of signature files (#12837). + -- Derived instances are forbidden completely (#21087). + | clas_nm `elem` [ knownNatClassName, knownSymbolClassName, knownCharClassName ] + , (not is_sig && hand_written_bindings) || derived_instance -- Note [Instances of built-in classes in signature files] - , hand_written_bindings = failWithTc $ TcRnSpecialClassInst clas False -- For the most part we don't allow @@ -1438,12 +1441,18 @@ check_special_inst_head dflags is_boot is_sig ctxt clas cls_args ty_args = filterOutInvisibleTypes (classTyCon clas) cls_args hand_written_bindings - = case ctxt of - InstDeclCtxt stand_alone -> not stand_alone - SpecInstCtxt -> False - DerivClauseCtxt -> False - SigmaCtxt -> False - _ -> True + = case ctxt of + InstDeclCtxt standalone -> not standalone + SpecInstCtxt -> False + DerivClauseCtxt -> False + SigmaCtxt -> False + _ -> True + + derived_instance + = case ctxt of + InstDeclCtxt standalone -> standalone + DerivClauseCtxt -> True + _ -> False check_h98_arg_shape = case ctxt of SpecInstCtxt -> False diff --git a/testsuite/tests/deriving/should_fail/T21087.hs b/testsuite/tests/deriving/should_fail/T21087.hs new file mode 100644 index 0000000000..730dbac153 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T21087.hs @@ -0,0 +1,11 @@ +{-# language DataKinds #-} +{-# language DerivingVia #-} +{-# language TypeFamilies #-} + +module T21087 where + +import GHC.TypeLits + +data family Z :: k + +deriving via 0 instance KnownNat Z diff --git a/testsuite/tests/deriving/should_fail/T21087.stderr b/testsuite/tests/deriving/should_fail/T21087.stderr new file mode 100644 index 0000000000..8e40f6e641 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T21087.stderr @@ -0,0 +1,4 @@ + +T21087.hs:11:25: error: + • Class ‘KnownNat’ does not support user-specified instances. + • In the stand-alone deriving instance for ‘KnownNat Z’ diff --git a/testsuite/tests/deriving/should_fail/T21087b.hs b/testsuite/tests/deriving/should_fail/T21087b.hs new file mode 100644 index 0000000000..522c1603a7 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T21087b.hs @@ -0,0 +1,3 @@ +module T21087b where + +import {-# SOURCE #-} T21087b_aux diff --git a/testsuite/tests/deriving/should_fail/T21087b.stderr b/testsuite/tests/deriving/should_fail/T21087b.stderr new file mode 100644 index 0000000000..4caee4928e --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T21087b.stderr @@ -0,0 +1,10 @@ +[1 of 3] Compiling T21087b_aux[boot] ( T21087b_aux.hs-boot, T21087b_aux.o-boot ) + +T21087b_aux.hs-boot:11:25: error: + • Class ‘KnownNat’ does not support user-specified instances. + • In the stand-alone deriving instance for ‘KnownNat Z’ +[3 of 3] Compiling T21087b_aux ( T21087b_aux.hs, T21087b_aux.o ) + +T21087b_aux.hs:11:25: error: + • Class ‘KnownNat’ does not support user-specified instances. + • In the stand-alone deriving instance for ‘KnownNat Z’ diff --git a/testsuite/tests/deriving/should_fail/T21087b_aux.hs b/testsuite/tests/deriving/should_fail/T21087b_aux.hs new file mode 100644 index 0000000000..2cccf704ea --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T21087b_aux.hs @@ -0,0 +1,11 @@ +{-# language DataKinds #-} +{-# language DerivingVia #-} +{-# language TypeFamilies #-} + +module T21087b_aux where + +import GHC.TypeLits + +data family Z :: k + +deriving via 0 instance KnownNat Z diff --git a/testsuite/tests/deriving/should_fail/T21087b_aux.hs-boot b/testsuite/tests/deriving/should_fail/T21087b_aux.hs-boot new file mode 100644 index 0000000000..2cccf704ea --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T21087b_aux.hs-boot @@ -0,0 +1,11 @@ +{-# language DataKinds #-} +{-# language DerivingVia #-} +{-# language TypeFamilies #-} + +module T21087b_aux where + +import GHC.TypeLits + +data family Z :: k + +deriving via 0 instance KnownNat Z diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index 70bd0f9dbe..61d74b72b4 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -80,3 +80,5 @@ test('deriving-via-fail2', normal, compile_fail, ['']) test('deriving-via-fail3', normal, compile_fail, ['']) test('deriving-via-fail4', normal, compile_fail, ['']) test('deriving-via-fail5', normal, compile_fail, ['']) +test('T21087', normal, compile_fail, ['']) +test('T21087b', [extra_files(['T21087b_aux.hs','T21087b_aux.hs-boot'])], multimod_compile_fail, ['T21087b', '']) |