diff options
| -rw-r--r-- | compiler/typecheck/TcInstDcls.hs | 8 | ||||
| -rw-r--r-- | compiler/types/Class.hs | 5 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T13068.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T13068.hs-boot | 2 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T13068.stderr | 6 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T13068a.hs | 3 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T13068m.hs | 2 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/all.T | 1 |
8 files changed, 31 insertions, 0 deletions
diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 95d33dde30..76d963d192 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -520,6 +520,10 @@ doClsInstErrorChecks inst_info -- In hs-boot files there should be no bindings ; failIfTc (is_boot && not no_binds) badBootDeclErr + -- If not in an hs-boot file, abstract classes cannot have + -- instances declared + ; failIfTc (not is_boot && isAbstractClass clas) abstractClassInstErr + -- Handwritten instances of any rejected -- class is always forbidden -- #12837 @@ -535,12 +539,16 @@ doClsInstErrorChecks inst_info binds = iBinds inst_info no_binds = isEmptyLHsBinds (ib_binds binds) && null (ib_pragmas binds) clas_nm = is_cls_nm ispec + clas = is_cls ispec gen_inst_err = hang (text ("Generic instances can only be " ++ "derived in Safe Haskell.") $+$ text "Replace the following instance:") 2 (pprInstanceHdr ispec) + abstractClassInstErr = + text "Cannot define instance for abstract class" <+> quotes (ppr clas_nm) + -- Report an error or a warning for certain class instances. -- If we are working on an .hs-boot file, we just report a warning, -- and ignore the instance. We do this, to give users a chance to fix diff --git a/compiler/types/Class.hs b/compiler/types/Class.hs index cd9f8dee95..ecc7e2efa2 100644 --- a/compiler/types/Class.hs +++ b/compiler/types/Class.hs @@ -18,6 +18,7 @@ module Class ( classKey, className, classATs, classATItems, classTyCon, classMethods, classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta, classAllSelIds, classSCSelId, classMinimalDef, classHasFds, + isAbstractClass, naturallyCoherentClass ) where @@ -302,6 +303,10 @@ classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps, }}) = (tyvars, fundeps, sc_theta, sc_sels, ats, op_stuff) +isAbstractClass :: Class -> Bool +isAbstractClass Class{ classBody = AbstractClass } = True +isAbstractClass _ = False + -- | If a class is "naturally coherent", then we needn't worry at all, in any -- way, about overlapping/incoherent instances. Just solve the thing! naturallyCoherentClass :: Class -> Bool diff --git a/testsuite/tests/typecheck/should_fail/T13068.hs b/testsuite/tests/typecheck/should_fail/T13068.hs new file mode 100644 index 0000000000..e0b8f57c94 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13068.hs @@ -0,0 +1,4 @@ +module T13068 where +import T13068a +class C a where + f :: a diff --git a/testsuite/tests/typecheck/should_fail/T13068.hs-boot b/testsuite/tests/typecheck/should_fail/T13068.hs-boot new file mode 100644 index 0000000000..b23b752349 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13068.hs-boot @@ -0,0 +1,2 @@ +module T13068 where +class C a diff --git a/testsuite/tests/typecheck/should_fail/T13068.stderr b/testsuite/tests/typecheck/should_fail/T13068.stderr new file mode 100644 index 0000000000..c161209001 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13068.stderr @@ -0,0 +1,6 @@ +[1 of 4] Compiling T13068[boot] ( T13068.hs-boot, T13068.o-boot ) +[2 of 4] Compiling T13068a ( T13068a.hs, T13068a.o ) + +T13068a.hs:3:1: error: + • Cannot define instance for abstract class ‘C’ + • In the instance declaration for ‘C Int’ diff --git a/testsuite/tests/typecheck/should_fail/T13068a.hs b/testsuite/tests/typecheck/should_fail/T13068a.hs new file mode 100644 index 0000000000..fb7bda627a --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13068a.hs @@ -0,0 +1,3 @@ +module T13068a where +import {-# SOURCE #-} T13068 +instance C Int where diff --git a/testsuite/tests/typecheck/should_fail/T13068m.hs b/testsuite/tests/typecheck/should_fail/T13068m.hs new file mode 100644 index 0000000000..3effc0a159 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13068m.hs @@ -0,0 +1,2 @@ +import T13068 +main = print (f :: Int) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 86334bac76..2d1d12bf74 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -424,6 +424,7 @@ test('T12918b', normal, compile_fail, ['']) test('T12921', normal, compile_fail, ['']) test('T12973', normal, compile_fail, ['']) test('StrictBinds', normal, compile_fail, ['']) +test('T13068', [extra_files(['T13068.hs', 'T13068a.hs', 'T13068.hs-boot', 'T13068m.hs'])], multimod_compile_fail, ['T13068m', '']) test('T13105', normal, compile_fail, ['']) test('LevPolyBounded', normal, compile_fail, ['']) test('T13292', normal, multimod_compile, ['T13292', '-v0 -fdefer-type-errors']) |