diff --git a/compiler/typecheck/TcRnExports.hs b/compiler/typecheck/TcRnExports.hs
index 7f677a478bb90cba152af7a3720e487bbe52a774..fd099d0c4cc876a21d6f8b7491154eaef0ea7274 100644
--- a/compiler/typecheck/TcRnExports.hs
+++ b/compiler/typecheck/TcRnExports.hs
@@ -302,28 +302,27 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
NoIEWildcard -> return (lname, [], [])
IEWildcard _ -> lookup_ie_all ie l
let name = unLoc lname
- subs' = map (replaceLWrappedName l . unLoc) subs
- return (IEThingWith (replaceLWrappedName l name) wc subs'
- (map noLoc (flds ++ all_flds)),
+ return (IEThingWith (replaceLWrappedName l name) wc subs
+ (flds ++ (map noLoc all_flds)),
AvailTC name (name : avails ++ all_avail)
- (flds ++ all_flds))
-
-
+ (map unLoc flds ++ all_flds))
lookup_ie _ = panic "lookup_ie" -- Other cases covered earlier
+
lookup_ie_with :: LIEWrappedName RdrName -> [LIEWrappedName RdrName]
- -> RnM (Located Name, [Located Name], [Name], [FieldLabel])
+ -> RnM (Located Name, [LIEWrappedName Name], [Name],
+ [Located FieldLabel])
lookup_ie_with (L l rdr) sub_rdrs
= do name <- lookupGlobalOccRn $ ieWrappedName rdr
- (non_flds, flds) <- lookupChildrenExport name
- (map ieLWrappedName sub_rdrs)
+ (non_flds, flds) <- lookupChildrenExport name sub_rdrs
if isUnboundName name
then return (L l name, [], [name], [])
else return (L l name, non_flds
- , map unLoc non_flds
- , map unLoc flds)
+ , map (ieWrappedName . unLoc) non_flds
+ , flds)
+
lookup_ie_all :: IE GhcPs -> LIEWrappedName RdrName
-> RnM (Located Name, [Name], [FieldLabel])
lookup_ie_all ie (L l rdr) =
@@ -404,8 +403,8 @@ isDoc _ = False
-lookupChildrenExport :: Name -> [Located RdrName]
- -> RnM ([Located Name], [Located FieldLabel])
+lookupChildrenExport :: Name -> [LIEWrappedName RdrName]
+ -> RnM ([LIEWrappedName Name], [Located FieldLabel])
lookupChildrenExport parent rdr_items =
do
xs <- mapAndReportM doOne rdr_items
@@ -420,11 +419,11 @@ lookupChildrenExport parent rdr_items =
| ns == tcName = [dataName, tcName]
| otherwise = [ns]
-- Process an individual child
- doOne :: Located RdrName
- -> RnM (Either (Located Name) (Located FieldLabel))
+ doOne :: LIEWrappedName RdrName
+ -> RnM (Either (LIEWrappedName Name) (Located FieldLabel))
doOne n = do
- let bareName = unLoc n
+ let bareName = (ieWrappedName . unLoc) n
lkup v = lookupSubBndrOcc_helper False True
parent (setRdrNameSpace bareName v)
@@ -446,9 +445,11 @@ lookupChildrenExport parent rdr_items =
traceRn "lookupChildrenExport" (ppr name')
case name' of
- NameNotFound -> Left . L (getLoc n) <$> reportUnboundName unboundName
+ NameNotFound -> do { ub <- reportUnboundName unboundName
+ ; let l = getLoc n
+ ; return (Left (L l (IEName (L l ub))))}
FoundFL fls -> return $ Right (L (getLoc n) fls)
- FoundName _p name -> return $ Left (L (getLoc n) name)
+ FoundName _p name -> return $ Left (replaceLWrappedName n name)
NameErr err_msg -> reportError err_msg >> failM
IncorrectParent p g td gs -> do
mkDcErrMsg p g td gs >>= reportError
diff --git a/testsuite/tests/parser/should_compile/T14189.hs b/testsuite/tests/parser/should_compile/T14189.hs
new file mode 100644
index 0000000000000000000000000000000000000000..c26ebd7dee6216290a98793dba6d90486b8528d9
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T14189.hs
@@ -0,0 +1,6 @@
+module T14189
+ (
+ MyType (f,NT)
+ ) where
+
+data MyType = MT Int | NT | F { f :: Int }
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..53e4a6f941b428e9c4538cc365aef97c4f2c449b
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T14189.stderr
@@ -0,0 +1,135 @@
+
+==================== Renamer ====================
+
+(Just
+ ((,,,)
+ (HsGroup
+ (ValBindsOut
+ []
+ [])
+ []
+ [(TyClGroup
+ [({ T14189.hs:6:1-42 }
+ (DataDecl
+ ({ T14189.hs:6:6-11 }
+ {Name: T14189.MyType})
+ (HsQTvs
+ []
+ []
+ {NameSet:
+ []})
+ (Prefix)
+ (HsDataDefn
+ (DataType)
+ ({ <no location info> }
+ [])
+ (Nothing)
+ (Nothing)
+ [({ T14189.hs:6:15-20 }
+ (ConDeclH98
+ ({ T14189.hs:6:15-16 }
+ {Name: T14189.MT})
+ (Nothing)
+ (Just
+ ({ <no location info> }
+ []))
+ (PrefixCon
+ [({ T14189.hs:6:18-20 }
+ (HsTyVar
+ (NotPromoted)
+ ({ T14189.hs:6:18-20 }
+ {Name: GHC.Types.Int})))])
+ (Nothing)))
+ ,({ T14189.hs:6:24-25 }
+ (ConDeclH98
+ ({ T14189.hs:6:24-25 }
+ {Name: T14189.NT})
+ (Nothing)
+ (Just
+ ({ <no location info> }
+ []))
+ (PrefixCon
+ [])
+ (Nothing)))
+ ,({ T14189.hs:6:29-42 }
+ (ConDeclH98
+ ({ T14189.hs:6:29 }
+ {Name: T14189.F})
+ (Nothing)
+ (Just
+ ({ <no location info> }
+ []))
+ (RecCon
+ ({ T14189.hs:6:31-42 }
+ [({ T14189.hs:6:33-40 }
+ (ConDeclField
+ [({ T14189.hs:6:33 }
+ (FieldOcc
+ ({ T14189.hs:6:33 }
+ (Unqual
+ {OccName: f}))
+ {Name: T14189.f}))]
+ ({ T14189.hs:6:38-40 }
+ (HsTyVar
+ (NotPromoted)
+ ({ T14189.hs:6:38-40 }
+ {Name: GHC.Types.Int})))
+ (Nothing)))]))
+ (Nothing)))]
+ ({ <no location info> }
+ []))
+ (True)
+ {NameSet:
+ [{Name: GHC.Types.Int}]}))]
+ []
+ [])]
+ []
+ []
+ []
+ []
+ []
+ []
+ []
+ []
+ [])
+ [({ T14189.hs:1:8-13 }
+ (ImportDecl
+ (NoSourceText)
+ ({ T14189.hs:1:8-13 }
+ {ModuleName: Prelude})
+ (Nothing)
+ (False)
+ (False)
+ (False)
+ (True)
+ (Nothing)
+ (Nothing)))]
+ (Just
+ [((,)
+ ({ T14189.hs:3:3-15 }
+ (IEThingWith
+ ({ T14189.hs:3:3-8 }
+ (IEName
+ ({ T14189.hs:3:3-8 }
+ {Name: T14189.MyType})))
+ (NoIEWildcard)
+ [({ T14189.hs:3:13-14 }
+ (IEName
+ ({ T14189.hs:3:13-14 }
+ {Name: T14189.NT})))]
+ [({ T14189.hs:3:11 }
+ (FieldLabel
+ {FastString: "f"}
+ (False)
+ {Name: T14189.f}))]))
+ [(AvailTC
+ {Name: T14189.MyType}
+ [{Name: T14189.MyType}
+ ,{Name: T14189.NT}]
+ [(FieldLabel
+ {FastString: "f"}
+ (False)
+ {Name: T14189.f})])])])
+ (Nothing)))
+
+
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index a9d683070122277c8fa80aeb7e432e787f7423d7..c008bd439a2ca1e5ae4f99203ba0784823c24378 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -108,3 +108,4 @@ test('DumpParsedAst', normal, compile, ['-dsuppress-uniques -ddump-parsed-a
test('DumpRenamedAst', normal, compile, ['-dsuppress-uniques -ddump-rn-ast'])
test('DumpTypecheckedAst', normal, compile, ['-dsuppress-uniques -ddump-tc-ast'])
test('T13747', normal, compile, [''])
+test('T14189', normal, compile, ['-dsuppress-uniques -ddump-rn-ast'])