summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/backpack/RnModIface.hs17
-rw-r--r--compiler/basicTypes/OccName.hs8
-rw-r--r--compiler/iface/TcIface.hs14
-rw-r--r--compiler/typecheck/TcClassDcl.hs29
-rw-r--r--compiler/typecheck/TcRnDriver.hs35
-rw-r--r--compiler/utils/BooleanFormula.hs37
-rw-r--r--testsuite/tests/backpack/should_compile/all.T2
-rw-r--r--testsuite/tests/backpack/should_compile/bkp15.bkp19
-rw-r--r--testsuite/tests/backpack/should_compile/bkp15.stderr18
-rw-r--r--testsuite/tests/backpack/should_compile/bkp46.bkp32
-rw-r--r--testsuite/tests/backpack/should_compile/bkp46.stderr12
-rw-r--r--testsuite/tests/backpack/should_compile/bkp47.bkp20
-rw-r--r--testsuite/tests/backpack/should_compile/bkp47.stderr12
-rw-r--r--testsuite/tests/backpack/should_fail/all.T3
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail39.bkp6
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail40.bkp5
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail40.stderr6
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail41.bkp13
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail41.stderr22
-rw-r--r--testsuite/tests/rename/should_fail/rnfail055.stderr1
20 files changed, 259 insertions, 52 deletions
diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs
index 0a95849646..ea3eb54b2a 100644
--- a/compiler/backpack/RnModIface.hs
+++ b/compiler/backpack/RnModIface.hs
@@ -304,10 +304,11 @@ rnIfaceGlobal n = do
]
Just n' -> return n'
--- | Rename a DFun name. Here is where we ensure that DFuns have the correct
--- module as described in Note [Bogus DFun renamings].
-rnIfaceDFun :: Name -> ShIfM Name
-rnIfaceDFun name = do
+-- | Rename an implicit name, e.g., a DFun or default method.
+-- Here is where we ensure that DFuns have the correct module as described in
+-- Note [Bogus DFun renamings].
+rnIfaceImplicit :: Name -> ShIfM Name
+rnIfaceImplicit name = do
hmap <- getHoleSubst
dflags <- getDynFlags
iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv
@@ -385,7 +386,7 @@ rnIfaceClsInst cls_inst = do
-- mentions DFuns since they are implicitly exported. See
-- Note [Signature merging DFuns]) The important thing is that it's
-- consistent everywhere.
- dfun <- rnIfaceDFun (ifDFun cls_inst)
+ dfun <- rnIfaceImplicit (ifDFun cls_inst)
return cls_inst { ifInstCls = n
, ifInstTys = tys
, ifDFun = dfun
@@ -408,8 +409,10 @@ rnIfaceDecl' (fp, decl) = (,) fp <$> rnIfaceDecl decl
rnIfaceDecl :: Rename IfaceDecl
rnIfaceDecl d@IfaceId{} = do
name <- case ifIdDetails d of
- IfDFunId -> rnIfaceDFun (ifName d)
- _ -> rnIfaceGlobal (ifName d)
+ IfDFunId -> rnIfaceImplicit (ifName d)
+ _ | isDefaultMethodOcc (occName (ifName d))
+ -> rnIfaceImplicit (ifName d)
+ | otherwise -> rnIfaceGlobal (ifName d)
ty <- rnIfaceType (ifType d)
details <- rnIfaceIdDetails (ifIdDetails d)
info <- rnIfaceIdInfo (ifIdInfo d)
diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs
index 182166e65f..0de9801117 100644
--- a/compiler/basicTypes/OccName.hs
+++ b/compiler/basicTypes/OccName.hs
@@ -57,7 +57,7 @@ module OccName (
isDerivedOccName,
mkDataConWrapperOcc, mkWorkerOcc,
mkMatcherOcc, mkBuilderOcc,
- mkDefaultMethodOcc,
+ mkDefaultMethodOcc, isDefaultMethodOcc,
mkNewTyCoOcc, mkClassOpAuxOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
mkClassDataConOcc, mkDictOcc, mkIPOcc,
@@ -595,6 +595,12 @@ isDerivedOccName occ =
c:':':_ | isAlphaNum c -> True -- E.g. N:blah newtype coercions
_other -> False
+isDefaultMethodOcc :: OccName -> Bool
+isDefaultMethodOcc occ =
+ case occNameString occ of
+ '$':'d':'m':_ -> True
+ _ -> False
+
mkDataConWrapperOcc, mkWorkerOcc,
mkMatcherOcc, mkBuilderOcc,
mkDefaultMethodOcc,
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 123b02fc81..d5cc860b64 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -71,6 +71,7 @@ import FastString
import BasicTypes hiding ( SuccessFlag(..) )
import ListSetOps
import GHC.Fingerprint
+import qualified BooleanFormula as BF
import Data.List
import Control.Monad
@@ -212,10 +213,23 @@ mergeIfaceDecl :: IfaceDecl -> IfaceDecl -> IfaceDecl
mergeIfaceDecl d1 d2
| isAbstractIfaceDecl d1 = d2
| isAbstractIfaceDecl d2 = d1
+ | IfaceClass{ ifSigs = ops1, ifMinDef = bf1 } <- d1
+ , IfaceClass{ ifSigs = ops2, ifMinDef = bf2 } <- d2
+ = let ops = nameEnvElts $
+ plusNameEnv_C mergeIfaceClassOp
+ (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops1 ])
+ (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ])
+ in d1 { ifSigs = ops
+ , ifMinDef = BF.mkOr [noLoc bf1, noLoc bf2]
+ }
-- It doesn't matter; we'll check for consistency later when
-- we merge, see 'mergeSignatures'
| otherwise = d1
+mergeIfaceClassOp :: IfaceClassOp -> IfaceClassOp -> IfaceClassOp
+mergeIfaceClassOp op1@(IfaceClassOp _ _ (Just _)) _ = op1
+mergeIfaceClassOp _ op2 = op2
+
-- | Merge two 'OccEnv's of 'IfaceDecl's by 'OccName'.
mergeIfaceDecls :: OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
mergeIfaceDecls = plusOccEnv_C mergeIfaceDecl
diff --git a/compiler/typecheck/TcClassDcl.hs b/compiler/typecheck/TcClassDcl.hs
index c5a4c3aab3..716aed36b3 100644
--- a/compiler/typecheck/TcClassDcl.hs
+++ b/compiler/typecheck/TcClassDcl.hs
@@ -29,6 +29,7 @@ import TcMType
import Type ( getClassPredTys_maybe, piResultTys )
import TcType
import TcRnMonad
+import DriverPhases (HscSource(..))
import BuildTyCl( TcMethInfo )
import Class
import Coercion ( pprCoAxiom )
@@ -95,6 +96,10 @@ Death to "ExpandingDicts".
************************************************************************
-}
+illegalHsigDefaultMethod :: Name -> SDoc
+illegalHsigDefaultMethod n =
+ text "Illegal default method(s) in class definition of" <+> ppr n <+> text "in hsig file"
+
tcClassSigs :: Name -- Name of the class
-> [LSig Name]
-> LHsBinds Name
@@ -113,9 +118,19 @@ tcClassSigs clas sigs def_methods
| n <- dm_bind_names, not (n `elemNameSet` op_names) ]
-- Value binding for non class-method (ie no TypeSig)
- ; sequence_ [ failWithTc (badGenericMethod clas n)
- | (n,_) <- gen_dm_prs, not (n `elem` dm_bind_names) ]
- -- Generic signature without value binding
+ ; tcg_env <- getGblEnv
+ ; if tcg_src tcg_env == HsigFile
+ then
+ -- Error if we have value bindings
+ -- (Generic signatures without value bindings indicate
+ -- that a default of this form is expected to be
+ -- provided.)
+ when (not (null def_methods)) $
+ failWithTc (illegalHsigDefaultMethod clas)
+ else
+ -- Error for each generic signature without value binding
+ sequence_ [ failWithTc (badGenericMethod clas n)
+ | (n,_) <- gen_dm_prs, not (n `elem` dm_bind_names) ]
; traceTc "tcClassSigs 2" (ppr clas)
; return op_info }
@@ -289,8 +304,12 @@ tcClassMinimalDef _clas sigs op_info
-- That is, the given mindef should at least ensure that the
-- class ops without default methods are required, since we
-- have no way to fill them in otherwise
- whenIsJust (isUnsatisfied (mindef `impliesAtom`) defMindef) $
- (\bf -> addWarnTc NoReason (warningMinimalDefIncomplete bf))
+ tcg_env <- getGblEnv
+ -- However, only do this test when it's not an hsig file,
+ -- since you can't write a default implementation.
+ when (tcg_src tcg_env /= HsigFile) $
+ whenIsJust (isUnsatisfied (mindef `impliesAtom`) defMindef) $
+ (\bf -> addWarnTc NoReason (warningMinimalDefIncomplete bf))
return mindef
where
-- By default require all methods without a default implementation
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index a1b559c176..4c44eecfd9 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -66,6 +66,7 @@ import TcExpr
import TcRnMonad
import TcRnExports
import TcEvidence
+import qualified BooleanFormula as BF
import PprTyThing( pprTyThing )
import MkIface( tyThingToIfaceDecl )
import Coercion( pprCoAxiom )
@@ -905,9 +906,13 @@ checkBootTyCon is_boot tc1 tc2
check (eqTypeX env op_ty1 op_ty2)
(text "The types of" <+> pname1 <+>
text "are different") `andThenCheck`
- check (eqMaybeBy eqDM def_meth1 def_meth2)
- (text "The default methods associated with" <+> pname1 <+>
- text "are different")
+ if is_boot
+ then check (eqMaybeBy eqDM def_meth1 def_meth2)
+ (text "The default methods associated with" <+> pname1 <+>
+ text "are different")
+ else check (subDM op_ty1 def_meth1 def_meth2)
+ (text "The default methods associated with" <+> pname1 <+>
+ text "are not compatible")
where
name1 = idName id1
name2 = idName id2
@@ -927,6 +932,26 @@ checkBootTyCon is_boot tc1 tc2
eqDM (_, GenericDM t1) (_, GenericDM t2) = eqTypeX env t1 t2
eqDM _ _ = False
+ -- NB: first argument is from hsig, second is from real impl.
+ -- Order of pattern matching matters.
+ subDM _ Nothing _ = True
+ subDM _ _ Nothing = False
+ -- If the hsig wrote:
+ --
+ -- f :: a -> a
+ -- default f :: a -> a
+ --
+ -- this should be validly implementable using an old-fashioned
+ -- vanilla default method.
+ subDM t1 (Just (_, GenericDM t2)) (Just (_, VanillaDM))
+ = eqTypeX env t1 t2
+ -- This case can occur when merging signatures
+ subDM t1 (Just (_, VanillaDM)) (Just (_, GenericDM t2))
+ = eqTypeX env t1 t2
+ subDM _ (Just (_, VanillaDM)) (Just (_, VanillaDM)) = True
+ subDM _ (Just (_, GenericDM t1)) (Just (_, GenericDM t2))
+ = eqTypeX env t1 t2
+
-- Ignore the location of the defaults
eqATDef Nothing Nothing = True
eqATDef (Just (ty1, _loc1)) (Just (ty2, _loc2)) = eqTypeX env ty1 ty2
@@ -948,7 +973,9 @@ checkBootTyCon is_boot tc1 tc2
check (eqListBy (eqTypeX env) sc_theta1 sc_theta2)
(text "The class constraints do not match") `andThenCheck`
checkListBy eqSig op_stuff1 op_stuff2 (text "methods") `andThenCheck`
- checkListBy eqAT ats1 ats2 (text "associated types")
+ checkListBy eqAT ats1 ats2 (text "associated types") `andThenCheck`
+ check (classMinimalDef c1 `BF.implies` classMinimalDef c2)
+ (text "The MINIMAL pragmas are not compatible")
| Just syn_rhs1 <- synTyConRhs_maybe tc1
, Just syn_rhs2 <- synTyConRhs_maybe tc2
diff --git a/compiler/utils/BooleanFormula.hs b/compiler/utils/BooleanFormula.hs
index 1509321e62..43a71f0080 100644
--- a/compiler/utils/BooleanFormula.hs
+++ b/compiler/utils/BooleanFormula.hs
@@ -23,6 +23,8 @@ import MonadUtils
import Outputable
import Binary
import SrcLoc
+import Unique
+import UniqSet
----------------------------------------------------------------------
-- Boolean formula type and smart constructors
@@ -157,11 +159,36 @@ And xs `impliesAtom` y = any (\x -> (unLoc x) `impliesAtom` y) xs
Or xs `impliesAtom` y = all (\x -> (unLoc x) `impliesAtom` y) xs
Parens x `impliesAtom` y = (unLoc x) `impliesAtom` y
-implies :: Eq a => BooleanFormula a -> BooleanFormula a -> Bool
-x `implies` Var y = x `impliesAtom` y
-x `implies` And ys = all (implies x . unLoc) ys
-x `implies` Or ys = any (implies x . unLoc) ys
-x `implies` Parens y = x `implies` (unLoc y)
+implies :: Uniquable a => BooleanFormula a -> BooleanFormula a -> Bool
+implies e1 e2 = go (Clause emptyUniqSet [e1]) (Clause emptyUniqSet [e2])
+ where
+ go :: Uniquable a => Clause a -> Clause a -> Bool
+ go l@Clause{ clauseExprs = hyp:hyps } r =
+ case hyp of
+ Var x | memberClauseAtoms x r -> True
+ | otherwise -> go (extendClauseAtoms l x) { clauseExprs = hyps } r
+ Parens hyp' -> go l { clauseExprs = unLoc hyp':hyps } r
+ And hyps' -> go l { clauseExprs = map unLoc hyps' ++ hyps } r
+ Or hyps' -> all (\hyp' -> go l { clauseExprs = unLoc hyp':hyps } r) hyps'
+ go l r@Clause{ clauseExprs = con:cons } =
+ case con of
+ Var x | memberClauseAtoms x l -> True
+ | otherwise -> go l (extendClauseAtoms r x) { clauseExprs = cons }
+ Parens con' -> go l r { clauseExprs = unLoc con':cons }
+ And cons' -> all (\con' -> go l r { clauseExprs = unLoc con':cons }) cons'
+ Or cons' -> go l r { clauseExprs = map unLoc cons' ++ cons }
+ go _ _ = False
+
+-- A small sequent calculus proof engine.
+data Clause a = Clause {
+ clauseAtoms :: UniqSet a,
+ clauseExprs :: [BooleanFormula a]
+ }
+extendClauseAtoms :: Uniquable a => Clause a -> a -> Clause a
+extendClauseAtoms c x = c { clauseAtoms = addOneToUniqSet (clauseAtoms c) x }
+
+memberClauseAtoms :: Uniquable a => a -> Clause a -> Bool
+memberClauseAtoms x c = x `elementOfUniqSet` clauseAtoms c
----------------------------------------------------------------------
-- Pretty printing
diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T
index f38e364a61..3525a8521f 100644
--- a/testsuite/tests/backpack/should_compile/all.T
+++ b/testsuite/tests/backpack/should_compile/all.T
@@ -37,3 +37,5 @@ test('bkp42', normal, backpack_compile, [''])
test('bkp43', normal, backpack_compile, [''])
test('bkp44', normal, backpack_compile, [''])
test('bkp45', normal, backpack_compile, [''])
+test('bkp46', normal, backpack_compile, [''])
+test('bkp47', normal, backpack_compile, [''])
diff --git a/testsuite/tests/backpack/should_compile/bkp15.bkp b/testsuite/tests/backpack/should_compile/bkp15.bkp
index 94678af234..c661eafe6f 100644
--- a/testsuite/tests/backpack/should_compile/bkp15.bkp
+++ b/testsuite/tests/backpack/should_compile/bkp15.bkp
@@ -15,13 +15,9 @@ unit p where
class Eq a => Bloop a b | a -> b where
data GMap a (v :: * -> *) :: *
xa :: a -> a -> Bool
- -- TODO: Putting default definitions in the signature file
- -- causes references to DFuns, which we choke on. These should
- -- be disallowed.
- -- xa = (==)
+ default xa :: a -> a -> Bool
y :: a -> a -> Ordering
- -- default y :: Ord a => a -> a -> Ordering
- -- y = compare
+ default y :: Ord a => a -> a -> Ordering
{-# MINIMAL xa | y #-}
-- type instance Elem Int = Bool
-- pattern Blub n = ("foo", n)
@@ -40,10 +36,9 @@ unit q where
class Eq a => Bloop a b | a -> b where
data GMap a (v :: * -> *) :: *
xa :: a -> a -> Bool
- -- xa = (==)
+ default xa :: a -> a -> Bool
y :: a -> a -> Ordering
- -- default y :: Ord a => a -> a -> Ordering
- -- y = compare
+ default y :: Ord a => a -> a -> Ordering
{-# MINIMAL xa | y #-}
-- type instance Elem Int = Bool
-- pattern Blub n = ("foo", n)
@@ -76,10 +71,10 @@ unit h-impl where
class Eq a => Bloop a b | a -> b where
data GMap a (v :: * -> *) :: *
xa :: a -> a -> Bool
- -- xa = (==)
+ xa = (==)
y :: a -> a -> Ordering
- -- default y :: Ord a => a -> a -> Ordering
- -- y = compare
+ default y :: Ord a => a -> a -> Ordering
+ y = compare
{-# MINIMAL xa | y #-}
unit s where
dependency r[H=h-impl:H]
diff --git a/testsuite/tests/backpack/should_compile/bkp15.stderr b/testsuite/tests/backpack/should_compile/bkp15.stderr
index 041b7fe4b8..904ab2d4cb 100644
--- a/testsuite/tests/backpack/should_compile/bkp15.stderr
+++ b/testsuite/tests/backpack/should_compile/bkp15.stderr
@@ -3,32 +3,14 @@ bkp15.bkp:1:26: warning:
-XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
[1 of 5] Processing p
[1 of 1] Compiling H[sig] ( p/H.hsig, nothing )
-
-bkp15.bkp:15:9: warning:
- • The MINIMAL pragma does not require:
- ‘xa’ and ‘y’
- but there is no default implementation.
- • In the class declaration for ‘Bloop’
[2 of 5] Processing q
[1 of 1] Compiling H[sig] ( q/H.hsig, nothing )
-
-bkp15.bkp:40:9: warning:
- • The MINIMAL pragma does not require:
- ‘xa’ and ‘y’
- but there is no default implementation.
- • In the class declaration for ‘Bloop’
[3 of 5] Processing r
[1 of 2] Compiling H[sig] ( r/H.hsig, nothing )
[2 of 2] Compiling M ( r/M.hs, nothing )
[4 of 5] Processing h-impl
Instantiating h-impl
[1 of 1] Compiling H ( h-impl/H.hs, bkp15.out/h-impl/H.o )
-
-bkp15.bkp:76:9: warning:
- • The MINIMAL pragma does not require:
- ‘xa’ and ‘y’
- but there is no default implementation.
- • In the class declaration for ‘Bloop’
[5 of 5] Processing s
Instantiating s
[1 of 1] Including r[H=h-impl:H]
diff --git a/testsuite/tests/backpack/should_compile/bkp46.bkp b/testsuite/tests/backpack/should_compile/bkp46.bkp
new file mode 100644
index 0000000000..6d054fe2e2
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp46.bkp
@@ -0,0 +1,32 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# OPTIONS_GHC -O #-}
+unit p where
+ signature A where
+ class C a where
+ f :: a -> a
+ class D a where
+ g :: a
+ default g :: a
+ class E a where
+ h :: a -> String
+ default h :: Show a => a -> String
+ module B where
+ class X a where
+ i :: String -> a
+ default i :: Read a => String -> a
+ i = read
+ instance X Int where
+unit i where
+ module A where
+ class C a where
+ f :: a -> a
+ f x = x
+ class D a where
+ g :: a
+ g = undefined
+ class E a where
+ h :: a -> String
+ default h :: Show a => a -> String
+ h = show
+unit m where
+ dependency p[A=i:A]
diff --git a/testsuite/tests/backpack/should_compile/bkp46.stderr b/testsuite/tests/backpack/should_compile/bkp46.stderr
new file mode 100644
index 0000000000..220eb96ab3
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp46.stderr
@@ -0,0 +1,12 @@
+[1 of 3] Processing p
+ [1 of 2] Compiling A[sig] ( p/A.hsig, nothing )
+ [2 of 2] Compiling B ( p/B.hs, nothing )
+[2 of 3] Processing i
+ Instantiating i
+ [1 of 1] Compiling A ( i/A.hs, bkp46.out/i/A.o )
+[3 of 3] Processing m
+ Instantiating m
+ [1 of 1] Including p[A=i:A]
+ Instantiating p[A=i:A]
+ [1 of 2] Compiling A[sig] ( p/A.hsig, bkp46.out/p/p-CtJxD03mJqIIVJzOga8l4X/A.o )
+ [2 of 2] Compiling B ( p/B.hs, bkp46.out/p/p-CtJxD03mJqIIVJzOga8l4X/B.o )
diff --git a/testsuite/tests/backpack/should_compile/bkp47.bkp b/testsuite/tests/backpack/should_compile/bkp47.bkp
new file mode 100644
index 0000000000..76653f070e
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp47.bkp
@@ -0,0 +1,20 @@
+{-# LANGUAGE DefaultSignatures #-}
+unit p where
+ signature A where
+ class C a where
+ f :: a -> a
+ g :: a -> a
+ {-# MINIMAL f #-}
+unit q where
+ signature A where
+ class C a where
+ f :: a -> a
+ g :: a -> a
+ {-# MINIMAL g #-}
+unit r where
+ dependency p[A=<A>]
+ dependency q[A=<A>]
+ module B where
+ import A
+ instance C Int where
+ -- Warns!
diff --git a/testsuite/tests/backpack/should_compile/bkp47.stderr b/testsuite/tests/backpack/should_compile/bkp47.stderr
new file mode 100644
index 0000000000..0cc25d58c1
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp47.stderr
@@ -0,0 +1,12 @@
+[1 of 3] Processing p
+ [1 of 1] Compiling A[sig] ( p/A.hsig, nothing )
+[2 of 3] Processing q
+ [1 of 1] Compiling A[sig] ( q/A.hsig, nothing )
+[3 of 3] Processing r
+ [1 of 2] Compiling A[sig] ( r/A.hsig, nothing )
+ [2 of 2] Compiling B ( r/B.hs, nothing )
+
+bkp47.bkp:19:18: warning: [-Wmissing-methods (in -Wdefault)]
+ • No explicit implementation for
+ either ‘f’ or ‘g’
+ • In the instance declaration for ‘C Int’
diff --git a/testsuite/tests/backpack/should_fail/all.T b/testsuite/tests/backpack/should_fail/all.T
index 937d0c8e03..c24fa25f3b 100644
--- a/testsuite/tests/backpack/should_fail/all.T
+++ b/testsuite/tests/backpack/should_fail/all.T
@@ -34,3 +34,6 @@ test('bkpfail35', normal, backpack_compile_fail, [''])
test('bkpfail36', normal, backpack_compile_fail, [''])
test('bkpfail37', normal, backpack_compile_fail, [''])
test('bkpfail38', normal, backpack_compile_fail, [''])
+test('bkpfail39', expect_broken(13068), backpack_compile_fail, [''])
+test('bkpfail40', normal, backpack_compile_fail, [''])
+test('bkpfail41', normal, backpack_compile_fail, [''])
diff --git a/testsuite/tests/backpack/should_fail/bkpfail39.bkp b/testsuite/tests/backpack/should_fail/bkpfail39.bkp
new file mode 100644
index 0000000000..8676193c68
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail39.bkp
@@ -0,0 +1,6 @@
+unit p where
+ signature A where
+ class C a
+ module B where
+ import A
+ instance C Int where
diff --git a/testsuite/tests/backpack/should_fail/bkpfail40.bkp b/testsuite/tests/backpack/should_fail/bkpfail40.bkp
new file mode 100644
index 0000000000..f06de4d4d2
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail40.bkp
@@ -0,0 +1,5 @@
+unit p where
+ signature A where
+ class C a where
+ f :: a -> a
+ f x = x
diff --git a/testsuite/tests/backpack/should_fail/bkpfail40.stderr b/testsuite/tests/backpack/should_fail/bkpfail40.stderr
new file mode 100644
index 0000000000..a2f36dfa8e
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail40.stderr
@@ -0,0 +1,6 @@
+[1 of 1] Processing p
+ [1 of 1] Compiling A[sig] ( p/A.hsig, nothing )
+
+bkpfail40.bkp:3:9: error:
+ • Illegal default method(s) in class definition of C in hsig file
+ • In the class declaration for ‘C’
diff --git a/testsuite/tests/backpack/should_fail/bkpfail41.bkp b/testsuite/tests/backpack/should_fail/bkpfail41.bkp
new file mode 100644
index 0000000000..a8e7f596d2
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail41.bkp
@@ -0,0 +1,13 @@
+{-# LANGUAGE DefaultSignatures #-}
+unit p where
+ signature A where
+ class C a where
+ f :: a -> a
+ default f :: a -> a
+ signature B where
+unit i where
+ module A where
+ class C a where
+ f :: a -> a
+unit r where
+ dependency p[A=i:A,B=<B>]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail41.stderr b/testsuite/tests/backpack/should_fail/bkpfail41.stderr
new file mode 100644
index 0000000000..9a1b4218e0
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail41.stderr
@@ -0,0 +1,22 @@
+[1 of 3] Processing p
+ [1 of 2] Compiling A[sig] ( p/A.hsig, nothing )
+ [2 of 2] Compiling B[sig] ( p/B.hsig, nothing )
+[2 of 3] Processing i
+ Instantiating i
+ [1 of 1] Compiling A ( i/A.hs, bkpfail41.out/i/A.o )
+[3 of 3] Processing r
+ [1 of 1] Compiling B[sig] ( r/B.hsig, nothing )
+
+bkpfail41.bkp:10:9: error:
+ • Class ‘C’ has conflicting definitions in the module
+ and its hsig file
+ Main module: class C a where
+ f :: a -> a
+ {-# MINIMAL f #-}
+ Hsig file: class C a where
+ f :: a -> a
+ default f :: a -> a
+ The methods do not match:
+ The default methods associated with ‘f’ are not compatible
+ The MINIMAL pragmas are not compatible
+ • while checking that i:A implements signature A in p[A=i:A,B=<B>]
diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr
index e7e6a3a817..7fc5d80bad 100644
--- a/testsuite/tests/rename/should_fail/rnfail055.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail055.stderr
@@ -93,6 +93,7 @@ RnFail055.hs-boot:28:1: error:
m2 :: a -> b
{-# MINIMAL m2 #-}
The methods do not match: There are different numbers of methods
+ The MINIMAL pragmas are not compatible
RnFail055.hs-boot:29:1: error:
Class ‘C3’ has conflicting definitions in the module