From bdf93da8cf8d92399e7a53a5cc3455bf15673876 Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Mon, 24 Mar 2025 11:25:12 +0100
Subject: [PATCH] Renamer: improve handling of export children
This commit refactors the 'childGREPriority' function which is used when
renaming subordinate items in export lists and class declarations.
Instead of having a complicated LookupChild parameter, we now simply pass the
GREInfo of the parent, which allows us to decide what is a valid child:
- classes can have children that are in the type constructor namespace,
- promoted data constructors should be treated the same as normal data
constructors.
Fixes #24027
---
compiler/GHC/Rename/Env.hs | 78 +++----
compiler/GHC/Tc/Gen/Export.hs | 27 +--
compiler/GHC/Types/Name/Reader.hs | 190 +++++++++---------
.../tests/rename/should_compile/T24027.hs | 6 +
.../tests/rename/should_compile/T24027_aux.hs | 4 +
testsuite/tests/rename/should_compile/all.T | 1 +
6 files changed, 158 insertions(+), 148 deletions(-)
create mode 100644 testsuite/tests/rename/should_compile/T24027.hs
create mode 100644 testsuite/tests/rename/should_compile/T24027_aux.hs
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index ba59e08ee97..287e6f4a873 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -411,7 +411,7 @@ lookupInstDeclBndr cls what_subordinate rdr
-- warnings when a deprecated class
-- method is defined. We only warn
-- when it's used
- cls what_subordinate rdr
+ (ParentGRE cls (IAmTyCon ClassFlavour)) what_subordinate rdr
; case mb_name of
Left err -> do { addErr (mkTcRnNotInScope rdr err)
; return (mkUnboundNameRdr rdr) }
@@ -681,25 +681,24 @@ lookupGlobalOccRn will find it.
-}
-- | Used in export lists to lookup the children.
-lookupSubBndrOcc_helper :: Bool -> DeprecationWarnings
- -> Name
- -> RdrName -- ^ thing we are looking up
- -> LookupChild -- ^ how to look it up (e.g. which
- -- 'NameSpace's to look in)
+lookupSubBndrOcc_helper :: Bool
+ -> DeprecationWarnings
+ -> ParentGRE -- ^ parent
+ -> RdrName -- ^ thing we are looking up
-> RnM ChildLookupResult
-lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
- | isUnboundName parent
+lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent_gre rdr_name
+ | isUnboundName (parentGRE_name parent_gre)
-- Avoid an error cascade
= return (FoundChild (mkUnboundGRERdr rdr_name))
| otherwise = do
gre_env <- getGlobalRdrEnv
- let original_gres = lookupGRE gre_env (LookupChildren (rdrNameOcc rdr_name) how_lkup)
+ let original_gres = lookupGRE gre_env (LookupChildren parent_gre (rdrNameOcc rdr_name) )
picked_gres = pick_gres original_gres
-- The remaining GREs are things that we *could* export here.
-- Note that this includes things which have `NoParent`;
-- those are sorted in `checkPatSynParent`.
- traceRn "parent" (ppr parent)
+ traceRn "parent" (ppr (parentGRE_name parent_gre))
traceRn "lookupExportChild original_gres:" (ppr original_gres)
traceRn "lookupExportChild picked_gres:" (ppr picked_gres $$ ppr must_have_parent)
case picked_gres of
@@ -735,12 +734,12 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
dup_fields_ok <- xoptM LangExt.DuplicateRecordFields
case original_gres of
[] -> return NameNotFound
- [g] -> return $ IncorrectParent parent g
+ [g] -> return $ IncorrectParent parent_gre g
[p | ParentIs p <- [greParent g]]
gss@(g:gss'@(_:_)) ->
if all isRecFldGRE gss && dup_fields_ok
then return $
- IncorrectParent parent g
+ IncorrectParent parent_gre g
[p | x <- gss, ParentIs p <- [greParent x]]
else mkNameClashErr $ g NE.:| gss'
@@ -750,22 +749,29 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
return (FoundChild (NE.head gres))
pick_gres :: [GlobalRdrElt] -> DisambigInfo
- -- For Unqual, find GREs that are in scope qualified or unqualified
- -- For Qual, find GREs that are in scope with that qualification
pick_gres gres
| isUnqual rdr_name
+ -- The child is not qualified: find GREs that are in scope, whether
+ -- qualified or unqualified, as per the Haskell 2010 report, 5.2.2:
+ --
+ -- - In all cases, the parent type constructor T must be in scope.
+ -- - A subordinate name is legal if and only if:
+ -- (a) it names a constructor or field of T, and
+ -- (b) the constructor or field is in scope, regardless of whether
+ -- it is in scope under a qualified or unqualified name.
= mconcat (map right_parent gres)
| otherwise
+ -- The child is qualified: find GREs that are in scope
+ -- with that qualification.
= mconcat (map right_parent (pickGREs rdr_name gres))
right_parent :: GlobalRdrElt -> DisambigInfo
right_parent gre
= case greParent gre of
ParentIs cur_parent
- | parent == cur_parent -> DisambiguatedOccurrence gre
+ | parentGRE_name parent_gre == cur_parent -> DisambiguatedOccurrence gre
| otherwise -> NoOccurrence
NoParent -> UniqueOccurrence gre
-{-# INLINEABLE lookupSubBndrOcc_helper #-}
-- | This domain specific datatype is used to record why we decided it was
-- possible that a GRE could be exported with a parent.
@@ -817,21 +823,21 @@ data ChildLookupResult
-- | We couldn't find a suitable name
= NameNotFound
-- | The child has an incorrect parent
- | IncorrectParent Name -- ^ parent
- GlobalRdrElt -- ^ child we were looking for
- [Name] -- ^ list of possible parents
+ | IncorrectParent ParentGRE -- ^ parent
+ GlobalRdrElt -- ^ child we were looking for
+ [Name] -- ^ list of possible parents
-- | We resolved to a child
| FoundChild GlobalRdrElt
instance Outputable ChildLookupResult where
ppr NameNotFound = text "NameNotFound"
ppr (FoundChild n) = text "Found:" <+> ppr (greParent n) <+> ppr n
- ppr (IncorrectParent p g ns)
+ ppr (IncorrectParent parent g ns)
= text "IncorrectParent"
- <+> hsep [ppr p, ppr $ greName g, ppr ns]
+ <+> hsep [ppr (parentGRE_name parent), ppr $ greName g, ppr ns]
lookupSubBndrOcc :: DeprecationWarnings
- -> Name -- Parent
+ -> ParentGRE
-> Subordinate
-> RdrName
-> RnM (Either NotInScopeError Name)
@@ -840,7 +846,7 @@ lookupSubBndrOcc :: DeprecationWarnings
lookupSubBndrOcc warn_if_deprec the_parent what_subordinate rdr_name =
lookupExactOrOrig rdr_name (Right . greName) $
-- This happens for built-in classes, see mod052 for example
- do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name what_lkup
+ do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name
; return $ case child of
FoundChild g -> Right (greName g)
NameNotFound -> Left unknown_sub
@@ -848,14 +854,10 @@ lookupSubBndrOcc warn_if_deprec the_parent what_subordinate rdr_name =
-- See [Mismatched class methods and associated type families]
-- in TcInstDecls.
where
- unknown_sub = UnknownSubordinate the_parent what_subordinate
- what_lkup = LookupChild { wantedParent = the_parent
- , lookupDataConFirst = False
- , prioritiseParent = True -- See T23664.
- }
-{-
-Note [Family instance binders]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ unknown_sub = UnknownSubordinate (parentGRE_name the_parent) what_subordinate
+
+{- Note [Family instance binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
data family F a
data instance F T = X1 | X2
@@ -1319,11 +1321,11 @@ We promote the namespace of RdrName and look up after that
(see the functions promotedRdrName and lookup_promoted).
In particular, we have the following error message
- • Illegal term-level use of the type constructor ‘Int’
- imported from ‘Prelude’ (and originally defined in ‘GHC.Types’)
- • In the first argument of ‘id’, namely ‘Int’
+ • Illegal term-level use of the type constructor ‘Int'
+ imported from ‘Prelude' (and originally defined in ‘GHC.Types')
+ • In the first argument of ‘id'
In the expression: id Int
- In an equation for ‘x’: x = id Int
+ In an equation for ‘x': x = id Int
when the user writes the following declaration
@@ -1896,7 +1898,7 @@ For example, writing `Data.List.sort` will load the interface file for
`Data.List` as if the user had written `import qualified Data.List`.
If we fail we just return Nothing, rather than bleating
-about "attempting to use module ‘D’ (./D.hs) which is not loaded"
+about "attempting to use module 'D' (./D.hs) which is not loaded"
which is what loadSrcInterface does.
It is enabled by default and disabled by the flag
@@ -2195,7 +2197,9 @@ lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns ns_spec
lookup_cls_op cls
= NE.singleton <$>
- lookupSubBndrOcc AllDeprecationWarnings cls MethodOfClass rdr_name
+ lookupSubBndrOcc AllDeprecationWarnings
+ (ParentGRE cls (IAmTyCon ClassFlavour))
+ MethodOfClass rdr_name
lookup_inst occ_env -- See Note [Signatures in instance decls]
= case lookupOccEnv occ_env occ of
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index 4c08dac9963..50635993006 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -564,8 +564,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
lookup_ie_kids_with :: GlobalRdrElt -> [LIEWrappedName GhcPs]
-> RnM ([LIEWrappedName GhcRn], [GlobalRdrElt])
lookup_ie_kids_with gre sub_rdrs =
- do { let name = greName gre
- ; kids <- lookupChildrenExport name sub_rdrs
+ do { kids <- lookupChildrenExport gre sub_rdrs
; return (map fst kids, map snd kids) }
lookup_ie_kids_all :: IE GhcPs -> LIEWrappedName GhcPs -> GlobalRdrElt
@@ -687,14 +686,14 @@ The Haskell 2010 report says in section 5.1:
>> An abbreviated form of module, consisting only of the module body, is
>> permitted. If this is used, the header is assumed to be
->> ‘module Main(main) where’.
+>> 'module Main(main) where'.
For modules without a module header, this is implemented the
following way:
If the module has a main function in scope:
Then create a module header and export the main function,
- as if a module header like ‘module Main(main) where...’ would exist.
+ as if a module header like 'module Main(main) where...' would exist.
This has the effect to mark the main function and all top level
functions called directly or indirectly via main as 'used',
and later on, unused top-level functions can be reported correctly.
@@ -708,7 +707,7 @@ If the module has NO main function:
In GHCi this has the effect, that we don't get any 'non-used' warnings.
In GHC, however, the 'has-main-module' check in GHC.Tc.Module.checkMain
fires, and we get the error:
- The IO action ‘main’ is not defined in module ‘Main’
+ The IO action 'main' is not defined in module 'Main'
-}
@@ -737,27 +736,21 @@ If the module has NO main function:
-lookupChildrenExport :: Name -> [LIEWrappedName GhcPs]
+lookupChildrenExport :: GlobalRdrElt
+ -> [LIEWrappedName GhcPs]
-> RnM ([(LIEWrappedName GhcRn, GlobalRdrElt)])
-lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items
+lookupChildrenExport parent_gre rdr_items = mapAndReportM doOne rdr_items
where
+ spec_parent = greName parent_gre
-- Process an individual child
doOne :: LIEWrappedName GhcPs
-> RnM (LIEWrappedName GhcRn, GlobalRdrElt)
doOne n = do
let bareName = (ieWrappedName . unLoc) n
- what_lkup :: LookupChild
- what_lkup =
- LookupChild
- { wantedParent = spec_parent
- , lookupDataConFirst = True
- , prioritiseParent = False -- See T11970.
- }
-
-- Do not report export list declaration deprecations
name <- lookupSubBndrOcc_helper False ExportDeprecationWarnings
- spec_parent bareName what_lkup
+ (ParentGRE spec_parent (greInfo parent_gre)) bareName
traceRn "lookupChildrenExport" (ppr name)
-- Default to data constructors for slightly better error
-- messages
@@ -776,7 +769,7 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items
do { checkPatSynParent spec_parent par child_nm
; return (replaceLWrappedName n child_nm, child)
}
- IncorrectParent p c gs -> failWithDcErr p (greName c) gs
+ IncorrectParent p c gs -> failWithDcErr (parentGRE_name p) (greName c) gs
-- Note [Typing Pattern Synonym Exports]
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index 8a9902c8b6d..06eea7e9f26 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -59,7 +59,6 @@ module GHC.Types.Name.Reader (
LookupGRE(..), lookupGRE,
WhichGREs(.., AllRelevantGREs, RelevantGREsFOS),
greIsRelevant,
- LookupChild(..),
lookupGRE_Name,
lookupGRE_FieldLabel,
@@ -98,7 +97,7 @@ module GHC.Types.Name.Reader (
fieldGRE_maybe, fieldGRELabel,
-- ** Parent information
- Parent(..), greParent_maybe,
+ Parent(..), ParentGRE(..), greParent_maybe,
mkParent, availParent,
ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
importSpecLoc, importSpecModule, isExplicitItem, bestImport,
@@ -1096,6 +1095,23 @@ allowGRE WantNormal gre
allowGRE WantField gre
= isRecFldGRE gre
+-- | A parent of a child, in contexts like import/export lists, class and
+-- instance declarations, etc.
+--
+-- Not simply a 'GlobalRdrElt', because we don't always have a full
+-- 'GlobalRdrElt' to hand (e.g. in 'GHC.Rename.Env.lookupInstDeclBndr').
+data ParentGRE
+ = ParentGRE
+ { parentGRE_name :: Name
+ , parentGRE_info :: GREInfo
+ }
+
+instance Outputable ParentGRE where
+ ppr (ParentGRE name info) = ppr name <+> parens (ppr info)
+
+instance Eq ParentGRE where
+ ParentGRE name1 _ == ParentGRE name2 _ = name1 == name2
+
-- | What should we look up in a 'GlobalRdrEnv'? Should we only look up
-- names with the exact same 'OccName', or do we allow different 'NameSpace's?
--
@@ -1136,11 +1152,9 @@ data LookupGRE info where
-- | Look up children 'GlobalRdrElt's with a given 'Parent'.
LookupChildren
- :: OccName -- ^ the 'OccName' to look up
- -> LookupChild
- -- ^ information to decide which 'GlobalRdrElt's
- -- are valid children after looking up
- -> LookupGRE info
+ :: ParentGRE -- ^ the parent
+ -> OccName -- ^ the child 'OccName' to look up
+ -> LookupGRE GREInfo
-- | How should we look up in a 'GlobalRdrEnv'?
-- Which 'NameSpace's are considered relevant for a given lookup?
@@ -1195,33 +1209,6 @@ pattern RelevantGREsFOS fos <- RelevantGREs { includeFieldSelectors = fos }
, lookupVariablesForFields = fos == WantBoth
, lookupTyConsAsWell = False }
-data LookupChild
- = LookupChild
- { wantedParent :: Name
- -- ^ the parent we are looking up children of
- , lookupDataConFirst :: Bool
- -- ^ for type constructors, should we look in the data constructor
- -- namespace first?
- , prioritiseParent :: Bool
- -- ^ should we prioritise getting the right 'Parent'?
- --
- -- - @True@: prioritise getting the right 'Parent'
- -- - @False@: prioritise getting the right 'NameSpace'
- --
- -- See Note [childGREPriority].
- }
-
-instance Outputable LookupChild where
- ppr (LookupChild { wantedParent = par
- , lookupDataConFirst = dc
- , prioritiseParent = prio_parent })
- = braces $ hsep
- [ text "LookupChild"
- , braces (text "parent:" <+> ppr par)
- , if dc then text "[dc_first]" else empty
- , if prio_parent then text "[prio_parent]" else empty
- ]
-
-- | After looking up something with the given 'NameSpace', is the resulting
-- 'GlobalRdrElt' we have obtained relevant, according to the 'RelevantGREs'
-- specification of which 'NameSpace's are relevant?
@@ -1270,69 +1257,64 @@ which have a given Parent. These are the two calls to lookupSubBndrOcc_helper:
class C a where { type (+++) :: a -> a ->; infixl 6 +++ }
(+++) :: Int -> Int -> Int; (+++) = (+)
-In these two situations, there are two competing metrics for finding the "best"
+In these two situations, there are two metrics for finding the "best"
'GlobalRdrElt' that a particular 'OccName' resolves to:
- does the resolved 'GlobalRdrElt' have the correct parent?
- does the resolved 'GlobalRdrElt' have the same 'NameSpace' as the 'OccName'?
-(A) and (B) have competing requirements.
+To resolve a children export item, we proceed by first prioritising GREs which
+have the correct parent, and then break ties by looking at 'NameSpace's.
-For the example of (A) above, we know that the child 'D' of 'T' must live
-in the data namespace, so we look up the OccName 'OccName DataName "D"' and
-prioritise the lookup results based on the 'NameSpace'.
-This means we get an error message of the form:
-
- The type constructor 'T' is not the parent of the data constructor 'D'.
-
-as opposed to the rather unhelpful and confusing:
-
- The type constructor 'T' is not the parent of the type constructor 'D'.
-
-See test case T11970.
-
-For the example of (B) above, the fixity declaration for +++ lies inside the
-class, so we should prioritise looking up 'GlobalRdrElt's whose parent is 'C'.
-Not doing so led to #23664.
+Test cases:
+ - T11970: pattern synonyms, classes etc
+ - T10816, T23664, T24037: fixity declarations for associated types
+ - T20427: promoted data constructors and TypeData
-}
-- | Scoring priority function for looking up children 'GlobalRdrElt'.
--
--- We score by 'Parent' and 'NameSpace', with higher priorities having lower
--- numbers. Which lexicographic order we use ('Parent' or 'NameSpace' first)
--- is determined by the first argument; see Note [childGREPriority].
-childGREPriority :: LookupChild -- ^ what kind of child do we want,
- -- e.g. what should its parent be?
- -> NameSpace -- ^ what 'NameSpace' are we originally looking in?
- -> GlobalRdrEltX info
- -- ^ the result of looking up; it might be in a different
- -- 'NameSpace', which is used to determine the score
- -- (in the first component)
+-- The returned score orders by 'Parent' first and then by 'NameSpace',
+-- with higher priorities having lower numbers.
+--
+-- See Note [childGREPriority].
+childGREPriority :: ParentGRE -- ^ wanted parent
+ -> NameSpace -- ^ what 'NameSpace' are we originally looking in?
+ -> GlobalRdrElt
+ -- ^ the result of looking up; it might be in a different
+ -- 'NameSpace', which is used to determine the score
+ -- (in the second component)
-> Maybe (Int, Int)
-childGREPriority (LookupChild { wantedParent = wanted_parent
- , lookupDataConFirst = try_dc_first
- , prioritiseParent = par_first })
- ns gre =
- case child_ns_prio $ greNameSpace gre of
- Nothing -> Nothing
- Just ns_prio ->
- let par_prio = parent_prio $ greParent gre
- in Just $ if par_first
- then (par_prio, ns_prio)
- else (ns_prio, par_prio)
- -- See Note [childGREPriority].
+childGREPriority (ParentGRE wanted_parent parent_info) wanted_ns child_gre =
+ (parent_prio, ) <$> child_ns_prio
where
+ child_ns = greNameSpace child_gre
+
+ -- Is the parent a class? Only class TyCons can have children that
+ -- are in the TcCls NameSpace (associated types).
+ is_class_parent =
+ case parent_info of
+ IAmTyCon ClassFlavour -> True
+ _ -> False
+
-- Pick out the possible 'NameSpace's in order of priority.
- child_ns_prio :: (NameSpace -> Maybe Int)
- child_ns_prio other_ns
- | other_ns == ns
+ child_ns_prio :: Maybe Int
+ child_ns_prio
+ | child_ns == wanted_ns
+
+ -- Is it OK to have a child in this NameSpace?
+ --
+ -- If it's in the TcCls NameSpace, then the parent must be a class,
+ -- unless the child is a promoted data constructor (which can happen
+ -- when exporting a TypeData declaration, see T20427).
+ , not (isTcClsNameSpace child_ns) || is_class_parent || child_is_data
= Just 0
- | isTermVarOrFieldNameSpace ns
- , isTermVarOrFieldNameSpace other_ns
+ | isTermVarOrFieldNameSpace wanted_ns
+ , isTermVarOrFieldNameSpace child_ns
= Just 0
- | isValNameSpace varName
- , other_ns == tcName
+ | isValNameSpace wanted_ns
+ , is_class_parent && isTcClsNameSpace child_ns
-- When looking up children, we sometimes want a value name
-- to resolve to a type constructor.
-- For example, for an infix declaration "infixr 3 +!" or "infix 2 `Fun`"
@@ -1342,18 +1324,38 @@ childGREPriority (LookupChild { wantedParent = wanted_parent
-- NameSpace, and "Fun" would be in the term-level data constructor
-- NameSpace. See tests T10816, T23664, T24037.
= Just 1
- | ns == tcName
- , other_ns == dataName
- , try_dc_first -- try data namespace before type/class namespace?
- = Just (-1)
+ | wanted_ns == tcName
+ , child_is_data
+ = Just $
+ -- For classes we de-prioritise data constructors;
+ -- otherwise we prioritise them.
+ if is_class_parent
+ then 1
+ else -1
| otherwise
= Nothing
- parent_prio :: Parent -> Int
- parent_prio (ParentIs other_parent)
- | other_parent == wanted_parent = 0
- | otherwise = 1
- parent_prio NoParent = 0
+ parent_prio :: Int
+ parent_prio =
+ case greParent child_gre of
+ ParentIs other_parent
+ | other_parent == wanted_parent
+ -> 0
+ | otherwise
+ -- The parent is wrong, so give this a low priority.
+ -- Don't return 'Nothing': if there are no other options, this
+ -- allows us to report an incorrect parent to the user, as opposed
+ -- to an out-of-scope error.
+ -> 2
+ NoParent ->
+ -- Higher priority than having the wrong parent entirely.
+ 1
+
+ child_is_data =
+ case greInfo child_gre of
+ IAmConLike{} -> True
+ IAmTyCon PromotedDataConFlavour -> True
+ _ -> child_ns == dataName
-- | Look something up in the Global Reader Environment.
--
@@ -1378,10 +1380,10 @@ lookupGRE env = \case
occ = nameOccName nm
lkup | all_ns = concat $ lookupOccEnv_AllNameSpaces env occ
| otherwise = fromMaybe [] $ lookupOccEnv env occ
- LookupChildren occ which_child ->
- let ns = occNameSpace occ
- all_gres = concat $ lookupOccEnv_AllNameSpaces env occ
- in highestPriorityGREs (childGREPriority which_child ns) all_gres
+ LookupChildren parent child_occ ->
+ let ns = occNameSpace child_occ
+ all_gres = concat $ lookupOccEnv_AllNameSpaces env child_occ
+ in highestPriorityGREs (childGREPriority parent ns) all_gres
-- | Collect the 'GlobalRdrElt's with the highest priority according
-- to the given function (lower value <=> higher priority).
diff --git a/testsuite/tests/rename/should_compile/T24027.hs b/testsuite/tests/rename/should_compile/T24027.hs
new file mode 100644
index 00000000000..857ba1422ce
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T24027.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE DataKinds, TypeData #-}
+module T24027(Foo(Foo1, Foo2)) where
+
+import qualified T24027_aux
+
+type data Foo = Foo1 | Foo2 | Foo3
diff --git a/testsuite/tests/rename/should_compile/T24027_aux.hs b/testsuite/tests/rename/should_compile/T24027_aux.hs
new file mode 100644
index 00000000000..1b6952bc43b
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T24027_aux.hs
@@ -0,0 +1,4 @@
+module T24027_aux (Foo(..)) where
+
+data Foo = Foo1 | Foo2 | Foo3
+
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 08b3ed48de8..27b5eb6e0f0 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -210,6 +210,7 @@ test('T23434', normal, compile, [''])
test('T23510b', normal, compile, [''])
test('T23512b', normal, compile, [''])
test('T23664', normal, compile, [''])
+test('T24027', [extra_files(['T24027_aux.hs'])], multimod_compile, ['T24027', '-v0'])
test('T24035', [extra_files(['T24035_aux.hs'])], multimod_compile, ['T24035', '-v0 -Wunused-imports'])
test('T24035b', [extra_files(['T24035_aux.hs'])], multimod_compile, ['T24035b', '-v0 -Wunused-imports'])
test('T24037', normal, compile, [''])
--
GitLab