diff options
| -rw-r--r-- | compiler/typecheck/TcRnExports.hs | 26 | ||||
| -rw-r--r-- | testsuite/tests/module/T13622.hs | 5 | ||||
| -rw-r--r-- | testsuite/tests/module/all.T | 1 |
3 files changed, 25 insertions, 7 deletions
diff --git a/compiler/typecheck/TcRnExports.hs b/compiler/typecheck/TcRnExports.hs index 2da1862f98..1389e745df 100644 --- a/compiler/typecheck/TcRnExports.hs +++ b/compiler/typecheck/TcRnExports.hs @@ -445,7 +445,7 @@ lookupChildrenExport parent rdr_items = let bareName = unLoc n lkup v = lookupExportChild parent (setRdrNameSpace bareName v) - name <- fmap mconcat . mapM lkup $ + name <- tryChildLookupResult $ map lkup $ (choosePossibleNamespaces (rdrNameSpace bareName)) -- Default to data constructors for slightly better error @@ -461,6 +461,17 @@ lookupChildrenExport parent rdr_items = FoundName name -> return $ Left (L (getLoc n) name) NameErr err_msg -> reportError err_msg >> failM +tryChildLookupResult :: [RnM ChildLookupResult] -> RnM ChildLookupResult +tryChildLookupResult [x] = x +tryChildLookupResult (x:xs) = do + res <- x + case res of + FoundFL {} -> return res + FoundName {} -> return res + NameErr {} -> return res + _ -> tryChildLookupResult xs +tryChildLookupResult _ = panic "tryChildLookupResult:empty list" + -- | Also captures the current context @@ -580,19 +591,20 @@ data DisambigInfo instance Monoid DisambigInfo where mempty = NoOccurrence -- This is the key line: We prefer disambiguated occurrences to other - -- names. - UniqueOccurrence _ `mappend` DisambiguatedOccurrence g' = DisambiguatedOccurrence g' - DisambiguatedOccurrence g' `mappend` UniqueOccurrence _ = DisambiguatedOccurrence g' + -- names. Notice that two disambiguated occurences are not ambiguous as + -- there is an internal invariant that a list of `DisambigInfo` arises + -- from a list of GREs which all have the same OccName. Thus, if we ever + -- have two DisambiguatedOccurences then they must have arisen from the + -- same GRE and hence it's safe to discard one. + _ `mappend` DisambiguatedOccurrence g' = DisambiguatedOccurrence g' + DisambiguatedOccurrence g' `mappend` _ = DisambiguatedOccurrence g' NoOccurrence `mappend` m = m m `mappend` NoOccurrence = m UniqueOccurrence g `mappend` UniqueOccurrence g' = AmbiguousOccurrence [g, g'] UniqueOccurrence g `mappend` AmbiguousOccurrence gs = AmbiguousOccurrence (g:gs) - DisambiguatedOccurrence g `mappend` DisambiguatedOccurrence g' = AmbiguousOccurrence [g, g'] - DisambiguatedOccurrence g `mappend` AmbiguousOccurrence gs = AmbiguousOccurrence (g:gs) AmbiguousOccurrence gs `mappend` UniqueOccurrence g' = AmbiguousOccurrence (g':gs) - AmbiguousOccurrence gs `mappend` DisambiguatedOccurrence g' = AmbiguousOccurrence (g':gs) AmbiguousOccurrence gs `mappend` AmbiguousOccurrence gs' = AmbiguousOccurrence (gs ++ gs') diff --git a/testsuite/tests/module/T13622.hs b/testsuite/tests/module/T13622.hs new file mode 100644 index 0000000000..037283ee57 --- /dev/null +++ b/testsuite/tests/module/T13622.hs @@ -0,0 +1,5 @@ +module Bug (Bits(Bits)) where + +import qualified Data.Bits as Bits + +newtype Bits = Bits Int diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T index 6d05c77a9e..5404f19e4a 100644 --- a/testsuite/tests/module/all.T +++ b/testsuite/tests/module/all.T @@ -283,4 +283,5 @@ test('T11970A', [], multimod_compile, ['T11970A','-Wunused-imports']) test('T11970B', normal, compile_fail, ['']) test('MultiExport', normal, compile, ['']) test('T13528', normal, compile, ['']) +test('T13622', normal, compile, ['']) |