From 6998772043a7f0b0360116eb5ffcbaa5630b21fb Mon Sep 17 00:00:00 2001
From: "Edward Z. Yang" <ezyang@fb.com>
Date: Sun, 29 Oct 2017 20:15:07 -0400
Subject: [PATCH] Make use of boot TyThings during typechecking.
Summary:
Suppose that you are typechecking A.hs, which transitively imports,
via B.hs, A.hs-boot. When we poke on B.hs and discover that it
has a reference to a type from A, what TyThing should we wire
it up with? Clearly, if we have already typechecked A, we
should use the most up-to-date TyThing: the one we freshly
generated when we typechecked A. But what if we haven't typechecked
it yet?
For the longest time, GHC adopted the policy that this was
*an error condition*; that you MUST NEVER poke on B.hs's reference
to a thing defined in A.hs until A.hs has gotten around to checking
this. However, actually ensuring this is the case has proven
to be a bug farm. The problem was especially poignant with
type family consistency checks, which eagerly happen before
any typechecking takes place.
This patch takes a different strategy: if we ever try to access
an entity from A which doesn't exist, we just fall back on the
definition of A from the hs-boot file. This means that you may
end up with a mix of A.hs and A.hs-boot TyThings during the
course of typechecking.
Signed-off-by: Edward Z. Yang <ezyang@fb.com>
Test Plan: validate
Reviewers: simonpj, bgamari, austin, goldfire
Subscribers: thomie, rwbarton
GHC Trac Issues: #14396
Differential Revision: https://phabricator.haskell.org/D4154
---
compiler/iface/TcIface.hs | 65 +++++++---
compiler/rename/RnSource.hs | 120 ------------------
compiler/typecheck/FamInst.hs | 78 +++---------
compiler/typecheck/TcRnDriver.hs | 4 +-
compiler/typecheck/TcRnMonad.hs | 1 -
compiler/typecheck/TcRnTypes.hs | 7 -
compiler/typecheck/TcTyClsDecls.hs | 4 -
.../tests/typecheck/should_compile/T14396.hs | 4 +
.../typecheck/should_compile/T14396.hs-boot | 2 +
.../tests/typecheck/should_compile/T14396a.hs | 5 +
.../tests/typecheck/should_compile/T14396b.hs | 4 +
.../tests/typecheck/should_compile/T14396f.hs | 3 +
.../tests/typecheck/should_compile/all.T | 1 +
.../tests/typecheck/should_fail/T12042.stderr | 10 +-
14 files changed, 87 insertions(+), 221 deletions(-)
create mode 100644 testsuite/tests/typecheck/should_compile/T14396.hs
create mode 100644 testsuite/tests/typecheck/should_compile/T14396.hs-boot
create mode 100644 testsuite/tests/typecheck/should_compile/T14396a.hs
create mode 100644 testsuite/tests/typecheck/should_compile/T14396b.hs
create mode 100644 testsuite/tests/typecheck/should_compile/T14396f.hs
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index b41c94823d6c..1a2d737726cd 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -1714,13 +1714,13 @@ tcIfaceGlobal name
{ type_env <- setLclEnv () get_type_env -- yuk
; case lookupNameEnv type_env name of
Just thing -> return thing
- Nothing ->
- pprPanic "tcIfaceGlobal (local): not found"
- (ifKnotErr name (if_doc env) type_env)
+ -- See Note [Knot-tying fallback on boot]
+ Nothing -> via_external
}
- ; _ -> do
-
+ ; _ -> via_external }}
+ where
+ via_external = do
{ hsc_env <- getTopEnv
; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
; case mb_thing of {
@@ -1731,21 +1731,7 @@ tcIfaceGlobal name
; case mb_thing of
Failed err -> failIfM err
Succeeded thing -> return thing
- }}}}}
-
-ifKnotErr :: Name -> SDoc -> TypeEnv -> SDoc
-ifKnotErr name env_doc type_env = vcat
- [ text "You are in a maze of twisty little passages, all alike."
- , text "While forcing the thunk for TyThing" <+> ppr name
- , text "which was lazily initialized by" <+> env_doc <> text ","
- , text "I tried to tie the knot, but I couldn't find" <+> ppr name
- , text "in the current type environment."
- , text "If you are developing GHC, please read Note [Tying the knot]"
- , text "and Note [Type-checking inside the knot]."
- , text "Consider rebuilding GHC with profiling for a better stack trace."
- , hang (text "Contents of current type environment:")
- 2 (ppr type_env)
- ]
+ }}}
-- Note [Tying the knot]
-- ~~~~~~~~~~~~~~~~~~~~~
@@ -1760,11 +1746,50 @@ ifKnotErr name env_doc type_env = vcat
-- * Note [Knot-tying typecheckIface]
-- * Note [DFun knot-tying]
-- * Note [hsc_type_env_var hack]
+-- * Note [Knot-tying fallback on boot]
--
-- There is also a wiki page on the subject, see:
--
-- https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TyingTheKnot
+-- Note [Knot-tying fallback on boot]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Suppose that you are typechecking A.hs, which transitively imports,
+-- via B.hs, A.hs-boot. When we poke on B.hs and discover that it
+-- has a reference to a type T from A, what TyThing should we wire
+-- it up with? Clearly, if we have already typechecked T and
+-- added it into the type environment, we should go ahead and use that
+-- type. But what if we haven't typechecked it yet?
+--
+-- For the longest time, GHC adopted the policy that this was
+-- *an error condition*; that you MUST NEVER poke on B.hs's reference
+-- to a T defined in A.hs until A.hs has gotten around to kind-checking
+-- T and adding it to the env. However, actually ensuring this is the
+-- case has proven to be a bug farm, because it's really difficult to
+-- actually ensure this never happens. The problem was especially poignant
+-- with type family consistency checks, which eagerly happen before any
+-- typechecking takes place.
+--
+-- Today, we take a different strategy: if we ever try to access
+-- an entity from A which doesn't exist, we just fall back on the
+-- definition of A from the hs-boot file. This is complicated in
+-- its own way: it means that you may end up with a mix of A.hs and
+-- A.hs-boot TyThings during the course of typechecking. We don't
+-- think (and have not observed) any cases where this would cause
+-- problems, but the hypothetical situation one might worry about
+-- is something along these lines in Core:
+--
+-- case x of
+-- A -> e1
+-- B -> e2
+--
+-- If, when typechecking this, we find x :: T, and the T we are hooked
+-- up with is the abstract one from the hs-boot file, rather than the
+-- one defined in this module with constructors A and B. But it's hard
+-- to see how this could happen, especially because the reference to
+-- the constructor (A and B) means that GHC will always typecheck
+-- this expression *after* typechecking T.
+
tcIfaceTyConByName :: IfExtName -> IfL TyCon
tcIfaceTyConByName name
= do { thing <- tcIfaceGlobal name
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index b182382381bb..c0347c4d6b6c 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -1283,9 +1283,6 @@ rnTyClDecls tycl_ds
; instds_w_fvs <- mapM (wrapLocFstM rnSrcInstDecl) (tyClGroupInstDecls tycl_ds)
; role_annots <- rnRoleAnnots tc_names (tyClGroupRoleDecls tycl_ds)
- ; tycls_w_fvs <- addBootDeps tycls_w_fvs
- -- TBD must add_boot_deps to instds_w_fvs?
-
-- Do SCC analysis on the type/class decls
; rdr_env <- getGlobalRdrEnv
; let tycl_sccs = depAnalTyClDecls rdr_env tycls_w_fvs
@@ -1365,123 +1362,6 @@ getParent rdr_env n
Nothing -> n
-{- Note [Extra dependencies from .hs-boot files]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-This is a long story, so buckle in.
-
-**Dependencies via hs-boot files are not obvious.** Consider the following case:
-
-A.hs-boot
- module A where
- data A1
-
-B.hs
- module B where
- import {-# SOURCE #-} A
- type B1 = A1
-
-A.hs
- module A where
- import B
- data A2 = MkA2 B1
- data A1 = MkA1 A2
-
-Here A2 is really recursive (via B1), but we won't see that easily when
-doing dependency analysis when compiling A.hs. When we look at A2,
-we see that its free variables are simply B1, but without (recursively) digging
-into the definition of B1 will we see that it actually refers to A1 via an
-hs-boot file.
-
-**Recursive declarations, even those broken by an hs-boot file, need to
-be type-checked together.** Whenever we refer to a declaration via
-an hs-boot file, we must be careful not to force the TyThing too early:
-ala Note [Tying the knot] if we force the TyThing before we have
-defined it ourselves in the local type environment, GHC will error.
-
-Conservatively, then, it would make sense that we to typecheck A1
-and A2 from the previous example together, because the two types are
-truly mutually recursive through B1.
-
-If we are being clever, we might observe that while kind-checking
-A2, we don't actually need to force the TyThing for A1: B1
-independently records its kind, so there is no need to go "deeper".
-But then we are in an uncomfortable situation where we have
-constructed a TyThing for A2 before we have checked A1, and we
-have to be absolutely certain we don't force it too deeply until
-we get around to kind checking A1, which could be for a very long
-time.
-
-Indeed, with datatype promotion, we may very well need to look
-at the type of MkA2 before we have kind-checked A1: consider,
-
- data T = MkT (Proxy 'MkA2)
-
-To promote MkA2, we need to lift its type to the kind level.
-We never tested this, but it seems likely A1 would get poked
-at this point.
-
-**Here's what we do instead.** So it is expedient for us to
-make sure A1 and A2 are kind checked together in a loop.
-To ensure that our dependency analysis can catch this,
-we add a dependency:
-
- - from every local declaration
- - to everything that comes from this module's .hs-boot file
- (this is gotten from sb_tcs in the SelfBootInfo).
-
-In this case, we'll add an edges
-
- - from A1 to A2 (but that edge is there already)
- - from A2 to A1 (which is new)
-
-Well, not quite *every* declaration. Imagine module A
-above had another datatype declaration:
-
- data A3 = A3 Int
-
-Even though A3 has a dependency (on Int), all its dependencies are from things
-that live on other packages. Since we don't have mutual dependencies across
-packages, it is safe not to add the dependencies on the .hs-boot stuff to A2.
-
-Hence function nameIsHomePackageImport.
-
-Note that this is fairly conservative: it essentially implies that
-EVERY type declaration in this modules hs-boot file will be kind-checked
-together in one giant loop (and furthermore makes every other type
-in the module depend on this loop). This is perhaps less than ideal, because
-the larger a recursive group, the less polymorphism available (we
-cannot infer a type to be polymorphically instantiated while we
-are inferring its kind), but no one has hollered about this (yet!)
--}
-
-addBootDeps :: [(LTyClDecl GhcRn, FreeVars)]
- -> RnM [(LTyClDecl GhcRn, FreeVars)]
--- See Note [Extra dependencies from .hs-boot files]
-addBootDeps ds_w_fvs
- = do { tcg_env <- getGblEnv
- ; let this_mod = tcg_mod tcg_env
- boot_info = tcg_self_boot tcg_env
-
- add_boot_deps :: [(LTyClDecl GhcRn, FreeVars)]
- -> [(LTyClDecl GhcRn, FreeVars)]
- add_boot_deps ds_w_fvs
- = case boot_info of
- SelfBoot { sb_tcs = tcs } | not (isEmptyNameSet tcs)
- -> map (add_one tcs) ds_w_fvs
- _ -> ds_w_fvs
-
- add_one :: NameSet -> (LTyClDecl GhcRn, FreeVars)
- -> (LTyClDecl GhcRn, FreeVars)
- add_one tcs pr@(decl,fvs)
- | has_local_imports fvs = (decl, fvs `plusFV` tcs)
- | otherwise = pr
-
- has_local_imports fvs
- = nameSetAny (nameIsHomePackageImport this_mod) fvs
- ; return (add_boot_deps ds_w_fvs) }
-
-
-
{- ******************************************************
* *
Role annotations
diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index 9c91daafc4a9..94bc43f862ad 100644
--- a/compiler/typecheck/FamInst.hs
+++ b/compiler/typecheck/FamInst.hs
@@ -7,7 +7,6 @@ module FamInst (
checkFamInstConsistency, tcExtendLocalFamInstEnv,
tcLookupDataFamInst, tcLookupDataFamInst_maybe,
tcInstNewTyCon_maybe, tcTopNormaliseNewTypeTF_maybe,
- checkRecFamInstConsistency,
newFamInst,
-- * Injectivity
@@ -43,8 +42,6 @@ import Panic
import VarSet
import Bag( Bag, unionBags, unitBag )
import Control.Monad
-import NameEnv
-import Data.List
#include "HsVersions.h"
@@ -102,8 +99,7 @@ defined in the module M itself. This is a pairwise check, i.e., for
every pair of instances we must check that they are consistent.
- For family instances coming from `dep_finsts`, this is checked in
-checkFamInstConsistency, called from tcRnImports, and in
-checkRecFamInstConsistency, called from tcTyClGroup. See Note
+checkFamInstConsistency, called from tcRnImports. See Note
[Checking family instance consistency] for details on this check (and
in particular how we avoid having to do all these checks for every
module we compile).
@@ -276,16 +272,14 @@ This is basically the idea from #13092, comment:14.
-- This function doesn't check ALL instances for consistency,
-- only ones that aren't involved in recursive knot-tying
-- loops; see Note [Don't check hs-boot type family instances too early].
--- It returns a modified 'TcGblEnv' that has saved the
--- instances that need to be checked later; use 'checkRecFamInstConsistency'
--- to check those.
-- We don't need to check the current module, this is done in
-- tcExtendLocalFamInstEnv.
-- See Note [The type family instance consistency story].
-checkFamInstConsistency :: [Module] -> TcM TcGblEnv
+checkFamInstConsistency :: [Module] -> TcM ()
checkFamInstConsistency directlyImpMods
= do { dflags <- getDynFlags
; (eps, hpt) <- getEpsAndHpt
+ ; traceTc "checkFamInstConsistency" (ppr directlyImpMods)
; let { -- Fetch the iface of a given module. Must succeed as
-- all directly imported modules must already have been loaded.
modIface mod =
@@ -313,10 +307,7 @@ checkFamInstConsistency directlyImpMods
}
- ; pending_checks <- checkMany hpt_fam_insts modConsistent directlyImpMods
- ; tcg_env <- getGblEnv
- ; return tcg_env { tcg_pending_fam_checks
- = foldl' (plusNameEnv_C (++)) emptyNameEnv pending_checks }
+ ; checkMany hpt_fam_insts modConsistent directlyImpMods
}
where
-- See Note [Checking family instance optimization]
@@ -324,26 +315,24 @@ checkFamInstConsistency directlyImpMods
:: ModuleEnv FamInstEnv -- home package family instances
-> (Module -> [Module]) -- given A, modules checked when A was checked
-> [Module] -- modules to process
- -> TcM [NameEnv [([FamInst], FamInstEnv)]]
- checkMany hpt_fam_insts modConsistent mods = go [] emptyModuleSet mods []
+ -> TcM ()
+ checkMany hpt_fam_insts modConsistent mods = go [] emptyModuleSet mods
where
go :: [Module] -- list of consistent modules
-> ModuleSet -- set of consistent modules, same elements as the
-- list above
-> [Module] -- modules to process
- -> [NameEnv [([FamInst], FamInstEnv)]]
- -- accumulator for pending checks
- -> TcM [NameEnv [([FamInst], FamInstEnv)]]
- go _ _ [] pending = return pending
- go consistent consistent_set (mod:mods) pending = do
- pending' <- sequence
+ -> TcM ()
+ go _ _ [] = return ()
+ go consistent consistent_set (mod:mods) = do
+ sequence_
[ check hpt_fam_insts m1 m2
| m1 <- to_check_from_mod
-- loop over toCheckFromMod first, it's usually smaller,
-- it may even be empty
, m2 <- to_check_from_consistent
]
- go consistent' consistent_set' mods (pending' ++ pending)
+ go consistent' consistent_set' mods
where
mod_deps_consistent = modConsistent mod
mod_deps_consistent_set = mkModuleSet mod_deps_consistent
@@ -358,10 +347,7 @@ checkFamInstConsistency directlyImpMods
-- We could, but doing so means one of two things:
--
-- 1. When looping over the cartesian product we convert
- -- a set into a non-deterministicly ordered list - then
- -- tcg_pending_fam_checks will end up storing some
- -- non-deterministically ordered lists as well and
- -- we end up with non-local non-determinism. Which
+ -- a set into a non-deterministicly ordered list. Which
-- happens to be fine for interface file determinism
-- in this case, today, because the order only
-- determines the order of deferred checks. But such
@@ -434,12 +420,9 @@ checkFamInstConsistency directlyImpMods
-- import B
-- data T = MkT
--
- -- However, this is not yet done; see #13981.
- --
- -- Note that it is NOT necessary to defer for occurrences in the
- -- RHS (e.g., type instance F Int = T, in the above example),
- -- since that never participates in consistency checking
- -- in any nontrivial way.
+ -- In fact, it is even necessary to defer for occurrences in
+ -- the RHS, because we may test for *compatibility* in event
+ -- of an overlap.
--
-- Why don't we defer ALL of the checks to later? Well, many
-- instances aren't involved in the recursive loop at all. So
@@ -453,40 +436,11 @@ checkFamInstConsistency directlyImpMods
--
-- See also Note [Tying the knot] and Note [Type-checking inside the knot]
-- for why we are doing this at all.
- ; this_mod <- getModule
- -- NB: == this_mod only holds if there's an hs-boot file;
- -- otherwise we cannot possible see instances for families
- -- defined by the module we are compiling in imports.
- ; let shouldCheckNow = ((/= this_mod) . nameModule . fi_fam)
- (check_now, check_later) =
- partition shouldCheckNow (famInstEnvElts env1)
+ ; let check_now = famInstEnvElts env1
; mapM_ (checkForConflicts (emptyFamInstEnv, env2)) check_now
; mapM_ (checkForInjectivityConflicts (emptyFamInstEnv,env2)) check_now
- ; let check_later_map =
- extendNameEnvList_C (++) emptyNameEnv
- [(fi_fam finst, [finst]) | finst <- check_later]
- ; return (mapNameEnv (\xs -> [(xs, env2)]) check_later_map)
}
--- | Given a 'TyCon' that has been incorporated into the type
--- environment (the knot is tied), if it is a type family, check
--- that all deferred instances for it are consistent.
--- See Note [Don't check hs-boot type family instances too early]
-checkRecFamInstConsistency :: TyCon -> TcM ()
-checkRecFamInstConsistency tc = do
- tcg_env <- getGblEnv
- let checkConsistency tc
- | isFamilyTyCon tc
- , Just pairs <- lookupNameEnv (tcg_pending_fam_checks tcg_env)
- (tyConName tc)
- = forM_ pairs $ \(check_now, env2) -> do
- mapM_ (checkForConflicts (emptyFamInstEnv, env2)) check_now
- mapM_ (checkForInjectivityConflicts (emptyFamInstEnv,env2)) check_now
- | otherwise
- = return ()
- checkConsistency tc
-
-
getFamInsts :: ModuleEnv FamInstEnv -> Module -> TcM FamInstEnv
getFamInsts hpt_fam_insts mod
| Just env <- lookupModuleEnv hpt_fam_insts mod = return env
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index fd63effbe638..40b5efec8429 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -370,10 +370,10 @@ tcRnImports hsc_env import_decls
; let { dir_imp_mods = moduleEnvKeys
. imp_mods
$ imports }
- ; tcg_env <- checkFamInstConsistency dir_imp_mods ;
+ ; checkFamInstConsistency dir_imp_mods
; traceRn "rn1: } checking family instance consistency" empty
- ; return tcg_env } }
+ ; getGblEnv } }
{-
************************************************************************
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 5121fb571f50..5bc200c1a057 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -258,7 +258,6 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_type_env_var = type_env_var,
tcg_inst_env = emptyInstEnv,
tcg_fam_inst_env = emptyFamInstEnv,
- tcg_pending_fam_checks = emptyNameEnv,
tcg_ann_env = emptyAnnEnv,
tcg_th_used = th_var,
tcg_th_splice_used = th_splice_var,
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 5f7498fa163e..5f14b455ad74 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -527,13 +527,6 @@ data TcGblEnv
tcg_fam_inst_env :: FamInstEnv, -- ^ Ditto for family instances
tcg_ann_env :: AnnEnv, -- ^ And for annotations
- -- | Family instances we have to check for consistency.
- -- Invariant: each FamInst in the list's fi_fam matches the
- -- key of the entry in the 'NameEnv'. This gets consumed
- -- by 'checkRecFamInstConsistency'.
- -- See Note [Don't check hs-boot type family instances too early]
- tcg_pending_fam_checks :: NameEnv [([FamInst], FamInstEnv)],
-
-- Now a bunch of things about this module that are simply
-- accumulated, but never consulted until the end.
-- Nevertheless, it's convenient to accumulate them along
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index b6fe855efacb..f77a70b69ba5 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -162,10 +162,6 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds
; checkSynCycles this_uid tyclss tyclds
; traceTc "Done synonym cycle check" (ppr tyclss)
- ; traceTc "Starting family consistency check" (ppr tyclss)
- ; forM_ tyclss checkRecFamInstConsistency
- ; traceTc "Done family consistency" (ppr tyclss)
-
-- Step 2: Perform the validity check on those types/classes
-- We can do this now because we are done with the recursive knot
-- Do it before Step 3 (adding implicit things) because the latter
diff --git a/testsuite/tests/typecheck/should_compile/T14396.hs b/testsuite/tests/typecheck/should_compile/T14396.hs
new file mode 100644
index 000000000000..2d6c7061c309
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T14396.hs
@@ -0,0 +1,4 @@
+module T14396 where
+import T14396a
+import T14396b
+data S = S
diff --git a/testsuite/tests/typecheck/should_compile/T14396.hs-boot b/testsuite/tests/typecheck/should_compile/T14396.hs-boot
new file mode 100644
index 000000000000..d4fe8673c36a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T14396.hs-boot
@@ -0,0 +1,2 @@
+module T14396 where
+data S = S
diff --git a/testsuite/tests/typecheck/should_compile/T14396a.hs b/testsuite/tests/typecheck/should_compile/T14396a.hs
new file mode 100644
index 000000000000..28a276c7195c
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T14396a.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+module T14396a where
+import T14396f
+import {-# SOURCE #-} T14396(S)
+type instance F Int = S
diff --git a/testsuite/tests/typecheck/should_compile/T14396b.hs b/testsuite/tests/typecheck/should_compile/T14396b.hs
new file mode 100644
index 000000000000..aabf3f3dcccb
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T14396b.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE TypeFamilies #-}
+module T14396b where
+import T14396f
+type instance F Bool = Int
diff --git a/testsuite/tests/typecheck/should_compile/T14396f.hs b/testsuite/tests/typecheck/should_compile/T14396f.hs
new file mode 100644
index 000000000000..e6230fd11b42
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T14396f.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE TypeFamilies #-}
+module T14396f where
+type family F a
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 19a99db6290a..3c6ef7fb5a48 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -581,6 +581,7 @@ test('T14333', normal, compile, [''])
test('T14363', normal, compile, [''])
test('T14363a', normal, compile, [''])
test('T7169', normal, compile, [''])
+test('T14396', [extra_files(['T14396.hs', 'T14396.hs-boot', 'T14396a.hs', 'T14396b.hs', 'T14396f.hs'])], multimod_compile, ['T14396', '-v0'])
test('T14434', [], run_command, ['$MAKE -s --no-print-directory T14434'])
test('MissingExportList01', normal, compile, [''])
test('MissingExportList02', normal, compile, [''])
diff --git a/testsuite/tests/typecheck/should_fail/T12042.stderr b/testsuite/tests/typecheck/should_fail/T12042.stderr
index e9b139ca5775..3266a1fe11a4 100644
--- a/testsuite/tests/typecheck/should_fail/T12042.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12042.stderr
@@ -2,8 +2,8 @@
[2 of 3] Compiling T12042a ( T12042a.hs, T12042a.o )
[3 of 3] Compiling T12042 ( T12042.hs, T12042.o )
-T12042.hs:3:1: error:
- Cycle in type synonym declarations:
- T12042.hs:3:1-12: type S = R
- T12042a.hs:3:1-10: B.U from external module
- T12042.hs:4:1-12: type R = B.U
+T12042.hs-boot:2:1: error:
+ Type constructor ‘S’ has conflicting definitions in the module
+ and its hs-boot file
+ Main module: type S = R
+ Boot file: data S
--
GitLab